Unverified Commit 8c2e3f6b authored by Oleg Grenrus's avatar Oleg Grenrus Committed by GitHub
Browse files

Merge pull request #7108 from phadej/null-filepaths

Prohibit empty file paths.
parents 5b1cb204 f7f4b341
......@@ -250,7 +250,11 @@ newtype FilePathNT = FilePathNT { getFilePathNT :: String }
instance Newtype String FilePathNT
instance Parsec FilePathNT where
parsec = pack <$> parsecToken
parsec = do
token <- parsecToken
if null token
then P.unexpected "empty FilePath"
else return (FilePathNT token)
instance Pretty FilePathNT where
pretty = showFilePath . unpack
......
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
-- | 'GenericPackageDescription' Field descriptions
module Distribution.PackageDescription.FieldGrammar (
-- * Package description
......@@ -55,6 +57,7 @@ import Language.Haskell.Extension
import Prelude ()
import Distribution.CabalSpecVersion
import Distribution.Compat.Newtype (Newtype)
import Distribution.Compiler (CompilerFlavor (..), PerCompilerFlavor (..))
import Distribution.FieldGrammar
import Distribution.Fields
......@@ -62,12 +65,12 @@ import Distribution.ModuleName (ModuleName)
import Distribution.Package
import Distribution.PackageDescription
import Distribution.Parsec
import Distribution.Pretty (prettyShow)
import Distribution.Pretty (Pretty (..), prettyShow, showToken)
import Distribution.Types.Mixin (Mixin)
import Distribution.Types.ModuleReexport
import Distribution.Version (Version, VersionRange)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Char8 as BS8
import qualified Distribution.SPDX as SPDX
import qualified Distribution.Types.Lens as L
......@@ -81,9 +84,11 @@ packageDescriptionFieldGrammar
, c (Identity PackageName)
, c (Identity Version)
, c (List FSep FilePathNT String)
, c (List FSep CompatFilePath String)
, c (List FSep TestedWith (CompilerFlavor, VersionRange))
, c (List VCat FilePathNT String)
, c FilePathNT
, c CompatFilePath
, c SpecLicense
, c SpecVersion
)
......@@ -93,6 +98,7 @@ packageDescriptionFieldGrammar = PackageDescription
<*> blurFieldGrammar L.package packageIdentifierGrammar
<*> optionalFieldDefAla "license" SpecLicense L.licenseRaw (Left SPDX.NONE)
<*> licenseFilesGrammar
^^^ fmap (filter (not . null)) -- strip empty filepaths
<*> freeTextFieldDefST "copyright" L.copyright
<*> freeTextFieldDefST "maintainer" L.maintainer
<*> freeTextFieldDefST "author" L.author
......@@ -117,7 +123,8 @@ packageDescriptionFieldGrammar = PackageDescription
<*> pure [] -- benchmarks
-- * Files
<*> monoidalFieldAla "data-files" (alaList' VCat FilePathNT) L.dataFiles
<*> optionalFieldDefAla "data-dir" FilePathNT L.dataDir ""
<*> optionalFieldDefAla "data-dir" CompatFilePath L.dataDir "."
^^^ fmap (\x -> if null x then "." else x) -- map empty directories to "."
<*> monoidalFieldAla "extra-source-files" formatExtraSourceFiles L.extraSrcFiles
<*> monoidalFieldAla "extra-tmp-files" (alaList' VCat FilePathNT) L.extraTmpFiles
<*> monoidalFieldAla "extra-doc-files" (alaList' VCat FilePathNT) L.extraDocFiles
......@@ -130,8 +137,8 @@ packageDescriptionFieldGrammar = PackageDescription
-- TODO: neither field is deprecated
-- should we pretty print license-file if there's single license file
-- and license-files when more
<$> monoidalFieldAla "license-file" (alaList' FSep FilePathNT) L.licenseFiles
<*> monoidalFieldAla "license-files" (alaList' FSep FilePathNT) L.licenseFiles
<$> monoidalFieldAla "license-file" (alaList' FSep CompatFilePath) L.licenseFiles
<*> monoidalFieldAla "license-files" (alaList' FSep CompatFilePath) L.licenseFiles
^^^ hiddenField
-------------------------------------------------------------------------------
......@@ -693,6 +700,44 @@ formatOtherExtensions = alaList' FSep MQuoted
formatOtherModules :: [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName
formatOtherModules = alaList' VCat MQuoted
-------------------------------------------------------------------------------
-- newtypes
-------------------------------------------------------------------------------
-- | Compat FilePath accepts empty file path,
-- but issues a warning.
--
-- There are simply too many (~1200) package definition files
--
-- @
-- license-file: ""
-- @
--
-- and
--
-- @
-- data-dir: ""
-- @
--
-- across Hackage to outrule them completely.
-- I suspect some of them are generated (e.g. formatted) by machine.
--
newtype CompatFilePath = CompatFilePath { getCompatFilePath :: FilePath } -- TODO: Change to use SymPath
instance Newtype String CompatFilePath
instance Parsec CompatFilePath where
parsec = do
token <- parsecToken
if null token
then do
parsecWarning PWTEmptyFilePath "empty FilePath"
return (CompatFilePath "")
else return (CompatFilePath token)
instance Pretty CompatFilePath where
pretty = showToken . getCompatFilePath
-------------------------------------------------------------------------------
-- vim syntax definitions
-------------------------------------------------------------------------------
......
......@@ -268,6 +268,17 @@ patches = Map.fromList
(Fingerprint 17812331267506881875 3005293725141563863)
(Fingerprint 3445957263137759540 12472369104312474458)
(bsReplace "cabal-version: 2" "cabal-version: 2.0")
-- Empty filepath in not license-file or data-dir
-- These have hs-source-dirs: ""
, mk "\nname: wai-middleware-hmac-client\nversion: 0.1.0.1\nlicense: BSD3\nlicense-file: LICENSE\nauthor: Christopher Reichert\nmaintainer: creichert07@gmail.com\ncopyright: (c) 2015, Christo"
(Fingerprint 3112606538775065787 11984607507024462091)
(Fingerprint 6916432989977230500 6621389616675138128)
(bsReplace "\"\"" ".")
, mk "\nname: wai-middleware-hmac-client\nversion: 0.1.0.2\nlicense: BSD3\nlicense-file: LICENSE\nauthor: Christopher Reichert\nmaintainer: creichert07@gmail.com\ncopyright: (c) 2015, Christo"
(Fingerprint 12566783342663020458 17562089389615949789)
(Fingerprint 15745683452603944938 10556498036622072844)
(bsReplace "\"\"" ".")
]
where
mk a b c d = ((a, b), (c, d))
......
......@@ -41,6 +41,8 @@ data PWarnType
| PWTSpecVersion -- ^ Warnings about cabal-version format.
| PWTEmptyFilePath -- ^ Empty filepath, i.e. literally ""
| PWTExperimental -- ^ Experimental feature
deriving (Eq, Ord, Show, Enum, Bounded, Generic)
......
......@@ -222,7 +222,7 @@ emptyPackageDescription
testSuites = [],
benchmarks = [],
dataFiles = [],
dataDir = "",
dataDir = ".",
extraSrcFiles = [],
extraTmpFiles = [],
extraDocFiles = []
......
......@@ -323,7 +323,7 @@ GenericPackageDescription
category = "Data",
copyright = "Copyright by Michal J. Gajda '2012",
customFieldsPD = [],
dataDir = "",
dataDir = ".",
dataFiles = [],
description = "Octree data structure is relatively shallow data structure for space partitioning.",
executables = [],
......
......@@ -79,7 +79,7 @@ GenericPackageDescription
category = "",
copyright = "",
customFieldsPD = [],
dataDir = "",
dataDir = ".",
dataFiles = [],
description = "",
executables = [],
......
......@@ -70,7 +70,7 @@ GenericPackageDescription
category = "",
copyright = "",
customFieldsPD = [],
dataDir = "",
dataDir = ".",
dataFiles = [],
description = "",
executables = [],
......
......@@ -656,7 +656,7 @@ GenericPackageDescription
category = "",
copyright = "",
customFieldsPD = [],
dataDir = "",
dataDir = ".",
dataFiles = [],
description = "",
executables = [],
......
......@@ -145,7 +145,7 @@ GenericPackageDescription
copyright = "",
customFieldsPD = [_×_ "x-revision" "1",
_×_ "x-follows-version-policy" ""],
dataDir = "",
dataDir = ".",
dataFiles = [],
description = "",
executables = [],
......
......@@ -682,7 +682,7 @@ GenericPackageDescription
category = "",
copyright = "",
customFieldsPD = [],
dataDir = "",
dataDir = ".",
dataFiles = [],
description = "",
executables = [],
......
......@@ -175,7 +175,7 @@ GenericPackageDescription
copyright = "",
customFieldsPD = [_×_ "x-revision" "1",
_×_ "x-follows-version-policy" ""],
dataDir = "",
dataDir = ".",
dataFiles = [],
description = "",
executables = [],
......
......@@ -147,7 +147,7 @@ GenericPackageDescription
category = "",
copyright = "",
customFieldsPD = [],
dataDir = "",
dataDir = ".",
dataFiles = [],
description = "",
executables = [],
......
......@@ -350,7 +350,7 @@ GenericPackageDescription
category = "",
copyright = "",
customFieldsPD = [],
dataDir = "",
dataDir = ".",
dataFiles = [],
description = "",
executables = [],
......
......@@ -91,7 +91,7 @@ GenericPackageDescription
category = "",
copyright = "",
customFieldsPD = [],
dataDir = "",
dataDir = ".",
dataFiles = [],
description = "",
executables = [],
......
......@@ -708,7 +708,7 @@ GenericPackageDescription
category = "Generics",
copyright = "",
customFieldsPD = [],
dataDir = "",
dataDir = ".",
dataFiles = [],
description = concat
["A library to support the definition of generic functions.\n",
......
......@@ -9799,7 +9799,7 @@ GenericPackageDescription
category = "Tensors, Machine Learning, AI",
copyright = "",
customFieldsPD = [],
dataDir = "",
dataDir = ".",
dataFiles = [],
description = "Hasktorch is a library for tensors and neural networks in Haskell. It is an independent open source community project which leverages the core C libraries shared by Torch and PyTorch. This library leverages @cabal v2-build@ and @backpack@. *Note that this project is in early development and should only be used by contributing developers. Expect substantial changes to the library API as it evolves. Contributions and PRs are welcome (see details on github).*",
executables = [],
......@@ -79,7 +79,7 @@ GenericPackageDescription
category = "",
copyright = "",
customFieldsPD = [],
dataDir = "",
dataDir = ".",
dataFiles = [],
description = "",
executables = [],
......
......@@ -70,7 +70,7 @@ GenericPackageDescription
category = "",
copyright = "",
customFieldsPD = [],
dataDir = "",
dataDir = ".",
dataFiles = [],
description = concat
["* foo\n",
......
......@@ -70,7 +70,7 @@ GenericPackageDescription
category = "",
copyright = "",
customFieldsPD = [],
dataDir = "",
dataDir = ".",
dataFiles = [],
description = concat ["foo\n", " indent2\n", " indent4"],
executables = [],
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment