diff --git a/Cabal-syntax/src/Distribution/Types/Benchmark.hs b/Cabal-syntax/src/Distribution/Types/Benchmark.hs index be0911432ec..13e5fe104e5 100644 --- a/Cabal-syntax/src/Distribution/Types/Benchmark.hs +++ b/Cabal-syntax/src/Distribution/Types/Benchmark.hs @@ -48,24 +48,12 @@ instance Monoid Benchmark where instance Semigroup Benchmark where a <> b = Benchmark - { benchmarkName = combine' benchmarkName + { benchmarkName = combineNames a b benchmarkName "benchmark" , benchmarkInterface = combine benchmarkInterface , benchmarkBuildInfo = combine benchmarkBuildInfo } where combine field = field a `mappend` field b - combine' field = case ( unUnqualComponentName $ field a - , unUnqualComponentName $ field b - ) of - ("", _) -> field b - (_, "") -> field a - (x, y) -> - error $ - "Ambiguous values for test field: '" - ++ x - ++ "' and '" - ++ y - ++ "'" emptyBenchmark :: Benchmark emptyBenchmark = mempty diff --git a/Cabal-syntax/src/Distribution/Types/Executable.hs b/Cabal-syntax/src/Distribution/Types/Executable.hs index 618f91dc5f3..5362d7122b0 100644 --- a/Cabal-syntax/src/Distribution/Types/Executable.hs +++ b/Cabal-syntax/src/Distribution/Types/Executable.hs @@ -40,25 +40,13 @@ instance Monoid Executable where instance Semigroup Executable where a <> b = Executable - { exeName = combine' exeName + { exeName = combineNames a b exeName "executable" , modulePath = combine modulePath , exeScope = combine exeScope , buildInfo = combine buildInfo } where combine field = field a `mappend` field b - combine' field = case ( unUnqualComponentName $ field a - , unUnqualComponentName $ field b - ) of - ("", _) -> field b - (_, "") -> field a - (x, y) -> - error $ - "Ambiguous values for executable field: '" - ++ x - ++ "' and '" - ++ y - ++ "'" emptyExecutable :: Executable emptyExecutable = mempty diff --git a/Cabal-syntax/src/Distribution/Types/ForeignLib.hs b/Cabal-syntax/src/Distribution/Types/ForeignLib.hs index 9d714f9895f..7e31a6cc7c0 100644 --- a/Cabal-syntax/src/Distribution/Types/ForeignLib.hs +++ b/Cabal-syntax/src/Distribution/Types/ForeignLib.hs @@ -140,7 +140,7 @@ instance NFData ForeignLib where rnf = genericRnf instance Semigroup ForeignLib where a <> b = ForeignLib - { foreignLibName = combine' foreignLibName + { foreignLibName = combineNames a b foreignLibName "foreign library" , foreignLibType = combine foreignLibType , foreignLibOptions = combine foreignLibOptions , foreignLibBuildInfo = combine foreignLibBuildInfo @@ -150,18 +150,6 @@ instance Semigroup ForeignLib where } where combine field = field a `mappend` field b - combine' field = case ( unUnqualComponentName $ field a - , unUnqualComponentName $ field b - ) of - ("", _) -> field b - (_, "") -> field a - (x, y) -> - error $ - "Ambiguous values for executable field: '" - ++ x - ++ "' and '" - ++ y - ++ "'" combine'' field = field b instance Monoid ForeignLib where diff --git a/Cabal-syntax/src/Distribution/Types/TestSuite.hs b/Cabal-syntax/src/Distribution/Types/TestSuite.hs index 5e72965b815..6b3107cae71 100644 --- a/Cabal-syntax/src/Distribution/Types/TestSuite.hs +++ b/Cabal-syntax/src/Distribution/Types/TestSuite.hs @@ -51,25 +51,13 @@ instance Monoid TestSuite where instance Semigroup TestSuite where a <> b = TestSuite - { testName = combine' testName + { testName = combineNames a b testName "test" , testInterface = combine testInterface , testBuildInfo = combine testBuildInfo , testCodeGenerators = combine testCodeGenerators } where combine field = field a `mappend` field b - combine' field = case ( unUnqualComponentName $ field a - , unUnqualComponentName $ field b - ) of - ("", _) -> field b - (_, "") -> field a - (x, y) -> - error $ - "Ambiguous values for test field: '" - ++ x - ++ "' and '" - ++ y - ++ "'" emptyTestSuite :: TestSuite emptyTestSuite = mempty diff --git a/Cabal-syntax/src/Distribution/Types/UnqualComponentName.hs b/Cabal-syntax/src/Distribution/Types/UnqualComponentName.hs index a13fc917633..93feff2fbbe 100644 --- a/Cabal-syntax/src/Distribution/Types/UnqualComponentName.hs +++ b/Cabal-syntax/src/Distribution/Types/UnqualComponentName.hs @@ -9,11 +9,12 @@ module Distribution.Types.UnqualComponentName , mkUnqualComponentName , packageNameToUnqualComponentName , unqualComponentNameToPackageName + , combineNames ) where import Distribution.Compat.Prelude import Distribution.Utils.ShortText -import Prelude () +import Prelude as P (null) import Distribution.Parsec import Distribution.Pretty @@ -105,3 +106,33 @@ packageNameToUnqualComponentName = UnqualComponentName . unPackageNameST -- @since 2.0.0.2 unqualComponentNameToPackageName :: UnqualComponentName -> PackageName unqualComponentNameToPackageName = mkPackageNameST . unUnqualComponentNameST + +-- | Combine names in targets if one name is empty or both names are equal +-- (partial function). +-- Useful in 'Semigroup' and similar instances. +combineNames + :: a + -> a + -> (a -> UnqualComponentName) + -> String + -> UnqualComponentName +combineNames a b tacc tt + -- One empty or the same. + | P.null unb + || una == unb = + na + | P.null una = nb + -- Both non-empty, different. + | otherwise = + error $ + "Ambiguous values for " + ++ tt + ++ " field: '" + ++ una + ++ "' and '" + ++ unb + ++ "'" + where + (na, nb) = (tacc a, tacc b) + una = unUnqualComponentName na + unb = unUnqualComponentName nb diff --git a/Cabal-tests/tests/CheckTests.hs b/Cabal-tests/tests/CheckTests.hs index ad9a93feebe..220cc7d1458 100644 --- a/Cabal-tests/tests/CheckTests.hs +++ b/Cabal-tests/tests/CheckTests.hs @@ -71,7 +71,7 @@ checkTest fp = cabalGoldenTest fp correct $ do -- Note: parser warnings are reported by `cabal check`, but not by -- D.PD.Check functionality. unlines (map (showPWarning fp) ws) ++ - unlines (map show (checkPackage gpd Nothing)) + unlines (map show (checkPackage gpd)) Left (_, errs) -> unlines $ map (("ERROR: " ++) . showPError fp) $ NE.toList errs where input = "tests" "ParserTests" "regressions" fp diff --git a/Cabal-tests/tests/HackageTests.hs b/Cabal-tests/tests/HackageTests.hs index df27938d221..9bff0ce05cc 100644 --- a/Cabal-tests/tests/HackageTests.hs +++ b/Cabal-tests/tests/HackageTests.hs @@ -196,7 +196,7 @@ parseCheckTest fpath bs = do Parsec.parseGenericPackageDescription bs case parsec of Right gpd -> do - let checks = checkPackage gpd Nothing + let checks = checkPackage gpd let w [] = 0 w _ = 1 diff --git a/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.check b/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.check index 0da0e871ebb..ad65af510aa 100644 --- a/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.check +++ b/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.check @@ -1,6 +1,6 @@ -These packages miss upper bounds: +On library, these packages miss upper bounds: + - somelib - alphalib - betalib - deltalib - - somelib -Please add them, using `cabal gen-bounds` for suggestions. For more information see: https://pvp.haskell.org/ +Please add them. There is more information at https://pvp.haskell.org/ diff --git a/Cabal-tests/tests/ParserTests/regressions/bad-glob-syntax.check b/Cabal-tests/tests/ParserTests/regressions/bad-glob-syntax.check index 5b7a0a12552..5f52530791f 100644 --- a/Cabal-tests/tests/ParserTests/regressions/bad-glob-syntax.check +++ b/Cabal-tests/tests/ParserTests/regressions/bad-glob-syntax.check @@ -1,2 +1,2 @@ -In the 'extra-source-files' field: invalid file glob 'foo/blah-*.hs'. Wildcards '*' may only totally replace the file's base name, not only parts of it. In the 'extra-source-files' field: invalid file glob 'foo/*/bar'. A wildcard '**' is only allowed as the final parent directory. Stars must not otherwise appear in the parent directories. +In the 'extra-source-files' field: invalid file glob 'foo/blah-*.hs'. Wildcards '*' may only totally replace the file's base name, not only parts of it. diff --git a/Cabal-tests/tests/ParserTests/regressions/decreasing-indentation.cabal b/Cabal-tests/tests/ParserTests/regressions/decreasing-indentation.cabal index 5a019b281d2..eb0a14724dc 100644 --- a/Cabal-tests/tests/ParserTests/regressions/decreasing-indentation.cabal +++ b/Cabal-tests/tests/ParserTests/regressions/decreasing-indentation.cabal @@ -24,7 +24,7 @@ Flag UseBinary Description: Use the binary package for serializing keys. Library - build-depends: base >= 3 + build-depends: base < 3 if flag(UseBinary) build-depends: binary <10 CPP-Options: -DUSE_BINARY @@ -34,7 +34,7 @@ Library exposed-modules: Codec.Crypto.RSA Executable test_rsa - build-depends: base >= 3 + build-depends: base < 3 CPP-Options: -DRSA_TEST Main-Is: Test.hs Other-Modules: Codec.Crypto.RSA @@ -52,7 +52,7 @@ Executable warnings -- Increasing indentation is also possible if we use braces to delimit field contents. Executable warnings2 - build-depends: { base <5 } + build-depends: { base < 5 } main-is: { warnings2.hs } Other-Modules: FooBar @@ -62,9 +62,9 @@ flag splitBase Executable warnings3 if flag(splitBase) - build-depends: base >= 3 + build-depends: base < 3 else - build-depends: base < 3 + build-depends: base < 5 Main-Is: warnings3.hs Other-Modules: diff --git a/Cabal-tests/tests/ParserTests/regressions/denormalised-paths.check b/Cabal-tests/tests/ParserTests/regressions/denormalised-paths.check index 84eade4e941..9b631589990 100644 --- a/Cabal-tests/tests/ParserTests/regressions/denormalised-paths.check +++ b/Cabal-tests/tests/ParserTests/regressions/denormalised-paths.check @@ -1,11 +1,14 @@ -The 'subdir' field of a source-repository is not a good relative path: "trailing same directory segment: ." -The paths 'files/<>/*.txt', 'c/**/*.c', 'C:foo/bar', '||s' are invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|" and there a few reserved names including "aux", "nul", "con", "prn", "com1-9", "lpt1-9" and "clock$". 'hs-source-dirs: ../../assoc/src' is a relative path outside of the source tree. This will not work when generating a tarball with 'sdist'. +The 'subdir' field of a source-repository is not a good relative path: "trailing same directory segment: ." 'extra-source-files: files/**/*.txt/' is not a good relative path: "trailing slash" 'extra-source-files: files/../foo.txt' is not a good relative path: "parent directory segment: .." -'license-file: LICENSE2/' is not a good relative path: "trailing slash" -'license-file: .' is not a good relative path: "trailing dot segment" +'hs-source-dirs: ../../assoc/src' is not a good relative path: "parent directory segment: .." 'hs-source-dirs: src/.' is not a good relative path: "trailing same directory segment: ." -'hs-source-dirs: src/../src' is not a good relative path: "parent directory segment: .." 'hs-source-dirs: src/../../assoc/src' is not a good relative path: "parent directory segment: .." -'hs-source-dirs: ../../assoc/src' is not a good relative path: "parent directory segment: .." +'hs-source-dirs: src/../src' is not a good relative path: "parent directory segment: .." +'license-file: .' is not a good relative path: "trailing dot segment" +'license-file: LICENSE2/' is not a good relative path: "trailing slash" +The path 'C:foo/bar' is invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|" and there a few reserved names including "aux", "nul", "con", "prn", "com1-9", "lpt1-9" and "clock$". +The path 'c/**/*.c' is invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|" and there a few reserved names including "aux", "nul", "con", "prn", "com1-9", "lpt1-9" and "clock$". +The path 'files/<>/*.txt' is invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|" and there a few reserved names including "aux", "nul", "con", "prn", "com1-9", "lpt1-9" and "clock$". +The path '||s' is invalid on Windows, which would cause portability problems for this package. Windows file names cannot contain any of the characters ":*?<>|" and there a few reserved names including "aux", "nul", "con", "prn", "com1-9", "lpt1-9" and "clock$". diff --git a/Cabal-tests/tests/ParserTests/regressions/ghc-option-j.check b/Cabal-tests/tests/ParserTests/regressions/ghc-option-j.check index 3643c13a0ec..8e6ed9f432a 100644 --- a/Cabal-tests/tests/ParserTests/regressions/ghc-option-j.check +++ b/Cabal-tests/tests/ParserTests/regressions/ghc-option-j.check @@ -1,2 +1,2 @@ -'ghc-options: -j[N]' can make sense for specific user's setup, but it is not appropriate for a distributed package. Alternatively, if you want to use this, make it conditional based on a Cabal configuration flag (with 'manual: True' and 'default: False') and enable that flag during development. -'ghc-shared-options: -j[N]' can make sense for specific user's setup, but it is not appropriate for a distributed package. Alternatively, if you want to use this, make it conditional based on a Cabal configuration flag (with 'manual: True' and 'default: False') and enable that flag during development. +'ghc-options: -j[N]' can make sense for a particular user's setup, but it is not appropriate for a distributed package. Alternatively, if you want to use this, make it conditional based on a Cabal configuration flag (with 'manual: True' and 'default: False') and enable that flag during development. +'ghc-shared-options: -j[N]' can make sense for a particular user's setup, but it is not appropriate for a distributed package. Alternatively, if you want to use this, make it conditional based on a Cabal configuration flag (with 'manual: True' and 'default: False') and enable that flag during development. diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-774.check b/Cabal-tests/tests/ParserTests/regressions/issue-774.check index 27bea8fc70b..84bf5272856 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-774.check +++ b/Cabal-tests/tests/ParserTests/regressions/issue-774.check @@ -1,6 +1,6 @@ issue-774.cabal:13:22: Packages with 'cabal-version: 1.12' or later should specify a specific version of the Cabal spec of the form 'cabal-version: x.y'. Use 'cabal-version: 1.12'. +'ghc-options: -rtsopts' has no effect for libraries. It should only be used for executables. +'ghc-options: -with-rtsopts' has no effect for libraries. It should only be used for executables. No 'category' field. No 'maintainer' field. The 'license' field is missing or is NONE. -'ghc-options: -rtsopts' has no effect for libraries. It should only be used for executables. -'ghc-options: -with-rtsopts' has no effect for libraries. It should only be used for executables. diff --git a/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.check b/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.check index aa57fe96240..6a21d7ccae8 100644 --- a/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.check +++ b/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.check @@ -2,5 +2,5 @@ No 'category' field. No 'maintainer' field. No 'description' field. The 'license' field is missing or is NONE. -Suspicious flag names: 無. To avoid ambiguity in command line interfaces, flag shouldn't start with a dash. Also for better compatibility, flag names shouldn't contain non-ascii characters. +Suspicious flag names: 無. To avoid ambiguity in command line interfaces, a flag shouldn't start with a dash. Also for better compatibility, flag names shouldn't contain non-ascii characters. Non ascii custom fields: x-無. For better compatibility, custom field names shouldn't contain non-ascii characters. diff --git a/Cabal-tests/tests/ParserTests/regressions/pre-2.4-globstar.check b/Cabal-tests/tests/ParserTests/regressions/pre-2.4-globstar.check index 331d5a0ade9..ac3bd4bc76d 100644 --- a/Cabal-tests/tests/ParserTests/regressions/pre-2.4-globstar.check +++ b/Cabal-tests/tests/ParserTests/regressions/pre-2.4-globstar.check @@ -1,3 +1,3 @@ In the 'data-files' field: invalid file glob 'foo/**/*.dat'. Using the double-star syntax requires 'cabal-version: 2.4' or greater. Alternatively, for compatibility with earlier Cabal versions, list the included directories explicitly. -In the 'extra-source-files' field: invalid file glob 'foo/**/*.hs'. Using the double-star syntax requires 'cabal-version: 2.4' or greater. Alternatively, for compatibility with earlier Cabal versions, list the included directories explicitly. In the 'extra-doc-files' field: invalid file glob 'foo/**/*.html'. Using the double-star syntax requires 'cabal-version: 2.4' or greater. Alternatively, for compatibility with earlier Cabal versions, list the included directories explicitly. +In the 'extra-source-files' field: invalid file glob 'foo/**/*.hs'. Using the double-star syntax requires 'cabal-version: 2.4' or greater. Alternatively, for compatibility with earlier Cabal versions, list the included directories explicitly. diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index da7eeda354c..c5dd237a5f8 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -322,6 +322,12 @@ library Distribution.Compat.SnocList Distribution.GetOpt Distribution.Lex + Distribution.PackageDescription.Check.Common + Distribution.PackageDescription.Check.Conditional + Distribution.PackageDescription.Check.Monad + Distribution.PackageDescription.Check.Paths + Distribution.PackageDescription.Check.Target + Distribution.PackageDescription.Check.Warning Distribution.Simple.Build.Macros.Z Distribution.Simple.Build.PackageInfoModule.Z Distribution.Simple.Build.PathsModule.Z diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index 2c9806a1ae5..fb3c05a64b6 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -1,10 +1,8 @@ -{-# LANGUAGE LambdaCase #-} - ------------------------------------------------------------------------------ +{-# LANGUAGE ScopedTypeVariables #-} -- | -- Module : Distribution.PackageDescription.Check --- Copyright : Lennart Kolmodin 2008 +-- Copyright : Lennart Kolmodin 2008, Francesco Ariis 2022 -- License : BSD3 -- -- Maintainer : cabal-devel@haskell.org @@ -34,55 +32,37 @@ module Distribution.PackageDescription.Check -- ** Checking package contents , checkPackageFiles + , checkPackageFilesGPD , checkPackageContent , CheckPackageContentOps (..) - , checkPackageFileNames ) where -import Data.Foldable (foldrM) import Distribution.Compat.Prelude import Prelude () -import Data.List (delete, group) +import Data.List (group) import Distribution.CabalSpecVersion import Distribution.Compat.Lens import Distribution.Compiler import Distribution.License -import Distribution.ModuleName (ModuleName) import Distribution.Package import Distribution.PackageDescription -import Distribution.PackageDescription.Configuration -import Distribution.Parsec.Warning (PWarning, showPWarning) +import Distribution.PackageDescription.Check.Common +import Distribution.PackageDescription.Check.Conditional +import Distribution.PackageDescription.Check.Monad +import Distribution.PackageDescription.Check.Paths +import Distribution.PackageDescription.Check.Target +import Distribution.Parsec.Warning (PWarning) import Distribution.Pretty (prettyShow) -import Distribution.Simple.BuildPaths (autogenPackageInfoModuleName, autogenPathsModuleName) -import Distribution.Simple.BuildToolDepends -import Distribution.Simple.CCompiler import Distribution.Simple.Glob import Distribution.Simple.Utils hiding (findPackageDesc, notice) -import Distribution.System -import Distribution.Types.ComponentRequestedSpec -import Distribution.Types.PackageName.Magic import Distribution.Utils.Generic (isAscii) import Distribution.Utils.Path import Distribution.Verbosity import Distribution.Version -import Language.Haskell.Extension -import System.FilePath - ( makeRelative - , normalise - , splitDirectories - , splitExtension - , splitPath - , takeExtension - , takeFileName - , (<.>) - , () - ) - -import qualified Control.Monad as CM +import System.FilePath (splitExtension, takeFileName, (<.>), ()) + import qualified Data.ByteString.Lazy as BS -import qualified Data.Map as Map -import qualified Distribution.Compat.DList as DList import qualified Distribution.SPDX as SPDX import qualified System.Directory as System @@ -92,1358 +72,552 @@ import qualified System.FilePath.Windows as FilePath.Windows (isValid) import qualified Data.Set as Set import qualified Distribution.Utils.ShortText as ShortText -import qualified Distribution.Types.BuildInfo.Lens as L import qualified Distribution.Types.GenericPackageDescription.Lens as L -import qualified Distribution.Types.PackageDescription.Lens as L + +import Control.Monad -- $setup -- >>> import Control.Arrow ((&&&)) --- ------------------------------------------------------------ - --- * Warning messages - --- ------------------------------------------------------------ - --- | Which stanza does `CheckExplanation` refer to? -data CEType = CETLibrary | CETExecutable | CETTest | CETBenchmark - deriving (Eq, Ord, Show) - --- | Pretty printing `CEType`. -ppCE :: CEType -> String -ppCE CETLibrary = "library" -ppCE CETExecutable = "executable" -ppCE CETTest = "test suite" -ppCE CETBenchmark = "benchmark" - --- | Which field does `CheckExplanation` refer to? -data CEField - = CEFCategory - | CEFMaintainer - | CEFSynopsis - | CEFDescription - | CEFSynOrDesc - deriving (Eq, Ord, Show) - --- | Pretty printing `CEField`. -ppCEField :: CEField -> String -ppCEField CEFCategory = "category" -ppCEField CEFMaintainer = "maintainer" -ppCEField CEFSynopsis = "synopsis" -ppCEField CEFDescription = "description" -ppCEField CEFSynOrDesc = "synopsis' or 'description" - --- | Explanations of 'PackageCheck`'s errors/warnings. -data CheckExplanation - = ParseWarning FilePath PWarning - | NoNameField - | NoVersionField - | NoTarget - | UnnamedInternal - | DuplicateSections [UnqualComponentName] - | IllegalLibraryName PackageDescription - | NoModulesExposed Library - | SignaturesCabal2 - | AutogenNotExposed - | AutogenIncludesNotIncluded - | NoMainIs Executable - | NoHsLhsMain - | MainCCabal1_18 - | AutogenNoOther CEType UnqualComponentName - | AutogenIncludesNotIncludedExe - | TestsuiteTypeNotKnown TestType - | TestsuiteNotSupported TestType - | BenchmarkTypeNotKnown BenchmarkType - | BenchmarkNotSupported BenchmarkType - | NoHsLhsMainBench - | InvalidNameWin PackageDescription - | ZPrefix - | NoBuildType - | NoCustomSetup - | UnknownCompilers [String] - | UnknownLanguages [String] - | UnknownExtensions [String] - | LanguagesAsExtension [String] - | DeprecatedExtensions [(Extension, Maybe Extension)] - | MissingField CEField - | SynopsisTooLong - | ShortDesc - | InvalidTestWith [Dependency] - | ImpossibleInternalDep [Dependency] - | ImpossibleInternalExe [ExeDependency] - | MissingInternalExe [ExeDependency] - | NONELicense - | NoLicense - | AllRightsReservedLicense - | LicenseMessParse PackageDescription - | UnrecognisedLicense String - | UncommonBSD4 - | UnknownLicenseVersion License [Version] - | NoLicenseFile - | UnrecognisedSourceRepo String - | MissingType - | MissingLocation - | MissingModule - | MissingTag - | SubdirRelPath - | SubdirGoodRelPath String - | OptFasm String - | OptViaC String - | OptHpc String - | OptProf String - | OptO String - | OptHide String - | OptMake String - | OptONot String - | OptOOne String - | OptOTwo String - | OptSplitSections String - | OptSplitObjs String - | OptWls String - | OptExts String - | OptRts String - | OptWithRts String - | COptONumber String String - | COptCPP String - | OptAlternatives String String [(String, String)] - | RelativeOutside String FilePath - | AbsolutePath String FilePath - | BadRelativePAth String FilePath String - | DistPoint (Maybe String) FilePath - | GlobSyntaxError String String - | RecursiveGlobInRoot String FilePath - | InvalidOnWin [FilePath] - | FilePathTooLong FilePath - | FilePathNameTooLong FilePath - | FilePathSplitTooLong FilePath - | FilePathEmpty - | CVTestSuite - | CVDefaultLanguage - | CVDefaultLanguageComponent - | CVExtraDocFiles - | CVMultiLib - | CVReexported - | CVMixins - | CVExtraFrameworkDirs - | CVDefaultExtensions - | CVExtensionsDeprecated - | CVSources - | CVExtraDynamic [[String]] - | CVVirtualModules - | CVSourceRepository - | CVExtensions CabalSpecVersion [Extension] - | CVCustomSetup - | CVExpliticDepsCustomSetup - | CVAutogenPaths - | CVAutogenPackageInfo - | GlobNoMatch String String - | GlobExactMatch String String FilePath - | GlobNoDir String String FilePath - | UnknownOS [String] - | UnknownArch [String] - | UnknownCompiler [String] - | BaseNoUpperBounds - | MissingUpperBounds [PackageName] - | SuspiciousFlagName [String] - | DeclaredUsedFlags (Set FlagName) (Set FlagName) - | NonASCIICustomField [String] - | RebindableClashPaths - | RebindableClashPackageInfo - | WErrorUnneeded String - | JUnneeded String - | FDeferTypeErrorsUnneeded String - | DynamicUnneeded String - | ProfilingUnneeded String - | UpperBoundSetup String - | DuplicateModule String [ModuleName] - | PotentialDupModule String [ModuleName] - | BOMStart FilePath - | NotPackageName FilePath String - | NoDesc - | MultiDesc [String] - | UnknownFile String (SymbolicPath PackageDir LicenseFile) - | MissingSetupFile - | MissingConfigureScript - | UnknownDirectory String FilePath - | MissingSourceControl - | MissingExpectedDocFiles Bool [FilePath] - | WrongFieldForExpectedDocFiles Bool String [FilePath] - deriving (Eq, Ord, Show) - --- | Wraps `ParseWarning` into `PackageCheck`. -wrapParseWarning :: FilePath -> PWarning -> PackageCheck -wrapParseWarning fp pw = PackageDistSuspicious (ParseWarning fp pw) - --- TODO: as Jul 2022 there is no severity indication attached PWarnType. --- Once that is added, we can output something more appropriate --- than PackageDistSuspicious for every parse warning. --- (see: Cabal-syntax/src/Distribution/Parsec/Warning.hs) - --- | Pretty printing `CheckExplanation`. -ppExplanation :: CheckExplanation -> String -ppExplanation (ParseWarning fp pp) = showPWarning fp pp -ppExplanation NoNameField = "No 'name' field." -ppExplanation NoVersionField = "No 'version' field." -ppExplanation NoTarget = - "No executables, libraries, tests, or benchmarks found. Nothing to do." -ppExplanation UnnamedInternal = - "Found one or more unnamed internal libraries. Only the non-internal" - ++ " library can have the same name as the package." -ppExplanation (DuplicateSections duplicateNames) = - "Duplicate sections: " - ++ commaSep (map unUnqualComponentName duplicateNames) - ++ ". The name of every library, executable, test suite," - ++ " and benchmark section in the package must be unique." -ppExplanation (IllegalLibraryName pkg) = - "Illegal internal library name " - ++ prettyShow (packageName pkg) - ++ ". Internal libraries cannot have the same name as the package." - ++ " Maybe you wanted a non-internal library?" - ++ " If so, rewrite the section stanza" - ++ " from 'library: '" - ++ prettyShow (packageName pkg) - ++ "' to 'library'." -ppExplanation (NoModulesExposed lib) = - showLibraryName (libName lib) ++ " does not expose any modules" -ppExplanation SignaturesCabal2 = - "To use the 'signatures' field the package needs to specify " - ++ "at least 'cabal-version: 2.0'." -ppExplanation AutogenNotExposed = - "An 'autogen-module' is neither on 'exposed-modules' nor 'other-modules'." -ppExplanation AutogenIncludesNotIncluded = - "An include in 'autogen-includes' is neither in 'includes' or " - ++ "'install-includes'." -ppExplanation (NoMainIs exe) = - "No 'main-is' field found for executable " ++ prettyShow (exeName exe) -ppExplanation NoHsLhsMain = - "The 'main-is' field must specify a '.hs' or '.lhs' file " - ++ "(even if it is generated by a preprocessor), " - ++ "or it may specify a C/C++/obj-C source file." -ppExplanation MainCCabal1_18 = - "The package uses a C/C++/obj-C source file for the 'main-is' field. " - ++ "To use this feature you need to specify 'cabal-version: 1.18' or" - ++ " higher." -ppExplanation (AutogenNoOther ct ucn) = - "On " - ++ ppCE ct - ++ " '" - ++ prettyShow ucn - ++ "' an 'autogen-module'" - ++ " is not on 'other-modules'" -ppExplanation AutogenIncludesNotIncludedExe = - "An include in 'autogen-includes' is not in 'includes'." -ppExplanation (TestsuiteTypeNotKnown tt) = - quote (prettyShow tt) - ++ " is not a known type of test suite. " - ++ "Either remove the 'type' field or use a known type. " - ++ "The known test suite types are: " - ++ commaSep (map prettyShow knownTestTypes) -ppExplanation (TestsuiteNotSupported tt) = - quote (prettyShow tt) - ++ " is not a supported test suite version. " - ++ "Either remove the 'type' field or use a known type. " - ++ "The known test suite types are: " - ++ commaSep (map prettyShow knownTestTypes) -ppExplanation (BenchmarkTypeNotKnown tt) = - quote (prettyShow tt) - ++ " is not a known type of benchmark. " - ++ "Either remove the 'type' field or use a known type. " - ++ "The known benchmark types are: " - ++ commaSep (map prettyShow knownBenchmarkTypes) -ppExplanation (BenchmarkNotSupported tt) = - quote (prettyShow tt) - ++ " is not a supported benchmark version. " - ++ "Either remove the 'type' field or use a known type. " - ++ "The known benchmark types are: " - ++ commaSep (map prettyShow knownBenchmarkTypes) -ppExplanation NoHsLhsMainBench = - "The 'main-is' field must specify a '.hs' or '.lhs' file " - ++ "(even if it is generated by a preprocessor)." -ppExplanation (InvalidNameWin pkg) = - "The package name '" - ++ prettyShow (packageName pkg) - ++ "' is " - ++ "invalid on Windows. Many tools need to convert package names to " - ++ "file names so using this name would cause problems." -ppExplanation ZPrefix = - "Package names with the prefix 'z-' are reserved by Cabal and " - ++ "cannot be used." -ppExplanation NoBuildType = - "No 'build-type' specified. If you do not need a custom Setup.hs or " - ++ "./configure script then use 'build-type: Simple'." -ppExplanation NoCustomSetup = - "Ignoring the 'custom-setup' section because the 'build-type' is " - ++ "not 'Custom'. Use 'build-type: Custom' if you need to use a " - ++ "custom Setup.hs script." -ppExplanation (UnknownCompilers unknownCompilers) = - "Unknown compiler " - ++ commaSep (map quote unknownCompilers) - ++ " in 'tested-with' field." -ppExplanation (UnknownLanguages unknownLanguages) = - "Unknown languages: " ++ commaSep unknownLanguages -ppExplanation (UnknownExtensions unknownExtensions) = - "Unknown extensions: " ++ commaSep unknownExtensions -ppExplanation (LanguagesAsExtension languagesUsedAsExtensions) = - "Languages listed as extensions: " - ++ commaSep languagesUsedAsExtensions - ++ ". Languages must be specified in either the 'default-language' " - ++ " or the 'other-languages' field." -ppExplanation (DeprecatedExtensions ourDeprecatedExtensions) = - "Deprecated extensions: " - ++ commaSep (map (quote . prettyShow . fst) ourDeprecatedExtensions) - ++ ". " - ++ unwords - [ "Instead of '" - ++ prettyShow ext - ++ "' use '" - ++ prettyShow replacement - ++ "'." - | (ext, Just replacement) <- ourDeprecatedExtensions - ] -ppExplanation (MissingField cef) = - "No '" ++ ppCEField cef ++ "' field." -ppExplanation SynopsisTooLong = - "The 'synopsis' field is rather long (max 80 chars is recommended)." -ppExplanation ShortDesc = - "The 'description' field should be longer than the 'synopsis' field. " - ++ "It's useful to provide an informative 'description' to allow " - ++ "Haskell programmers who have never heard about your package to " - ++ "understand the purpose of your package. " - ++ "The 'description' field content is typically shown by tooling " - ++ "(e.g. 'cabal info', Haddock, Hackage) below the 'synopsis' which " - ++ "serves as a headline. " - ++ "Please refer to for more details." -ppExplanation (InvalidTestWith testedWithImpossibleRanges) = - "Invalid 'tested-with' version range: " - ++ commaSep (map prettyShow testedWithImpossibleRanges) - ++ ". To indicate that you have tested a package with multiple " - ++ "different versions of the same compiler use multiple entries, " - ++ "for example 'tested-with: GHC==6.10.4, GHC==6.12.3' and not " - ++ "'tested-with: GHC==6.10.4 && ==6.12.3'." -ppExplanation (ImpossibleInternalDep depInternalLibWithImpossibleVersion) = - "The package has an impossible version range for a dependency on an " - ++ "internal library: " - ++ commaSep (map prettyShow depInternalLibWithImpossibleVersion) - ++ ". This version range does not include the current package, and must " - ++ "be removed as the current package's library will always be used." -ppExplanation (ImpossibleInternalExe depInternalExecWithImpossibleVersion) = - "The package has an impossible version range for a dependency on an " - ++ "internal executable: " - ++ commaSep (map prettyShow depInternalExecWithImpossibleVersion) - ++ ". This version range does not include the current package, and must " - ++ "be removed as the current package's executable will always be used." -ppExplanation (MissingInternalExe depInternalExeWithImpossibleVersion) = - "The package depends on a missing internal executable: " - ++ commaSep (map prettyShow depInternalExeWithImpossibleVersion) -ppExplanation NONELicense = "The 'license' field is missing or is NONE." -ppExplanation NoLicense = "The 'license' field is missing." -ppExplanation AllRightsReservedLicense = - "The 'license' is AllRightsReserved. Is that really what you want?" -ppExplanation (LicenseMessParse pkg) = - "Unfortunately the license " - ++ quote (prettyShow (license pkg)) - ++ " messes up the parser in earlier Cabal versions so you need to " - ++ "specify 'cabal-version: >= 1.4'. Alternatively if you require " - ++ "compatibility with earlier Cabal versions then use 'OtherLicense'." -ppExplanation (UnrecognisedLicense l) = - quote ("license: " ++ l) - ++ " is not a recognised license. The " - ++ "known licenses are: " - ++ commaSep (map prettyShow knownLicenses) -ppExplanation UncommonBSD4 = - "Using 'license: BSD4' is almost always a misunderstanding. 'BSD4' " - ++ "refers to the old 4-clause BSD license with the advertising " - ++ "clause. 'BSD3' refers the new 3-clause BSD license." -ppExplanation (UnknownLicenseVersion lic known) = - "'license: " - ++ prettyShow lic - ++ "' is not a known " - ++ "version of that license. The known versions are " - ++ commaSep (map prettyShow known) - ++ ". If this is not a mistake and you think it should be a known " - ++ "version then please file a ticket." -ppExplanation NoLicenseFile = "A 'license-file' is not specified." -ppExplanation (UnrecognisedSourceRepo kind) = - quote kind - ++ " is not a recognised kind of source-repository. " - ++ "The repo kind is usually 'head' or 'this'" -ppExplanation MissingType = - "The source-repository 'type' is a required field." -ppExplanation MissingLocation = - "The source-repository 'location' is a required field." -ppExplanation MissingModule = - "For a CVS source-repository, the 'module' is a required field." -ppExplanation MissingTag = - "For the 'this' kind of source-repository, the 'tag' is a required " - ++ "field. It should specify the tag corresponding to this version " - ++ "or release of the package." -ppExplanation SubdirRelPath = - "The 'subdir' field of a source-repository must be a relative path." -ppExplanation (SubdirGoodRelPath err) = - "The 'subdir' field of a source-repository is not a good relative path: " - ++ show err -ppExplanation (OptFasm fieldName) = - "'" - ++ fieldName - ++ ": -fasm' is unnecessary and will not work on CPU " - ++ "architectures other than x86, x86-64, ppc or sparc." -ppExplanation (OptViaC fieldName) = - "'" - ++ fieldName - ++ ": -fvia-C' is usually unnecessary. If your package " - ++ "needs -via-C for correctness rather than performance then it " - ++ "is using the FFI incorrectly and will probably not work with GHC " - ++ "6.10 or later." -ppExplanation (OptHpc fieldName) = - "'" - ++ fieldName - ++ ": -fhpc' is not necessary. Use the configure flag " - ++ " --enable-coverage instead." -ppExplanation (OptProf fieldName) = - "'" - ++ fieldName - ++ ": -prof' is not necessary and will lead to problems " - ++ "when used on a library. Use the configure flag " - ++ "--enable-library-profiling and/or --enable-profiling." -ppExplanation (OptO fieldName) = - "'" - ++ fieldName - ++ ": -o' is not needed. " - ++ "The output files are named automatically." -ppExplanation (OptHide fieldName) = - "'" - ++ fieldName - ++ ": -hide-package' is never needed. " - ++ "Cabal hides all packages." -ppExplanation (OptMake fieldName) = - "'" - ++ fieldName - ++ ": --make' is never needed. Cabal uses this automatically." -ppExplanation (OptONot fieldName) = - "'" - ++ fieldName - ++ ": -O0' is not needed. " - ++ "Use the --disable-optimization configure flag." -ppExplanation (OptOOne fieldName) = - "'" - ++ fieldName - ++ ": -O' is not needed. " - ++ "Cabal automatically adds the '-O' flag. " - ++ "Setting it yourself interferes with the --disable-optimization flag." -ppExplanation (OptOTwo fieldName) = - "'" - ++ fieldName - ++ ": -O2' is rarely needed. " - ++ "Check that it is giving a real benefit " - ++ "and not just imposing longer compile times on your users." -ppExplanation (OptSplitSections fieldName) = - "'" - ++ fieldName - ++ ": -split-sections' is not needed. " - ++ "Use the --enable-split-sections configure flag." -ppExplanation (OptSplitObjs fieldName) = - "'" - ++ fieldName - ++ ": -split-objs' is not needed. " - ++ "Use the --enable-split-objs configure flag." -ppExplanation (OptWls fieldName) = - "'" - ++ fieldName - ++ ": -optl-Wl,-s' is not needed and is not portable to" - ++ " all operating systems. Cabal 1.4 and later automatically strip" - ++ " executables. Cabal also has a flag --disable-executable-stripping" - ++ " which is necessary when building packages for some Linux" - ++ " distributions and using '-optl-Wl,-s' prevents that from working." -ppExplanation (OptExts fieldName) = - "Instead of '" - ++ fieldName - ++ ": -fglasgow-exts' it is preferable to use " - ++ "the 'extensions' field." -ppExplanation (OptRts fieldName) = - "'" - ++ fieldName - ++ ": -rtsopts' has no effect for libraries. It should " - ++ "only be used for executables." -ppExplanation (OptWithRts fieldName) = - "'" - ++ fieldName - ++ ": -with-rtsopts' has no effect for libraries. It " - ++ "should only be used for executables." -ppExplanation (COptONumber prefix label) = - "'" - ++ prefix - ++ ": -O[n]' is generally not needed. When building with " - ++ " optimisations Cabal automatically adds '-O2' for " - ++ label - ++ " code. Setting it yourself interferes with the" - ++ " --disable-optimization flag." -ppExplanation (COptCPP opt) = - "'cpp-options: " ++ opt ++ "' is not a portable C-preprocessor flag." -ppExplanation (OptAlternatives badField goodField flags) = - "Instead of " - ++ quote (badField ++ ": " ++ unwords badFlags) - ++ " use " - ++ quote (goodField ++ ": " ++ unwords goodFlags) - where - (badFlags, goodFlags) = unzip flags -ppExplanation (RelativeOutside field path) = - quote (field ++ ": " ++ path) - ++ " is a relative path outside of the source tree. " - ++ "This will not work when generating a tarball with 'sdist'." -ppExplanation (AbsolutePath field path) = - quote (field ++ ": " ++ path) - ++ " specifies an absolute path, but the " - ++ quote field - ++ " field must use relative paths." -ppExplanation (BadRelativePAth field path err) = - quote (field ++ ": " ++ path) - ++ " is not a good relative path: " - ++ show err -ppExplanation (DistPoint mfield path) = - incipit - ++ " points inside the 'dist' " - ++ "directory. This is not reliable because the location of this " - ++ "directory is configurable by the user (or package manager). In " - ++ "addition the layout of the 'dist' directory is subject to change " - ++ "in future versions of Cabal." - where - -- mfiled Nothing -> the path is inside `ghc-options` - incipit = - maybe - ("'ghc-options' path " ++ quote path) - (\field -> quote (field ++ ": " ++ path)) - mfield -ppExplanation (GlobSyntaxError field expl) = - "In the '" ++ field ++ "' field: " ++ expl -ppExplanation (RecursiveGlobInRoot field glob) = - "In the '" - ++ field - ++ "': glob '" - ++ glob - ++ "' starts at project root directory, this might " - ++ "include `.git/`, ``dist-newstyle/``, or other large directories!" -ppExplanation (InvalidOnWin paths) = - "The " - ++ quotes paths - ++ " invalid on Windows, which " - ++ "would cause portability problems for this package. Windows file " - ++ "names cannot contain any of the characters \":*?<>|\" and there " - ++ "a few reserved names including \"aux\", \"nul\", \"con\", " - ++ "\"prn\", \"com1-9\", \"lpt1-9\" and \"clock$\"." - where - quotes [failed] = "path " ++ quote failed ++ " is" - quotes failed = - "paths " - ++ intercalate ", " (map quote failed) - ++ " are" -ppExplanation (FilePathTooLong path) = - "The following file name is too long to store in a portable POSIX " - ++ "format tar archive. The maximum length is 255 ASCII characters.\n" - ++ "The file in question is:\n " - ++ path -ppExplanation (FilePathNameTooLong path) = - "The following file name is too long to store in a portable POSIX " - ++ "format tar archive. The maximum length for the name part (including " - ++ "extension) is 100 ASCII characters. The maximum length for any " - ++ "individual directory component is 155.\n" - ++ "The file in question is:\n " - ++ path -ppExplanation (FilePathSplitTooLong path) = - "The following file name is too long to store in a portable POSIX " - ++ "format tar archive. While the total length is less than 255 ASCII " - ++ "characters, there are unfortunately further restrictions. It has to " - ++ "be possible to split the file path on a directory separator into " - ++ "two parts such that the first part fits in 155 characters or less " - ++ "and the second part fits in 100 characters or less. Basically you " - ++ "have to make the file name or directory names shorter, or you could " - ++ "split a long directory name into nested subdirectories with shorter " - ++ "names.\nThe file in question is:\n " - ++ path -ppExplanation FilePathEmpty = - "Encountered a file with an empty name, something is very wrong! " - ++ "Files with an empty name cannot be stored in a tar archive or in " - ++ "standard file systems." -ppExplanation CVTestSuite = - "The 'test-suite' section is new in Cabal 1.10. " - ++ "Unfortunately it messes up the parser in older Cabal versions " - ++ "so you must specify at least 'cabal-version: >= 1.8', but note " - ++ "that only Cabal 1.10 and later can actually run such test suites." -ppExplanation CVDefaultLanguage = - "To use the 'default-language' field the package needs to specify " - ++ "at least 'cabal-version: >= 1.10'." -ppExplanation CVDefaultLanguageComponent = - "Packages using 'cabal-version: >= 1.10' and before 'cabal-version: 3.4' " - ++ "must specify the 'default-language' field for each component (e.g. " - ++ "Haskell98 or Haskell2010). If a component uses different languages " - ++ "in different modules then list the other ones in the " - ++ "'other-languages' field." -ppExplanation CVExtraDocFiles = - "To use the 'extra-doc-files' field the package needs to specify " - ++ "'cabal-version: 1.18' or higher." -ppExplanation CVMultiLib = - "To use multiple 'library' sections or a named library section " - ++ "the package needs to specify at least 'cabal-version: 2.0'." -ppExplanation CVReexported = - "To use the 'reexported-module' field the package needs to specify " - ++ "'cabal-version: 1.22' or higher." -ppExplanation CVMixins = - "To use the 'mixins' field the package needs to specify " - ++ "at least 'cabal-version: 2.0'." -ppExplanation CVExtraFrameworkDirs = - "To use the 'extra-framework-dirs' field the package needs to specify" - ++ " 'cabal-version: 1.24' or higher." -ppExplanation CVDefaultExtensions = - "To use the 'default-extensions' field the package needs to specify " - ++ "at least 'cabal-version: >= 1.10'." -ppExplanation CVExtensionsDeprecated = - "For packages using 'cabal-version: >= 1.10' the 'extensions' " - ++ "field is deprecated. The new 'default-extensions' field lists " - ++ "extensions that are used in all modules in the component, while " - ++ "the 'other-extensions' field lists extensions that are used in " - ++ "some modules, e.g. via the {-# LANGUAGE #-} pragma." -ppExplanation CVSources = - "The use of 'asm-sources', 'cmm-sources', 'extra-bundled-libraries' " - ++ " and 'extra-library-flavours' requires the package " - ++ " to specify at least 'cabal-version: 3.0'." -ppExplanation (CVExtraDynamic flavs) = - "The use of 'extra-dynamic-library-flavours' requires the package " - ++ " to specify at least 'cabal-version: 3.0'. The flavours are: " - ++ commaSep (concat flavs) -ppExplanation CVVirtualModules = - "The use of 'virtual-modules' requires the package " - ++ " to specify at least 'cabal-version: 2.2'." -ppExplanation CVSourceRepository = - "The 'source-repository' section is new in Cabal 1.6. " - ++ "Unfortunately it messes up the parser in earlier Cabal versions " - ++ "so you need to specify 'cabal-version: >= 1.6'." -ppExplanation (CVExtensions version extCab12) = - "Unfortunately the language extensions " - ++ commaSep (map (quote . prettyShow) extCab12) - ++ " break the parser in earlier Cabal versions so you need to " - ++ "specify 'cabal-version: >= " - ++ showCabalSpecVersion version - ++ "'. Alternatively if you require compatibility with earlier " - ++ "Cabal versions then you may be able to use an equivalent " - ++ "compiler-specific flag." -ppExplanation CVCustomSetup = - "Packages using 'cabal-version: 1.24' or higher with 'build-type: Custom' " - ++ "must use a 'custom-setup' section with a 'setup-depends' field " - ++ "that specifies the dependencies of the Setup.hs script itself. " - ++ "The 'setup-depends' field uses the same syntax as 'build-depends', " - ++ "so a simple example would be 'setup-depends: base, Cabal'." -ppExplanation CVExpliticDepsCustomSetup = - "From version 1.24 cabal supports specifying explicit dependencies " - ++ "for Custom setup scripts. Consider using 'cabal-version: 1.24' or " - ++ "higher and adding a 'custom-setup' section with a 'setup-depends' " - ++ "field that specifies the dependencies of the Setup.hs script " - ++ "itself. The 'setup-depends' field uses the same syntax as " - ++ "'build-depends', so a simple example would be 'setup-depends: base, " - ++ "Cabal'." -ppExplanation CVAutogenPaths = - "Packages using 'cabal-version: 2.0' and the autogenerated " - ++ "module Paths_* must include it also on the 'autogen-modules' field " - ++ "besides 'exposed-modules' and 'other-modules'. This specifies that " - ++ "the module does not come with the package and is generated on " - ++ "setup. Modules built with a custom Setup.hs script also go here " - ++ "to ensure that commands like sdist don't fail." -ppExplanation CVAutogenPackageInfo = - "Packages using 'cabal-version: 2.0' and the autogenerated " - ++ "module PackageInfo_* must include it in 'autogen-modules' as well as" - ++ " 'exposed-modules' and 'other-modules'. This specifies that " - ++ "the module does not come with the package and is generated on " - ++ "setup. Modules built with a custom Setup.hs script also go here " - ++ "to ensure that commands like sdist don't fail." -ppExplanation (GlobNoMatch field glob) = - "In '" - ++ field - ++ "': the pattern '" - ++ glob - ++ "' does not" - ++ " match any files." -ppExplanation (GlobExactMatch field glob file) = - "In '" - ++ field - ++ "': the pattern '" - ++ glob - ++ "' does not" - ++ " match the file '" - ++ file - ++ "' because the extensions do not" - ++ " exactly match (e.g., foo.en.html does not exactly match *.html)." - ++ " To enable looser suffix-only matching, set 'cabal-version: 2.4' or" - ++ " higher." -ppExplanation (GlobNoDir field glob dir) = - "In '" - ++ field - ++ "': the pattern '" - ++ glob - ++ "' attempts to" - ++ " match files in the directory '" - ++ dir - ++ "', but there is no" - ++ " directory by that name." -ppExplanation (UnknownOS unknownOSs) = - "Unknown operating system name " ++ commaSep (map quote unknownOSs) -ppExplanation (UnknownArch unknownArches) = - "Unknown architecture name " ++ commaSep (map quote unknownArches) -ppExplanation (UnknownCompiler unknownImpls) = - "Unknown compiler name " ++ commaSep (map quote unknownImpls) -ppExplanation (MissingUpperBounds names) = - let separator = "\n - " - in "These packages miss upper bounds:" - ++ separator - ++ (intercalate separator (unPackageName <$> names)) - ++ "\n" - ++ "Please add them, using `cabal gen-bounds` for suggestions." - ++ " For more information see: " - ++ " https://pvp.haskell.org/" -ppExplanation BaseNoUpperBounds = - "The dependency 'build-depends: base' does not specify an upper " - ++ "bound on the version number. Each major release of the 'base' " - ++ "package changes the API in various ways and most packages will " - ++ "need some changes to compile with it. The recommended practice " - ++ "is to specify an upper bound on the version of the 'base' " - ++ "package. This ensures your package will continue to build when a " - ++ "new major version of the 'base' package is released. If you are " - ++ "not sure what upper bound to use then use the next major " - ++ "version. For example if you have tested your package with 'base' " - ++ "version 4.5 and 4.6 then use 'build-depends: base >= 4.5 && < 4.7'." -ppExplanation (SuspiciousFlagName invalidFlagNames) = - "Suspicious flag names: " - ++ unwords invalidFlagNames - ++ ". " - ++ "To avoid ambiguity in command line interfaces, flag shouldn't " - ++ "start with a dash. Also for better compatibility, flag names " - ++ "shouldn't contain non-ascii characters." -ppExplanation (DeclaredUsedFlags declared used) = - "Declared and used flag sets differ: " - ++ s declared - ++ " /= " - ++ s used - ++ ". " - where - s :: Set.Set FlagName -> String - s = commaSep . map unFlagName . Set.toList -ppExplanation (NonASCIICustomField nonAsciiXFields) = - "Non ascii custom fields: " - ++ unwords nonAsciiXFields - ++ ". " - ++ "For better compatibility, custom field names " - ++ "shouldn't contain non-ascii characters." -ppExplanation RebindableClashPaths = - "Packages using RebindableSyntax with OverloadedStrings or" - ++ " OverloadedLists in default-extensions, in conjunction with the" - ++ " autogenerated module Paths_*, are known to cause compile failures" - ++ " with Cabal < 2.2. To use these default-extensions with a Paths_*" - ++ " autogen module, specify at least 'cabal-version: 2.2'." -ppExplanation RebindableClashPackageInfo = - "Packages using RebindableSyntax with OverloadedStrings or" - ++ " OverloadedLists in default-extensions, in conjunction with the" - ++ " autogenerated module PackageInfo_*, are known to cause compile failures" - ++ " with Cabal < 2.2. To use these default-extensions with a PackageInfo_*" - ++ " autogen module, specify at least 'cabal-version: 2.2'." -ppExplanation (WErrorUnneeded fieldName) = - addConditionalExp $ - "'" - ++ fieldName - ++ ": -Werror' makes the package easy to " - ++ "break with future GHC versions because new GHC versions often " - ++ "add new warnings." -ppExplanation (JUnneeded fieldName) = - addConditionalExp $ - "'" - ++ fieldName - ++ ": -j[N]' can make sense for specific user's setup," - ++ " but it is not appropriate for a distributed package." -ppExplanation (FDeferTypeErrorsUnneeded fieldName) = - addConditionalExp $ - "'" - ++ fieldName - ++ ": -fdefer-type-errors' is fine during development " - ++ "but is not appropriate for a distributed package." -ppExplanation (DynamicUnneeded fieldName) = - addConditionalExp $ - "'" - ++ fieldName - ++ ": -d*' debug flags are not appropriate " - ++ "for a distributed package." -ppExplanation (ProfilingUnneeded fieldName) = - addConditionalExp $ - "'" - ++ fieldName - ++ ": -fprof*' profiling flags are typically not " - ++ "appropriate for a distributed library package. These flags are " - ++ "useful to profile this package, but when profiling other packages " - ++ "that use this one these flags clutter the profile output with " - ++ "excessive detail. If you think other packages really want to see " - ++ "cost centres from this package then use '-fprof-auto-exported' " - ++ "which puts cost centres only on exported functions." -ppExplanation (UpperBoundSetup nm) = - "The dependency 'setup-depends: '" - ++ nm - ++ "' does not specify an " - ++ "upper bound on the version number. Each major release of the " - ++ "'" - ++ nm - ++ "' package changes the API in various ways and most " - ++ "packages will need some changes to compile with it. If you are " - ++ "not sure what upper bound to use then use the next major " - ++ "version." -ppExplanation (DuplicateModule s dupLibsLax) = - "Duplicate modules in " - ++ s - ++ ": " - ++ commaSep (map prettyShow dupLibsLax) -ppExplanation (PotentialDupModule s dupLibsStrict) = - "Potential duplicate modules (subject to conditionals) in " - ++ s - ++ ": " - ++ commaSep (map prettyShow dupLibsStrict) -ppExplanation (BOMStart pdfile) = - pdfile - ++ " starts with an Unicode byte order mark (BOM)." - ++ " This may cause problems with older cabal versions." -ppExplanation (NotPackageName pdfile expectedCabalname) = - "The filename " - ++ quote pdfile - ++ " does not match package name " - ++ "(expected: " - ++ quote expectedCabalname - ++ ")" -ppExplanation NoDesc = - "No cabal file found.\n" - ++ "Please create a package description file .cabal" -ppExplanation (MultiDesc multiple) = - "Multiple cabal files found while checking.\n" - ++ "Please use only one of: " - ++ intercalate ", " multiple -ppExplanation (UnknownFile fieldname file) = - "The '" - ++ fieldname - ++ "' field refers to the file " - ++ quote (getSymbolicPath file) - ++ " which does not exist." -ppExplanation MissingSetupFile = - "The package is missing a Setup.hs or Setup.lhs script." -ppExplanation MissingConfigureScript = - "The 'build-type' is 'Configure' but there is no 'configure' script. " - ++ "You probably need to run 'autoreconf -i' to generate it." -ppExplanation (UnknownDirectory kind dir) = - quote (kind ++ ": " ++ dir) - ++ " specifies a directory which does not exist." -ppExplanation MissingSourceControl = - "When distributing packages it is encouraged to specify source " - ++ "control information in the .cabal file using one or more " - ++ "'source-repository' sections. See the Cabal user guide for " - ++ "details." -ppExplanation (MissingExpectedDocFiles extraDocFileSupport paths) = - "Please consider including the " - ++ quotes paths - ++ " in the '" - ++ targetField - ++ "' section of the .cabal file " - ++ "if it contains useful information for users of the package." - where - quotes [p] = "file " ++ quote p - quotes ps = "files " ++ intercalate ", " (map quote ps) - targetField = - if extraDocFileSupport - then "extra-doc-files" - else "extra-source-files" -ppExplanation (WrongFieldForExpectedDocFiles extraDocFileSupport field paths) = - "Please consider moving the " - ++ quotes paths - ++ " from the '" - ++ field - ++ "' section of the .cabal file " - ++ "to the section '" - ++ targetField - ++ "'." - where - quotes [p] = "file " ++ quote p - quotes ps = "files " ++ intercalate ", " (map quote ps) - targetField = - if extraDocFileSupport - then "extra-doc-files" - else "extra-source-files" - --- | Results of some kind of failed package check. +-- ☞ N.B. -- --- There are a range of severities, from merely dubious to totally insane. --- All of them come with a human readable explanation. In future we may augment --- them with more machine readable explanations, for example to help an IDE --- suggest automatic corrections. -data PackageCheck - = -- | This package description is no good. There's no way it's going to - -- build sensibly. This should give an error at configure time. - PackageBuildImpossible {explanation :: CheckExplanation} - | -- | A problem that is likely to affect building the package, or an - -- issue that we'd like every package author to be aware of, even if - -- the package is never distributed. - PackageBuildWarning {explanation :: CheckExplanation} - | -- | An issue that might not be a problem for the package author but - -- might be annoying or detrimental when the package is distributed to - -- users. We should encourage distributed packages to be free from these - -- issues, but occasionally there are justifiable reasons so we cannot - -- ban them entirely. - PackageDistSuspicious {explanation :: CheckExplanation} - | -- | Like PackageDistSuspicious but will only display warnings - -- rather than causing abnormal exit when you run 'cabal check'. - PackageDistSuspiciousWarn {explanation :: CheckExplanation} - | -- | An issue that is OK in the author's environment but is almost - -- certain to be a portability problem for other environments. We can - -- quite legitimately refuse to publicly distribute packages with these - -- problems. - PackageDistInexcusable {explanation :: CheckExplanation} - deriving (Eq, Ord) - --- | Would Hackage refuse a package because of this error? -isHackageDistError :: PackageCheck -> Bool -isHackageDistError = \case - (PackageBuildImpossible{}) -> True - (PackageBuildWarning{}) -> True - (PackageDistInexcusable{}) -> True - (PackageDistSuspicious{}) -> False - (PackageDistSuspiciousWarn{}) -> False - --- | Pretty printing 'PackageCheck'. -ppPackageCheck :: PackageCheck -> String -ppPackageCheck e = ppExplanation (explanation e) - -instance Show PackageCheck where - show notice = ppPackageCheck notice - -check :: Bool -> PackageCheck -> Maybe PackageCheck -check False _ = Nothing -check True pc = Just pc - -checkSpecVersion - :: PackageDescription - -> CabalSpecVersion - -> Bool - -> PackageCheck - -> Maybe PackageCheck -checkSpecVersion pkg specver cond pc - | specVersion pkg >= specver = Nothing - | otherwise = check cond pc +-- Part of the tools/scaffold used to perform check is found in +-- Distribution.PackageDescription.Check.Types. Summary of that module (for +-- how we use it here): +-- 1. we work inside a 'CheckM m a' monad (where `m` is an abstraction to +-- run non-pure checks); +-- 2. 'checkP', 'checkPre' functions perform checks (respectively pure and +-- non-pure); +-- 3. 'PackageCheck' and 'CheckExplanation' are types for warning severity +-- and description. -- ------------------------------------------------------------ - --- * Standard checks - +-- Checking interface -- ------------------------------------------------------------ +-- | 'checkPackagePrim' is the most general way to invoke package checks. +-- We pass to it two interfaces (one to check contents of packages, the +-- other to inspect working tree for orphan files) and before that a +-- Boolean to indicate whether we want pure checks or not. Based on these +-- parameters, some checks will be performed, some omitted. +-- Generality over @m@ means we could do non pure checks in monads other +-- than IO (e.g. a virtual filesystem, like a zip file, a VCS filesystem, +-- etc). +checkPackagePrim + :: Monad m + => Bool -- Perform pure checks? + -> Maybe (CheckPackageContentOps m) -- Package content interface. + -> Maybe (CheckPreDistributionOps m) -- Predist checks interface. + -> GenericPackageDescription -- GPD to check. + -> m [PackageCheck] +checkPackagePrim b mco mpdo gpd = do + let cm = checkGenericPackageDescription gpd + ci = CheckInterface b mco mpdo + ctx = pristineCheckCtx ci gpd + execCheckM cm ctx + -- | Check for common mistakes and problems in package descriptions. -- -- This is the standard collection of checks covering all aspects except -- for checks that require looking at files within the package. For those -- see 'checkPackageFiles'. +checkPackage :: GenericPackageDescription -> [PackageCheck] +checkPackage gpd = runIdentity $ checkPackagePrim True Nothing Nothing gpd + +-- | This function is an oddity due to the historical +-- GenericPackageDescription/PackageDescription split. It is only maintained +-- not to break interface, use `checkPackage` if possible. +checkConfiguredPackage :: PackageDescription -> [PackageCheck] +checkConfiguredPackage pd = checkPackage (pd2gpd pd) + +-- | Sanity check things that requires looking at files in the package. +-- This is a generalised version of 'checkPackageFiles' that can work in any +-- monad for which you can provide 'CheckPackageContentOps' operations. -- --- It requires the 'GenericPackageDescription' and optionally a particular --- configuration of that package. If you pass 'Nothing' then we just check --- a version of the generic description using 'flattenPackageDescription'. -checkPackage - :: GenericPackageDescription - -> Maybe PackageDescription - -> [PackageCheck] -checkPackage gpkg mpkg = - checkConfiguredPackage pkg - ++ checkConditionals gpkg - ++ checkPackageVersions gpkg - ++ checkDevelopmentOnlyFlags gpkg - ++ checkFlagNames gpkg - ++ checkUnusedFlags gpkg - ++ checkUnicodeXFields gpkg - ++ checkPathsModuleExtensions pkg - ++ checkPackageInfoModuleExtensions pkg - ++ checkSetupVersions gpkg - ++ checkDuplicateModules gpkg +-- The point of this extra generality is to allow doing checks in some virtual +-- file system, for example a tarball in memory. +checkPackageContent + :: Monad m + => CheckPackageContentOps m + -> GenericPackageDescription + -> m [PackageCheck] +checkPackageContent pops gpd = checkPackagePrim False (Just pops) Nothing gpd + +-- | Sanity checks that require IO. 'checkPackageFiles' looks at the files +-- in the package and expects to find the package unpacked at the given +-- filepath. +checkPackageFilesGPD + :: Verbosity -- Glob warn message verbosity. + -> GenericPackageDescription + -> FilePath -- Package root. + -> IO [PackageCheck] +checkPackageFilesGPD verbosity gpd root = + checkPackagePrim False (Just checkFilesIO) (Just checkPreIO) gpd where - pkg = fromMaybe (flattenPackageDescription gpkg) mpkg + checkFilesIO = + CheckPackageContentOps + { doesFileExist = System.doesFileExist . relative + , doesDirectoryExist = System.doesDirectoryExist . relative + , getDirectoryContents = System.Directory.getDirectoryContents . relative + , getFileContents = BS.readFile . relative + } --- TODO: make this variant go away --- we should always know the GenericPackageDescription -checkConfiguredPackage :: PackageDescription -> [PackageCheck] -checkConfiguredPackage pkg = - checkSanity pkg - ++ checkFields pkg - ++ checkLicense pkg - ++ checkSourceRepos pkg - ++ checkAllGhcOptions pkg - ++ checkCCOptions pkg - ++ checkCxxOptions pkg - ++ checkCPPOptions pkg - ++ checkPaths pkg - ++ checkCabalVersion pkg + checkPreIO = + CheckPreDistributionOps + { runDirFileGlobM = \fp g -> runDirFileGlob verbosity (root fp) g + , getDirectoryContentsM = System.Directory.getDirectoryContents . relative + } --- ------------------------------------------------------------ + relative path = root path --- * Basic sanity checks +-- | Same as 'checkPackageFilesGPD', but working with 'PackageDescription'. +-- +-- This function is included for legacy reasons, use 'checkPackageFilesGPD' +-- if you are working with 'GenericPackageDescription'. +checkPackageFiles + :: Verbosity -- Glob warn message verbosity. + -> PackageDescription + -> FilePath -- Package root. + -> IO [PackageCheck] +checkPackageFiles verbosity pd oot = + checkPackageFilesGPD verbosity (pd2gpd pd) oot -- ------------------------------------------------------------ +-- Package description +-- ------------------------------------------------------------ --- | Check that this package description is sane. -checkSanity :: PackageDescription -> [PackageCheck] -checkSanity pkg = - catMaybes - [ check (null . unPackageName . packageName $ pkg) $ - PackageBuildImpossible NoNameField - , check (nullVersion == packageVersion pkg) $ - PackageBuildImpossible NoVersionField - , check - ( all - ($ pkg) - [ null . executables - , null . testSuites - , null . benchmarks - , null . allLibraries - , null . foreignLibs +-- Here lies the meat of the module. Starting from 'GenericPackageDescription', +-- we walk the data while doing a number of checks. +-- +-- Where applicable we do a full pattern match (if the data changes, code will +-- break: a gentle reminder to add more checks). +-- Pattern matching variables convention: matching accessor + underscore. +-- This way it is easier to see which one we are missing if we run into +-- an “GPD should have 20 arguments but has been given only 19” error. + +-- | 'GenericPackageDescription' checks. Remember that for historical quirks +-- in the cabal codebase we have both `GenericPackageDescription` and +-- `PackageDescription` and that PD is both a *field* of GPD and a concept +-- of its own (i.e. a fully realised GPD). +-- In this case we are checking (correctly) GPD, so for target info/checks +-- you should walk condLibrary_ etc. and *not* the (empty) target info in +-- PD. See 'pd2gpd' for a convenient hack when you only have +-- 'PackageDescription'. +checkGenericPackageDescription + :: Monad m + => GenericPackageDescription + -> CheckM m () +checkGenericPackageDescription + gpd@( GenericPackageDescription + packageDescription_ + _gpdScannedVersion_ + genPackageFlags_ + condLibrary_ + condSubLibraries_ + condForeignLibs_ + condExecutables_ + condTestSuites_ + condBenchmarks_ + ) = + do + -- § Description and names. + checkPackageDescription packageDescription_ + -- Targets should be present... + let condAllLibraries = + maybeToList condLibrary_ + ++ (map snd condSubLibraries_) + checkP + ( and + [ null condExecutables_ + , null condTestSuites_ + , null condBenchmarks_ + , null condAllLibraries + , null condForeignLibs_ ] ) - $ PackageBuildImpossible NoTarget - , check (any (== LMainLibName) (map libName $ subLibraries pkg)) $ - PackageBuildImpossible UnnamedInternal - , check (not (null duplicateNames)) $ - PackageBuildImpossible (DuplicateSections duplicateNames) - , -- NB: but it's OK for executables to have the same name! - -- TODO shouldn't need to compare on the string level - check - ( any - (== prettyShow (packageName pkg)) - (prettyShow <$> subLibNames) + (PackageBuildImpossible NoTarget) + -- ... and have unique names (names are not under conditional, it is + -- appropriate to check here. + (nsubs, nexes, ntests, nbenchs) <- + asksCM + ( ( \n -> + ( pnSubLibs n + , pnExecs n + , pnTests n + , pnBenchs n + ) + ) + . ccNames + ) + let names = concat [nsubs, nexes, ntests, nbenchs] + dupes = dups names + checkP + (not . null $ dups names) + (PackageBuildImpossible $ DuplicateSections dupes) + -- PackageDescription checks. + checkPackageDescription packageDescription_ + -- Flag names. + mapM_ checkFlagName genPackageFlags_ + + -- § Feature checks. + checkSpecVer + CabalSpecV2_0 + (not . null $ condSubLibraries_) + (PackageDistInexcusable CVMultiLib) + checkSpecVer + CabalSpecV1_8 + (not . null $ condTestSuites_) + (PackageDistInexcusable CVTestSuite) + + -- § Conditional targets + + -- Extract dependencies from libraries, to be passed along for + -- PVP checks purposes. + pName <- + asksCM + ( packageNameToUnqualComponentName + . pkgName + . pnPackageId + . ccNames + ) + let ads = + maybe [] ((: []) . extractAssocDeps pName) condLibrary_ + ++ map (uncurry extractAssocDeps) condSubLibraries_ + + case condLibrary_ of + Just cl -> + checkCondTarget + genPackageFlags_ + (checkLibrary False ads) + (const id) + (mempty, cl) + Nothing -> return () + mapM_ + ( checkCondTarget + genPackageFlags_ + (checkLibrary False ads) + (\u l -> l{libName = maybeToLibraryName (Just u)}) ) - $ PackageBuildImpossible (IllegalLibraryName pkg) - ] - -- TODO: check for name clashes case insensitively: windows file systems cannot - -- cope. - - ++ concatMap (checkLibrary pkg) (allLibraries pkg) - ++ concatMap (checkExecutable pkg) (executables pkg) - ++ concatMap (checkTestSuite pkg) (testSuites pkg) - ++ concatMap (checkBenchmark pkg) (benchmarks pkg) - where - -- The public 'library' gets special dispensation, because it - -- is common practice to export a library and name the executable - -- the same as the package. - subLibNames = mapMaybe (libraryNameString . libName) $ subLibraries pkg - exeNames = map exeName $ executables pkg - testNames = map testName $ testSuites pkg - bmNames = map benchmarkName $ benchmarks pkg - duplicateNames = dups $ subLibNames ++ exeNames ++ testNames ++ bmNames - -checkLibrary :: PackageDescription -> Library -> [PackageCheck] -checkLibrary pkg lib = - catMaybes - [ -- TODO: This check is bogus if a required-signature was passed through - check (null (explicitLibModules lib) && null (reexportedModules lib)) $ - PackageDistSuspiciousWarn (NoModulesExposed lib) - , -- check use of signatures sections - checkVersion CabalSpecV2_0 (not (null (signatures lib))) $ - PackageDistInexcusable SignaturesCabal2 - , -- check that all autogen-modules appear on other-modules or exposed-modules - check - (not $ and $ map (flip elem (explicitLibModules lib)) (libModulesAutogen lib)) - $ PackageBuildImpossible AutogenNotExposed - , -- check that all autogen-includes appear on includes or install-includes - check - (not $ and $ map (flip elem (allExplicitIncludes lib)) (view L.autogenIncludes lib)) - $ PackageBuildImpossible AutogenIncludesNotIncluded - ] - where - checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck - checkVersion ver cond pc - | specVersion pkg >= ver = Nothing - | otherwise = check cond pc - -allExplicitIncludes :: L.HasBuildInfo a => a -> [FilePath] -allExplicitIncludes x = view L.includes x ++ view L.installIncludes x - -checkExecutable :: PackageDescription -> Executable -> [PackageCheck] -checkExecutable pkg exe = - catMaybes - [ check (null (modulePath exe)) $ - PackageBuildImpossible (NoMainIs exe) - , -- This check does not apply to scripts. - check - ( package pkg /= fakePackageId - && not (null (modulePath exe)) - && not (fileExtensionSupportedLanguage $ modulePath exe) + condSubLibraries_ + mapM_ + ( checkCondTarget + genPackageFlags_ + checkForeignLib + (const id) ) - $ PackageBuildImpossible NoHsLhsMain - , checkSpecVersion - pkg - CabalSpecV1_18 - ( fileExtensionSupportedLanguage (modulePath exe) - && takeExtension (modulePath exe) `notElem` [".hs", ".lhs"] + condForeignLibs_ + mapM_ + ( checkCondTarget + genPackageFlags_ + (checkExecutable ads) + (const id) ) - $ PackageDistInexcusable MainCCabal1_18 - , -- check that all autogen-modules appear on other-modules - check - (not $ and $ map (flip elem (exeModules exe)) (exeModulesAutogen exe)) - $ PackageBuildImpossible (AutogenNoOther CETExecutable (exeName exe)) - , -- check that all autogen-includes appear on includes - check - (not $ and $ map (flip elem (view L.includes exe)) (view L.autogenIncludes exe)) - $ PackageBuildImpossible AutogenIncludesNotIncludedExe - ] - -checkTestSuite :: PackageDescription -> TestSuite -> [PackageCheck] -checkTestSuite pkg test = - catMaybes - [ case testInterface test of - TestSuiteUnsupported tt@(TestTypeUnknown _ _) -> - Just $ - PackageBuildWarning (TestsuiteTypeNotKnown tt) - TestSuiteUnsupported tt -> - Just $ - PackageBuildWarning (TestsuiteNotSupported tt) - _ -> Nothing - , check mainIsWrongExt $ - PackageBuildImpossible NoHsLhsMain - , checkSpecVersion pkg CabalSpecV1_18 (mainIsNotHsExt && not mainIsWrongExt) $ - PackageDistInexcusable MainCCabal1_18 - , -- check that all autogen-modules appear on other-modules - check - (not $ and $ map (flip elem (testModules test)) (testModulesAutogen test)) - $ PackageBuildImpossible (AutogenNoOther CETTest (testName test)) - , -- check that all autogen-includes appear on includes - check - (not $ and $ map (flip elem (view L.includes test)) (view L.autogenIncludes test)) - $ PackageBuildImpossible AutogenIncludesNotIncludedExe - ] - where - mainIsWrongExt = case testInterface test of - TestSuiteExeV10 _ f -> not $ fileExtensionSupportedLanguage f - _ -> False - - mainIsNotHsExt = case testInterface test of - TestSuiteExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"] - _ -> False - -checkBenchmark :: PackageDescription -> Benchmark -> [PackageCheck] -checkBenchmark _pkg bm = - catMaybes - [ case benchmarkInterface bm of - BenchmarkUnsupported tt@(BenchmarkTypeUnknown _ _) -> - Just $ - PackageBuildWarning (BenchmarkTypeNotKnown tt) - BenchmarkUnsupported tt -> - Just $ - PackageBuildWarning (BenchmarkNotSupported tt) - _ -> Nothing - , check mainIsWrongExt $ - PackageBuildImpossible NoHsLhsMainBench - , -- check that all autogen-modules appear on other-modules - check - (not $ and $ map (flip elem (benchmarkModules bm)) (benchmarkModulesAutogen bm)) - $ PackageBuildImpossible (AutogenNoOther CETBenchmark (benchmarkName bm)) - , -- check that all autogen-includes appear on includes - check - (not $ and $ map (flip elem (view L.includes bm)) (view L.autogenIncludes bm)) - $ PackageBuildImpossible AutogenIncludesNotIncludedExe - ] - where - mainIsWrongExt = case benchmarkInterface bm of - BenchmarkExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"] - _ -> False - --- ------------------------------------------------------------ - --- * Additional pure checks - --- ------------------------------------------------------------ - -checkFields :: PackageDescription -> [PackageCheck] -checkFields pkg = - catMaybes - [ check (not . FilePath.Windows.isValid . prettyShow . packageName $ pkg) $ - PackageDistInexcusable (InvalidNameWin pkg) - , check (isPrefixOf "z-" . prettyShow . packageName $ pkg) $ - PackageDistInexcusable ZPrefix - , check (isNothing (buildTypeRaw pkg) && specVersion pkg < CabalSpecV2_2) $ - PackageBuildWarning NoBuildType - , check (isJust (setupBuildInfo pkg) && buildType pkg /= Custom) $ - PackageBuildWarning NoCustomSetup - , check (not (null unknownCompilers)) $ - PackageBuildWarning (UnknownCompilers unknownCompilers) - , check (not (null unknownLanguages)) $ - PackageBuildWarning (UnknownLanguages unknownLanguages) - , check (not (null unknownExtensions)) $ - PackageBuildWarning (UnknownExtensions unknownExtensions) - , check (not (null languagesUsedAsExtensions)) $ - PackageBuildWarning (LanguagesAsExtension languagesUsedAsExtensions) - , check (not (null ourDeprecatedExtensions)) $ - PackageDistSuspicious (DeprecatedExtensions ourDeprecatedExtensions) - , check (ShortText.null (category pkg)) $ - PackageDistSuspicious (MissingField CEFCategory) - , check (ShortText.null (maintainer pkg)) $ - PackageDistSuspicious (MissingField CEFMaintainer) - , check (ShortText.null (synopsis pkg) && ShortText.null (description pkg)) $ - PackageDistInexcusable (MissingField CEFSynOrDesc) - , check (ShortText.null (description pkg) && not (ShortText.null (synopsis pkg))) $ - PackageDistSuspicious (MissingField CEFDescription) - , check (ShortText.null (synopsis pkg) && not (ShortText.null (description pkg))) $ - PackageDistSuspicious (MissingField CEFSynopsis) - , -- TODO: recommend the bug reports URL, author and homepage fields - -- TODO: recommend not using the stability field - -- TODO: recommend specifying a source repo - - check (ShortText.length (synopsis pkg) > 80) $ - PackageDistSuspicious SynopsisTooLong - , -- See also https://github.com/haskell/cabal/pull/3479 - check - ( not (ShortText.null (description pkg)) - && ShortText.length (description pkg) <= ShortText.length (synopsis pkg) + condExecutables_ + mapM_ + ( checkCondTarget + genPackageFlags_ + (checkTestSuite ads) + (\u l -> l{testName = u}) ) - $ PackageDistSuspicious ShortDesc - , -- check use of impossible constraints "tested-with: GHC== 6.10 && ==6.12" - check (not (null testedWithImpossibleRanges)) $ - PackageDistInexcusable (InvalidTestWith testedWithImpossibleRanges) - , -- for more details on why the following was commented out, - -- check https://github.com/haskell/cabal/pull/7470#issuecomment-875878507 - -- , check (not (null depInternalLibraryWithExtraVersion)) $ - -- PackageBuildWarning $ - -- "The package has an extraneous version range for a dependency on an " - -- ++ "internal library: " - -- ++ commaSep (map prettyShow depInternalLibraryWithExtraVersion) - -- ++ ". This version range includes the current package but isn't needed " - -- ++ "as the current package's library will always be used." - - check (not (null depInternalLibraryWithImpossibleVersion)) $ - PackageBuildImpossible - (ImpossibleInternalDep depInternalLibraryWithImpossibleVersion) - , -- , check (not (null depInternalExecutableWithExtraVersion)) $ - -- PackageBuildWarning $ - -- "The package has an extraneous version range for a dependency on an " - -- ++ "internal executable: " - -- ++ commaSep (map prettyShow depInternalExecutableWithExtraVersion) - -- ++ ". This version range includes the current package but isn't needed " - -- ++ "as the current package's executable will always be used." - - check (not (null depInternalExecutableWithImpossibleVersion)) $ - PackageBuildImpossible - (ImpossibleInternalExe depInternalExecutableWithImpossibleVersion) - , check (not (null depMissingInternalExecutable)) $ - PackageBuildImpossible (MissingInternalExe depMissingInternalExecutable) - ] - where - unknownCompilers = [name | (OtherCompiler name, _) <- testedWith pkg] - unknownLanguages = - [ name | bi <- allBuildInfo pkg, UnknownLanguage name <- allLanguages bi - ] - unknownExtensions = - [ name | bi <- allBuildInfo pkg, UnknownExtension name <- allExtensions bi, name `notElem` map prettyShow knownLanguages - ] - ourDeprecatedExtensions = - nub $ - catMaybes - [ find ((== ext) . fst) deprecatedExtensions - | bi <- allBuildInfo pkg - , ext <- allExtensions bi + condTestSuites_ + mapM_ + ( checkCondTarget + genPackageFlags_ + (checkBenchmark ads) + (\u l -> l{benchmarkName = u}) + ) + condBenchmarks_ + + -- For unused flags it is clearer and more convenient to fold the + -- data rather than walk it, an exception to the rule. + checkP + (decFlags /= usedFlags) + (PackageDistSuspicious $ DeclaredUsedFlags decFlags usedFlags) + + -- Duplicate modules. + mapM_ tellP (checkDuplicateModules gpd) + where + -- todo is this caught at parse time? + checkFlagName :: Monad m => PackageFlag -> CheckM m () + checkFlagName pf = + let fn = unFlagName . flagName $ pf + + invalidFlagName ('-' : _) = True -- starts with dash + invalidFlagName cs = any (not . isAscii) cs -- non ASCII + in checkP + (invalidFlagName fn) + (PackageDistInexcusable $ SuspiciousFlagName [fn]) + + decFlags :: Set.Set FlagName + decFlags = toSetOf (L.genPackageFlags . traverse . L.flagName) gpd + + usedFlags :: Set.Set FlagName + usedFlags = + mconcat + [ toSetOf (L.condLibrary . traverse . traverseCondTreeV . L._PackageFlag) gpd + , toSetOf (L.condSubLibraries . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd + , toSetOf (L.condForeignLibs . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd + , toSetOf (L.condExecutables . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd + , toSetOf (L.condTestSuites . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd + , toSetOf (L.condBenchmarks . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd ] - languagesUsedAsExtensions = - [ name | bi <- allBuildInfo pkg, UnknownExtension name <- allExtensions bi, name `elem` map prettyShow knownLanguages - ] - - testedWithImpossibleRanges = - [ Dependency (mkPackageName (prettyShow compiler)) vr mainLibSet - | (compiler, vr) <- testedWith pkg - , isNoVersion vr - ] - - internalExecutables = map exeName $ executables pkg - internalLibDeps = - [ dep - | bi <- allBuildInfo pkg - , dep@(Dependency name _ _) <- targetBuildDepends bi - , name == packageName pkg - ] - - internalExeDeps = - [ dep - | bi <- allBuildInfo pkg - , dep <- getAllToolDependencies pkg bi - , isInternal pkg dep - ] - - -- depInternalLibraryWithExtraVersion = - -- [ dep - -- | dep@(Dependency _ versionRange _) <- internalLibDeps - -- , not $ isAnyVersion versionRange - -- , packageVersion pkg `withinRange` versionRange - -- ] - - depInternalLibraryWithImpossibleVersion = - [ dep - | dep@(Dependency _ versionRange _) <- internalLibDeps - , not $ packageVersion pkg `withinRange` versionRange - ] - - -- depInternalExecutableWithExtraVersion = - -- [ dep - -- | dep@(ExeDependency _ _ versionRange) <- internalExeDeps - -- , not $ isAnyVersion versionRange - -- , packageVersion pkg `withinRange` versionRange - -- ] - - depInternalExecutableWithImpossibleVersion = - [ dep - | dep@(ExeDependency _ _ versionRange) <- internalExeDeps - , not $ packageVersion pkg `withinRange` versionRange - ] +checkPackageDescription :: Monad m => PackageDescription -> CheckM m () +checkPackageDescription + pkg@( PackageDescription + specVersion_ + package_ + licenseRaw_ + licenseFiles_ + _copyright_ + maintainer_ + _author_ + _stability_ + testedWith_ + _homepage_ + _pkgUrl_ + _bugReports_ + sourceRepos_ + synopsis_ + description_ + category_ + customFieldsPD_ + buildTypeRaw_ + setupBuildInfo_ + _library_ + _subLibraries_ + _executables_ + _foreignLibs_ + _testSuites_ + _benchmarks_ + dataFiles_ + dataDir_ + extraSrcFiles_ + extraTmpFiles_ + extraDocFiles_ + ) = do + -- § Sanity checks. + checkPackageId package_ + -- TODO `name` is caught at parse level, remove this test. + let pn = packageName package_ + checkP + (null . unPackageName $ pn) + (PackageBuildImpossible NoNameField) + -- TODO `version` is caught at parse level, remove this test. + checkP + (nullVersion == packageVersion package_) + (PackageBuildImpossible NoVersionField) + -- But it is OK for executables to have the same name. + nsubs <- asksCM (pnSubLibs . ccNames) + checkP + (any (== prettyShow pn) (prettyShow <$> nsubs)) + (PackageBuildImpossible $ IllegalLibraryName pn) + + -- § Fields check. + checkNull + category_ + (PackageDistSuspicious $ MissingField CEFCategory) + checkNull + maintainer_ + (PackageDistSuspicious $ MissingField CEFMaintainer) + checkP + (ShortText.null synopsis_ && not (ShortText.null description_)) + (PackageDistSuspicious $ MissingField CEFSynopsis) + checkP + (ShortText.null description_ && not (ShortText.null synopsis_)) + (PackageDistSuspicious $ MissingField CEFDescription) + checkP + (all ShortText.null [synopsis_, description_]) + (PackageDistInexcusable $ MissingField CEFSynOrDesc) + checkP + (ShortText.length synopsis_ > 80) + (PackageDistSuspicious SynopsisTooLong) + checkP + ( not (ShortText.null description_) + && ShortText.length description_ <= ShortText.length synopsis_ + ) + (PackageDistSuspicious ShortDesc) + + -- § Paths. + mapM_ (checkPath False "extra-source-files" PathKindGlob) extraSrcFiles_ + mapM_ (checkPath False "extra-tmp-files" PathKindFile) extraTmpFiles_ + mapM_ (checkPath False "extra-doc-files" PathKindGlob) extraDocFiles_ + mapM_ (checkPath False "data-files" PathKindGlob) dataFiles_ + checkPath True "data-dir" PathKindDirectory dataDir_ + let licPaths = map getSymbolicPath licenseFiles_ + mapM_ (checkPath False "license-file" PathKindFile) licPaths + mapM_ checkLicFileExist licenseFiles_ + + -- § Globs. + dataGlobs <- mapM (checkGlob "data-files") dataFiles_ + extraGlobs <- mapM (checkGlob "extra-source-files") extraSrcFiles_ + docGlobs <- mapM (checkGlob "extra-doc-files") extraDocFiles_ + -- We collect globs to feed them to checkMissingDocs. + + -- § Missing documentation. + checkMissingDocs + (catMaybes dataGlobs) + (catMaybes extraGlobs) + (catMaybes docGlobs) + + -- § Datafield checks. + checkSetupBuildInfo setupBuildInfo_ + mapM_ checkTestedWith testedWith_ + either + checkNewLicense + (checkOldLicense $ null licenseFiles_) + licenseRaw_ + checkSourceRepos sourceRepos_ + mapM_ checkCustomField customFieldsPD_ + + -- Feature checks. + checkSpecVer + CabalSpecV1_18 + (not . null $ extraDocFiles_) + (PackageDistInexcusable CVExtraDocFiles) + checkSpecVer + CabalSpecV1_6 + (not . null $ sourceRepos_) + (PackageDistInexcusable CVSourceRepository) + checkP + ( specVersion_ >= CabalSpecV1_24 + && isNothing setupBuildInfo_ + && buildTypeRaw_ == Just Custom + ) + (PackageBuildWarning CVCustomSetup) + checkSpecVer + CabalSpecV1_24 + ( isNothing setupBuildInfo_ + && buildTypeRaw_ == Just Custom + ) + (PackageDistSuspiciousWarn CVExpliticDepsCustomSetup) + checkP + (isNothing buildTypeRaw_ && specVersion_ < CabalSpecV2_2) + (PackageBuildWarning NoBuildType) + checkP + (isJust setupBuildInfo_ && buildType pkg /= Custom) + (PackageBuildWarning NoCustomSetup) + + -- Contents. + checkConfigureExists (buildType pkg) + checkSetupExists (buildType pkg) + checkCabalFile (packageName pkg) + mapM_ (checkGlobFile specVersion_ "." "extra-source-files") extraSrcFiles_ + mapM_ (checkGlobFile specVersion_ "." "extra-doc-files") extraDocFiles_ + mapM_ (checkGlobFile specVersion_ dataDir_ "data-files") dataFiles_ + where + checkNull + :: Monad m + => ShortText.ShortText + -> PackageCheck + -> CheckM m () + checkNull st c = checkP (ShortText.null st) c + + checkTestedWith + :: Monad m + => (CompilerFlavor, VersionRange) + -> CheckM m () + checkTestedWith (OtherCompiler n, _) = + tellP (PackageBuildWarning $ UnknownCompilers [n]) + checkTestedWith (compiler, versionRange) = + checkVersionRange compiler versionRange + + checkVersionRange + :: Monad m + => CompilerFlavor + -> VersionRange + -> CheckM m () + checkVersionRange cmp vr = + when + (isNoVersion vr) + ( let dep = + [ Dependency + (mkPackageName (prettyShow cmp)) + vr + mainLibSet + ] + in tellP (PackageDistInexcusable (InvalidTestWith dep)) + ) - depMissingInternalExecutable = - [ dep - | dep@(ExeDependency _ eName _) <- internalExeDeps - , not $ eName `elem` internalExecutables +checkSetupBuildInfo :: Monad m => Maybe SetupBuildInfo -> CheckM m () +checkSetupBuildInfo Nothing = return () +checkSetupBuildInfo (Just (SetupBuildInfo ds _)) = do + let uqs = map mkUnqualComponentName ["base", "Cabal"] + (is, rs) <- partitionDeps [] uqs ds + let ick = PackageDistInexcusable . UpperBoundSetup + rck = + PackageDistSuspiciousWarn + . MissingUpperBounds CETSetup + checkPVP ick is + checkPVPs rck rs + +checkPackageId :: Monad m => PackageIdentifier -> CheckM m () +checkPackageId (PackageIdentifier pkgName_ _pkgVersion_) = do + checkP + (not . FilePath.Windows.isValid . prettyShow $ pkgName_) + (PackageDistInexcusable $ InvalidNameWin pkgName_) + checkP (isPrefixOf "z-" . prettyShow $ pkgName_) $ + (PackageDistInexcusable ZPrefix) + +checkNewLicense :: Monad m => SPDX.License -> CheckM m () +checkNewLicense lic = do + checkP + (lic == SPDX.NONE) + (PackageDistInexcusable NONELicense) + +checkOldLicense + :: Monad m + => Bool -- Flag: no license file? + -> License + -> CheckM m () +checkOldLicense nullLicFiles lic = do + checkP + (lic == UnspecifiedLicense) + (PackageDistInexcusable NoLicense) + checkP + (lic == AllRightsReserved) + (PackageDistSuspicious AllRightsReservedLicense) + checkSpecVer + CabalSpecV1_4 + (lic `notElem` compatLicenses) + (PackageDistInexcusable (LicenseMessParse lic)) + checkP + (lic == BSD4) + (PackageDistSuspicious UncommonBSD4) + case lic of + UnknownLicense l -> + tellP (PackageBuildWarning (UnrecognisedLicense l)) + _ -> return () + checkP + ( lic + `notElem` [ AllRightsReserved + , UnspecifiedLicense + , PublicDomain + ] + && + -- AllRightsReserved and PublicDomain are not strictly + -- licenses so don't need license files. + nullLicFiles + ) + $ (PackageDistSuspicious NoLicenseFile) + case unknownLicenseVersion lic of + Just knownVersions -> + tellP + (PackageDistSuspicious $ UnknownLicenseVersion lic knownVersions) + _ -> return () + where + compatLicenses = + [ GPL Nothing + , LGPL Nothing + , AGPL Nothing + , BSD3 + , BSD4 + , PublicDomain + , AllRightsReserved + , UnspecifiedLicense + , OtherLicense ] -checkLicense :: PackageDescription -> [PackageCheck] -checkLicense pkg = case licenseRaw pkg of - Right l -> checkOldLicense pkg l - Left l -> checkNewLicense pkg l - -checkNewLicense :: PackageDescription -> SPDX.License -> [PackageCheck] -checkNewLicense _pkg lic = - catMaybes - [ check (lic == SPDX.NONE) $ - PackageDistInexcusable NONELicense - ] - -checkOldLicense :: PackageDescription -> License -> [PackageCheck] -checkOldLicense pkg lic = - catMaybes - [ check (lic == UnspecifiedLicense) $ - PackageDistInexcusable NoLicense - , check (lic == AllRightsReserved) $ - PackageDistSuspicious AllRightsReservedLicense - , checkVersion CabalSpecV1_4 (lic `notElem` compatLicenses) $ - PackageDistInexcusable (LicenseMessParse pkg) - , case lic of - UnknownLicense l -> Just $ PackageBuildWarning (UnrecognisedLicense l) - _ -> Nothing - , check (lic == BSD4) $ - PackageDistSuspicious UncommonBSD4 - , case unknownLicenseVersion lic of - Just knownVersions -> - Just $ - PackageDistSuspicious (UnknownLicenseVersion lic knownVersions) - _ -> Nothing - , check - ( lic - `notElem` [ AllRightsReserved - , UnspecifiedLicense - , PublicDomain - ] - -- AllRightsReserved and PublicDomain are not strictly - -- licenses so don't need license files. - && null (licenseFiles pkg) - ) - $ PackageDistSuspicious NoLicenseFile - ] - where unknownLicenseVersion (GPL (Just v)) | v `notElem` knownVersions = Just knownVersions where @@ -1462,1773 +636,432 @@ checkOldLicense pkg lic = knownVersions = [v' | Apache (Just v') <- knownLicenses] unknownLicenseVersion _ = Nothing - checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck - checkVersion ver cond pc - | specVersion pkg >= ver = Nothing - | otherwise = check cond pc - - compatLicenses = - [ GPL Nothing - , LGPL Nothing - , AGPL Nothing - , BSD3 - , BSD4 - , PublicDomain - , AllRightsReserved - , UnspecifiedLicense - , OtherLicense - ] - -checkSourceRepos :: PackageDescription -> [PackageCheck] -checkSourceRepos pkg = - catMaybes $ - concat - [ [ case repoKind repo of - RepoKindUnknown kind -> - Just $ - PackageDistInexcusable $ - UnrecognisedSourceRepo kind - _ -> Nothing - , check (isNothing (repoType repo)) $ - PackageDistInexcusable MissingType - , check (isNothing (repoLocation repo)) $ - PackageDistInexcusable MissingLocation - , check (repoType repo == Just (KnownRepoType CVS) && isNothing (repoModule repo)) $ - PackageDistInexcusable MissingModule - , check (repoKind repo == RepoThis && isNothing (repoTag repo)) $ - PackageDistInexcusable MissingTag - , check (maybe False isAbsoluteOnAnyPlatform (repoSubdir repo)) $ - PackageDistInexcusable SubdirRelPath - , do - subdir <- repoSubdir repo - err <- isGoodRelativeDirectoryPath subdir - return $ PackageDistInexcusable (SubdirGoodRelPath err) - ] - | repo <- sourceRepos pkg - ] - --- TODO: check location looks like a URL for some repo types. - --- | Checks GHC options from all ghc-*-options fields in the given --- PackageDescription and reports commonly misused or non-portable flags -checkAllGhcOptions :: PackageDescription -> [PackageCheck] -checkAllGhcOptions pkg = - checkGhcOptions "ghc-options" (hcOptions GHC) pkg - ++ checkGhcOptions "ghc-prof-options" (hcProfOptions GHC) pkg - ++ checkGhcOptions "ghc-shared-options" (hcSharedOptions GHC) pkg - --- | Extracts GHC options belonging to the given field from the given --- PackageDescription using given function and checks them for commonly misused --- or non-portable flags -checkGhcOptions :: String -> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck] -checkGhcOptions fieldName getOptions pkg = - catMaybes - [ checkFlags ["-fasm"] $ - PackageDistInexcusable (OptFasm fieldName) - , checkFlags ["-fvia-C"] $ - PackageDistSuspicious (OptViaC fieldName) - , checkFlags ["-fhpc"] $ - PackageDistInexcusable (OptHpc fieldName) - , checkFlags ["-prof"] $ - PackageBuildWarning (OptProf fieldName) - , unlessScript . checkFlags ["-o"] $ - PackageBuildWarning (OptO fieldName) - , checkFlags ["-hide-package"] $ - PackageBuildWarning (OptHide fieldName) - , checkFlags ["--make"] $ - PackageBuildWarning (OptMake fieldName) - , checkNonTestAndBenchmarkFlags ["-O0", "-Onot"] $ - PackageDistSuspicious (OptONot fieldName) - , checkTestAndBenchmarkFlags ["-O0", "-Onot"] $ - PackageDistSuspiciousWarn (OptONot fieldName) - , checkFlags ["-O", "-O1"] $ - PackageDistInexcusable (OptOOne fieldName) - , checkFlags ["-O2"] $ - PackageDistSuspiciousWarn (OptOTwo fieldName) - , checkFlags ["-split-sections"] $ - PackageBuildWarning (OptSplitSections fieldName) - , checkFlags ["-split-objs"] $ - PackageBuildWarning (OptSplitObjs fieldName) - , checkFlags ["-optl-Wl,-s", "-optl-s"] $ - PackageDistInexcusable (OptWls fieldName) - , checkFlags ["-fglasgow-exts"] $ - PackageDistSuspicious (OptExts fieldName) - , check ("-rtsopts" `elem` lib_ghc_options) $ - PackageBuildWarning (OptRts fieldName) - , check (any (\opt -> "-with-rtsopts" `isPrefixOf` opt) lib_ghc_options) $ - PackageBuildWarning (OptWithRts fieldName) - , checkAlternatives - fieldName - "extensions" - [ (flag, prettyShow extension) | flag <- ghc_options_no_rtsopts, Just extension <- [ghcExtension flag] - ] - , checkAlternatives - fieldName - "extensions" - [(flag, extension) | flag@('-' : 'X' : extension) <- ghc_options_no_rtsopts] - , checkAlternatives fieldName "cpp-options" $ - [(flag, flag) | flag@('-' : 'D' : _) <- ghc_options_no_rtsopts] - ++ [(flag, flag) | flag@('-' : 'U' : _) <- ghc_options_no_rtsopts] - , checkAlternatives - fieldName - "include-dirs" - [(flag, dir) | flag@('-' : 'I' : dir) <- ghc_options_no_rtsopts] - , checkAlternatives - fieldName - "extra-libraries" - [(flag, lib) | flag@('-' : 'l' : lib) <- ghc_options_no_rtsopts] - , checkAlternatives - fieldName - "extra-libraries-static" - [(flag, lib) | flag@('-' : 'l' : lib) <- ghc_options_no_rtsopts] - , checkAlternatives - fieldName - "extra-lib-dirs" - [(flag, dir) | flag@('-' : 'L' : dir) <- ghc_options_no_rtsopts] - , checkAlternatives - fieldName - "extra-lib-dirs-static" - [(flag, dir) | flag@('-' : 'L' : dir) <- ghc_options_no_rtsopts] - , checkAlternatives - fieldName - "frameworks" - [ (flag, fmwk) - | (flag@"-framework", fmwk) <- - zip ghc_options_no_rtsopts (safeTail ghc_options_no_rtsopts) - ] - , checkAlternatives - fieldName - "extra-framework-dirs" - [ (flag, dir) - | (flag@"-framework-path", dir) <- - zip ghc_options_no_rtsopts (safeTail ghc_options_no_rtsopts) - ] - ] - where - all_ghc_options = concatMap getOptions (allBuildInfo pkg) - ghc_options_no_rtsopts = rmRtsOpts all_ghc_options - lib_ghc_options = - concatMap - (getOptions . libBuildInfo) - (allLibraries pkg) - test_ghc_options = - concatMap - (getOptions . testBuildInfo) - (testSuites pkg) - benchmark_ghc_options = - concatMap - (getOptions . benchmarkBuildInfo) - (benchmarks pkg) - test_and_benchmark_ghc_options = - test_ghc_options - ++ benchmark_ghc_options - non_test_and_benchmark_ghc_options = - concatMap - getOptions - ( allBuildInfo - ( pkg - { testSuites = [] - , benchmarks = [] - } - ) - ) - - checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck - checkFlags flags = check (any (`elem` flags) all_ghc_options) - - unlessScript :: Maybe PackageCheck -> Maybe PackageCheck - unlessScript pc - | packageId pkg == fakePackageId = Nothing - | otherwise = pc - - checkTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck - checkTestAndBenchmarkFlags flags = check (any (`elem` flags) test_and_benchmark_ghc_options) - - checkNonTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck - checkNonTestAndBenchmarkFlags flags = check (any (`elem` flags) non_test_and_benchmark_ghc_options) - - ghcExtension ('-' : 'f' : name) = case name of - "allow-overlapping-instances" -> enable OverlappingInstances - "no-allow-overlapping-instances" -> disable OverlappingInstances - "th" -> enable TemplateHaskell - "no-th" -> disable TemplateHaskell - "ffi" -> enable ForeignFunctionInterface - "no-ffi" -> disable ForeignFunctionInterface - "fi" -> enable ForeignFunctionInterface - "no-fi" -> disable ForeignFunctionInterface - "monomorphism-restriction" -> enable MonomorphismRestriction - "no-monomorphism-restriction" -> disable MonomorphismRestriction - "mono-pat-binds" -> enable MonoPatBinds - "no-mono-pat-binds" -> disable MonoPatBinds - "allow-undecidable-instances" -> enable UndecidableInstances - "no-allow-undecidable-instances" -> disable UndecidableInstances - "allow-incoherent-instances" -> enable IncoherentInstances - "no-allow-incoherent-instances" -> disable IncoherentInstances - "arrows" -> enable Arrows - "no-arrows" -> disable Arrows - "generics" -> enable Generics - "no-generics" -> disable Generics - "implicit-prelude" -> enable ImplicitPrelude - "no-implicit-prelude" -> disable ImplicitPrelude - "implicit-params" -> enable ImplicitParams - "no-implicit-params" -> disable ImplicitParams - "bang-patterns" -> enable BangPatterns - "no-bang-patterns" -> disable BangPatterns - "scoped-type-variables" -> enable ScopedTypeVariables - "no-scoped-type-variables" -> disable ScopedTypeVariables - "extended-default-rules" -> enable ExtendedDefaultRules - "no-extended-default-rules" -> disable ExtendedDefaultRules - _ -> Nothing - ghcExtension "-cpp" = enable CPP - ghcExtension _ = Nothing - - enable e = Just (EnableExtension e) - disable e = Just (DisableExtension e) - - rmRtsOpts :: [String] -> [String] - rmRtsOpts ("-with-rtsopts" : _ : xs) = rmRtsOpts xs - rmRtsOpts (x : xs) = x : rmRtsOpts xs - rmRtsOpts [] = [] - -checkCCOptions :: PackageDescription -> [PackageCheck] -checkCCOptions = checkCLikeOptions "C" "cc-options" ccOptions - -checkCxxOptions :: PackageDescription -> [PackageCheck] -checkCxxOptions = checkCLikeOptions "C++" "cxx-options" cxxOptions - -checkCLikeOptions :: String -> String -> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck] -checkCLikeOptions label prefix accessor pkg = - catMaybes - [ checkAlternatives - prefix - "include-dirs" - [(flag, dir) | flag@('-' : 'I' : dir) <- all_cLikeOptions] - , checkAlternatives - prefix - "extra-libraries" - [(flag, lib) | flag@('-' : 'l' : lib) <- all_cLikeOptions] - , checkAlternatives - prefix - "extra-lib-dirs" - [(flag, dir) | flag@('-' : 'L' : dir) <- all_cLikeOptions] - , checkAlternatives - "ld-options" - "extra-libraries" - [(flag, lib) | flag@('-' : 'l' : lib) <- all_ldOptions] - , checkAlternatives - "ld-options" - "extra-lib-dirs" - [(flag, dir) | flag@('-' : 'L' : dir) <- all_ldOptions] - , checkCCFlags ["-O", "-Os", "-O0", "-O1", "-O2", "-O3"] $ - PackageDistSuspicious (COptONumber prefix label) - ] - where - all_cLikeOptions = - [ opts | bi <- allBuildInfo pkg, opts <- accessor bi - ] - all_ldOptions = - [ opts | bi <- allBuildInfo pkg, opts <- ldOptions bi - ] - - checkCCFlags :: [String] -> PackageCheck -> Maybe PackageCheck - checkCCFlags flags = check (any (`elem` flags) all_cLikeOptions) - -checkCPPOptions :: PackageDescription -> [PackageCheck] -checkCPPOptions pkg = - catMaybes - [ checkAlternatives - "cpp-options" - "include-dirs" - [(flag, dir) | flag@('-' : 'I' : dir) <- all_cppOptions] - ] - ++ [ PackageBuildWarning (COptCPP opt) - | opt <- all_cppOptions - , -- "-I" is handled above, we allow only -DNEWSTUFF and -UOLDSTUFF - not $ any (`isPrefixOf` opt) ["-D", "-U", "-I"] - ] - where - all_cppOptions = [opts | bi <- allBuildInfo pkg, opts <- cppOptions bi] - -checkAlternatives - :: String - -> String - -> [(String, String)] - -> Maybe PackageCheck -checkAlternatives badField goodField flags = - check (not (null badFlags)) $ - PackageBuildWarning (OptAlternatives badField goodField flags) +checkSourceRepos :: Monad m => [SourceRepo] -> CheckM m () +checkSourceRepos rs = do + mapM_ repoCheck rs + checkMissingVcsInfo rs where - (badFlags, _) = unzip flags - -data PathKind - = PathKindFile - | PathKindDirectory - | PathKindGlob - deriving (Eq) - -checkPaths :: PackageDescription -> [PackageCheck] -checkPaths pkg = - checkPackageFileNamesWithGlob - [ (kind == PathKindGlob, path) - | (path, _, kind) <- relPaths ++ absPaths - ] - ++ [ PackageBuildWarning (RelativeOutside field path) - | (path, field, _) <- relPaths ++ absPaths - , isOutsideTree path - ] - ++ [ PackageDistInexcusable (AbsolutePath field path) - | (path, field, _) <- relPaths - , isAbsoluteOnAnyPlatform path - ] - ++ [ PackageDistInexcusable (BadRelativePAth field path err) - | (path, field, kind) <- relPaths - , -- these are not paths, but globs... - err <- maybeToList $ case kind of - PathKindFile -> isGoodRelativeFilePath path - PathKindGlob -> isGoodRelativeGlob path - PathKindDirectory -> isGoodRelativeDirectoryPath path - ] - ++ [ PackageDistInexcusable $ DistPoint (Just field) path - | (path, field, _) <- relPaths ++ absPaths - , isInsideDist path - ] - ++ [ PackageDistInexcusable (DistPoint Nothing path) - | bi <- allBuildInfo pkg - , (GHC, flags) <- perCompilerFlavorToList $ options bi - , path <- flags - , isInsideDist path - ] - ++ [ PackageDistInexcusable $ - GlobSyntaxError "data-files" (explainGlobSyntaxError pat err) - | (Left err, pat) <- zip globsDataFiles $ dataFiles pkg - ] - ++ [ PackageDistInexcusable - (GlobSyntaxError "extra-source-files" (explainGlobSyntaxError pat err)) - | (Left err, pat) <- zip globsExtraSrcFiles $ extraSrcFiles pkg - ] - ++ [ PackageDistInexcusable $ - GlobSyntaxError "extra-doc-files" (explainGlobSyntaxError pat err) - | (Left err, pat) <- zip globsExtraDocFiles $ extraDocFiles pkg - ] - ++ [ PackageDistSuspiciousWarn $ - RecursiveGlobInRoot "data-files" pat - | (Right glob, pat) <- zip globsDataFiles $ dataFiles pkg - , isRecursiveInRoot glob - ] - ++ [ PackageDistSuspiciousWarn $ - RecursiveGlobInRoot "extra-source-files" pat - | (Right glob, pat) <- zip globsExtraSrcFiles $ extraSrcFiles pkg - , isRecursiveInRoot glob - ] - ++ [ PackageDistSuspiciousWarn $ - RecursiveGlobInRoot "extra-doc-files" pat - | (Right glob, pat) <- zip globsExtraDocFiles $ extraDocFiles pkg - , isRecursiveInRoot glob - ] - where - isOutsideTree path = case splitDirectories path of - ".." : _ -> True - "." : ".." : _ -> True - _ -> False - isInsideDist path = case map lowercase (splitDirectories path) of - "dist" : _ -> True - "." : "dist" : _ -> True - _ -> False - - -- paths that must be relative - relPaths :: [(FilePath, String, PathKind)] - relPaths = - [(path, "extra-source-files", PathKindGlob) | path <- extraSrcFiles pkg] - ++ [(path, "extra-tmp-files", PathKindFile) | path <- extraTmpFiles pkg] - ++ [(path, "extra-doc-files", PathKindGlob) | path <- extraDocFiles pkg] - ++ [(path, "data-files", PathKindGlob) | path <- dataFiles pkg] - ++ [(path, "data-dir", PathKindDirectory) | path <- [dataDir pkg]] - ++ [(path, "license-file", PathKindFile) | path <- map getSymbolicPath $ licenseFiles pkg] - ++ concat - [ [(path, "asm-sources", PathKindFile) | path <- asmSources bi] - ++ [(path, "cmm-sources", PathKindFile) | path <- cmmSources bi] - ++ [(path, "c-sources", PathKindFile) | path <- cSources bi] - ++ [(path, "cxx-sources", PathKindFile) | path <- cxxSources bi] - ++ [(path, "js-sources", PathKindFile) | path <- jsSources bi] - ++ [(path, "install-includes", PathKindFile) | path <- installIncludes bi] - ++ [(path, "hs-source-dirs", PathKindDirectory) | path <- map getSymbolicPath $ hsSourceDirs bi] - | bi <- allBuildInfo pkg - ] - - -- paths that are allowed to be absolute - absPaths :: [(FilePath, String, PathKind)] - absPaths = - concat - [ [(path, "includes", PathKindFile) | path <- includes bi] - ++ [(path, "include-dirs", PathKindDirectory) | path <- includeDirs bi] - ++ [(path, "extra-lib-dirs", PathKindDirectory) | path <- extraLibDirs bi] - ++ [(path, "extra-lib-dirs-static", PathKindDirectory) | path <- extraLibDirsStatic bi] - | bi <- allBuildInfo pkg - ] - globsDataFiles :: [Either GlobSyntaxError Glob] - globsDataFiles = parseFileGlob (specVersion pkg) <$> dataFiles pkg - globsExtraSrcFiles :: [Either GlobSyntaxError Glob] - globsExtraSrcFiles = parseFileGlob (specVersion pkg) <$> extraSrcFiles pkg - globsExtraDocFiles :: [Either GlobSyntaxError Glob] - globsExtraDocFiles = parseFileGlob (specVersion pkg) <$> extraDocFiles pkg - --- TODO: check sets of paths that would be interpreted differently between Unix --- and windows, ie case-sensitive or insensitive. Things that might clash, or --- conversely be distinguished. - --- TODO: use the tar path checks on all the above paths - --- | Check that the package declares the version in the @\"cabal-version\"@ --- field correctly. -checkCabalVersion :: PackageDescription -> [PackageCheck] -checkCabalVersion pkg = - catMaybes - [ -- check use of test suite sections - checkVersion CabalSpecV1_8 (not (null $ testSuites pkg)) $ - PackageDistInexcusable CVTestSuite - , -- check use of default-language field - -- note that we do not need to do an equivalent check for the - -- other-language field since that one does not change behaviour - checkVersion CabalSpecV1_10 (any isJust (buildInfoField defaultLanguage)) $ - PackageBuildWarning CVDefaultLanguage - , check - ( specVersion pkg >= CabalSpecV1_10 - && specVersion pkg < CabalSpecV3_4 - && any isNothing (buildInfoField defaultLanguage) - ) - $ PackageBuildWarning CVDefaultLanguageComponent - , checkVersion - CabalSpecV1_18 - (not . null $ extraDocFiles pkg) - $ PackageDistInexcusable CVExtraDocFiles - , checkVersion - CabalSpecV2_0 - (not (null (subLibraries pkg))) - $ PackageDistInexcusable CVMultiLib - , -- check use of reexported-modules sections - checkVersion - CabalSpecV1_22 - (any (not . null . reexportedModules) (allLibraries pkg)) - $ PackageDistInexcusable CVReexported - , -- check use of thinning and renaming - checkVersion CabalSpecV2_0 usesBackpackIncludes $ - PackageDistInexcusable CVMixins - , -- check use of 'extra-framework-dirs' field - checkVersion CabalSpecV1_24 (any (not . null) (buildInfoField extraFrameworkDirs)) $ - -- Just a warning, because this won't break on old Cabal versions. - PackageDistSuspiciousWarn CVExtraFrameworkDirs - , -- check use of default-extensions field - -- don't need to do the equivalent check for other-extensions - checkVersion CabalSpecV1_10 (any (not . null) (buildInfoField defaultExtensions)) $ - PackageBuildWarning CVDefaultExtensions - , -- check use of extensions field - check - ( specVersion pkg >= CabalSpecV1_10 - && any (not . null) (buildInfoField oldExtensions) - ) - $ PackageBuildWarning CVExtensionsDeprecated - , checkVersion - CabalSpecV3_0 - ( any - (not . null) - ( concatMap - buildInfoField - [ asmSources - , cmmSources - , extraBundledLibs - , extraLibFlavours - ] - ) - ) - $ PackageDistInexcusable CVSources - , checkVersion CabalSpecV3_0 (any (not . null) $ buildInfoField extraDynLibFlavours) $ - PackageDistInexcusable - (CVExtraDynamic $ buildInfoField extraDynLibFlavours) - , checkVersion - CabalSpecV2_2 - ( any - (not . null) - (buildInfoField virtualModules) - ) - $ PackageDistInexcusable CVVirtualModules - , -- check use of "source-repository" section - checkVersion CabalSpecV1_6 (not (null (sourceRepos pkg))) $ - PackageDistInexcusable CVSourceRepository - , -- check for new language extensions - checkVersion CabalSpecV1_2 (not (null mentionedExtensionsThatNeedCabal12)) $ - PackageDistInexcusable - (CVExtensions CabalSpecV1_2 mentionedExtensionsThatNeedCabal12) - , checkVersion CabalSpecV1_4 (not (null mentionedExtensionsThatNeedCabal14)) $ - PackageDistInexcusable - (CVExtensions CabalSpecV1_4 mentionedExtensionsThatNeedCabal14) - , check - ( specVersion pkg >= CabalSpecV1_24 - && isNothing (setupBuildInfo pkg) - && buildType pkg == Custom - ) - $ PackageBuildWarning CVCustomSetup - , check - ( specVersion pkg < CabalSpecV1_24 - && isNothing (setupBuildInfo pkg) - && buildType pkg == Custom - ) - $ PackageDistSuspiciousWarn CVExpliticDepsCustomSetup - , check - ( specVersion pkg >= CabalSpecV2_0 - && elem (autogenPathsModuleName pkg) allModuleNames - && not (elem (autogenPathsModuleName pkg) allModuleNamesAutogen) - ) - $ PackageDistInexcusable CVAutogenPaths - , check - ( specVersion pkg >= CabalSpecV2_0 - && elem (autogenPackageInfoModuleName pkg) allModuleNames - && not (elem (autogenPackageInfoModuleName pkg) allModuleNamesAutogen) + -- Single repository checks. + repoCheck :: Monad m => SourceRepo -> CheckM m () + repoCheck + ( SourceRepo + repoKind_ + repoType_ + repoLocation_ + repoModule_ + _repoBranch_ + repoTag_ + repoSubdir_ + ) = do + case repoKind_ of + RepoKindUnknown kind -> + tellP + (PackageDistInexcusable $ UnrecognisedSourceRepo kind) + _ -> return () + checkP + (isNothing repoType_) + (PackageDistInexcusable MissingType) + checkP + (isNothing repoLocation_) + (PackageDistInexcusable MissingLocation) + checkP + ( repoType_ == Just (KnownRepoType CVS) + && isNothing repoModule_ + ) + (PackageDistInexcusable MissingModule) + checkP + (repoKind_ == RepoThis && isNothing repoTag_) + (PackageDistInexcusable MissingTag) + checkP + (any isAbsoluteOnAnyPlatform repoSubdir_) + (PackageDistInexcusable SubdirRelPath) + case join . fmap isGoodRelativeDirectoryPath $ repoSubdir_ of + Just err -> + tellP + (PackageDistInexcusable $ SubdirGoodRelPath err) + Nothing -> return () + +checkMissingVcsInfo :: Monad m => [SourceRepo] -> CheckM m () +checkMissingVcsInfo rs = + let rdirs = concatMap repoTypeDirname knownRepoTypes + in checkPkg + ( \ops -> do + us <- or <$> traverse (doesDirectoryExist ops) rdirs + return (null rs && us) ) - $ PackageDistInexcusable CVAutogenPackageInfo - ] + (PackageDistSuspicious MissingSourceControl) where - -- Perform a check on packages that use a version of the spec less than - -- the version given. This is for cases where a new Cabal version adds - -- a new feature and we want to check that it is not used prior to that - -- version. - checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck - checkVersion ver cond pc - | specVersion pkg >= ver = Nothing - | otherwise = check cond pc - - buildInfoField field = map field (allBuildInfo pkg) - - usesBackpackIncludes = any (not . null . mixins) (allBuildInfo pkg) - - mentionedExtensions = - [ ext | bi <- allBuildInfo pkg, ext <- allExtensions bi - ] - mentionedExtensionsThatNeedCabal12 = - nub (filter (`elem` compatExtensionsExtra) mentionedExtensions) - - -- As of Cabal-1.4 we can add new extensions without worrying about - -- breaking old versions of cabal. - mentionedExtensionsThatNeedCabal14 = - nub (filter (`notElem` compatExtensions) mentionedExtensions) - - -- The known extensions in Cabal-1.2.3 - compatExtensions = - map - EnableExtension - [ OverlappingInstances - , UndecidableInstances - , IncoherentInstances - , RecursiveDo - , ParallelListComp - , MultiParamTypeClasses - , FunctionalDependencies - , Rank2Types - , RankNTypes - , PolymorphicComponents - , ExistentialQuantification - , ScopedTypeVariables - , ImplicitParams - , FlexibleContexts - , FlexibleInstances - , EmptyDataDecls - , CPP - , BangPatterns - , TypeSynonymInstances - , TemplateHaskell - , ForeignFunctionInterface - , Arrows - , Generics - , NamedFieldPuns - , PatternGuards - , GeneralizedNewtypeDeriving - , ExtensibleRecords - , RestrictedTypeSynonyms - , HereDocuments - ] - ++ map - DisableExtension - [MonomorphismRestriction, ImplicitPrelude] - ++ compatExtensionsExtra - - -- The extra known extensions in Cabal-1.2.3 vs Cabal-1.1.6 - -- (Cabal-1.1.6 came with ghc-6.6. Cabal-1.2 came with ghc-6.8) - compatExtensionsExtra = - map - EnableExtension - [ KindSignatures - , MagicHash - , TypeFamilies - , StandaloneDeriving - , UnicodeSyntax - , PatternSignatures - , UnliftedFFITypes - , LiberalTypeSynonyms - , TypeOperators - , RecordWildCards - , RecordPuns - , DisambiguateRecordFields - , OverloadedStrings - , GADTs - , RelaxedPolyRec - , ExtendedDefaultRules - , UnboxedTuples - , DeriveDataTypeable - , ConstrainedClassMethods - ] - ++ map - DisableExtension - [MonoPatBinds] - - allModuleNames = - ( case library pkg of - Nothing -> [] - (Just lib) -> explicitLibModules lib - ) - ++ concatMap otherModules (allBuildInfo pkg) - - allModuleNamesAutogen = concatMap autogenModules (allBuildInfo pkg) + repoTypeDirname :: KnownRepoType -> [FilePath] + repoTypeDirname Darcs = ["_darcs"] + repoTypeDirname Git = [".git"] + repoTypeDirname SVN = [".svn"] + repoTypeDirname CVS = ["CVS"] + repoTypeDirname Mercurial = [".hg"] + repoTypeDirname GnuArch = [".arch-params"] + repoTypeDirname Bazaar = [".bzr"] + repoTypeDirname Monotone = ["_MTN"] + repoTypeDirname Pijul = [".pijul"] -- ------------------------------------------------------------ - --- * Checks on the GenericPackageDescription - +-- Package and distribution checks -- ------------------------------------------------------------ --- | Check the build-depends fields for any weirdness or bad practice. -checkPackageVersions :: GenericPackageDescription -> [PackageCheck] -checkPackageVersions pkg = - -- if others is empty, - -- the error will still fire but listing no dependencies. - -- so we have to check - if length others > 0 - then PackageDistSuspiciousWarn (MissingUpperBounds others) : baseErrors - else baseErrors - where - baseErrors = PackageDistInexcusable BaseNoUpperBounds <$ bases - deps = toDependencyVersionsMap allNonInternalBuildDepends pkg - -- base gets special treatment (it's more critical) - (bases, others) = - partition (("base" ==) . unPackageName) $ - [ name - | (name, vr) <- Map.toList deps - , not (hasUpperBound vr) - ] - - -- Get the combined build-depends entries of all components. - allNonInternalBuildDepends :: PackageDescription -> [Dependency] - allNonInternalBuildDepends = targetBuildDepends CM.<=< allNonInternalBuildInfo - - allNonInternalBuildInfo :: PackageDescription -> [BuildInfo] - allNonInternalBuildInfo pkg_descr = - [bi | lib <- allLibraries pkg_descr, let bi = libBuildInfo lib] - ++ [bi | flib <- foreignLibs pkg_descr, let bi = foreignLibBuildInfo flib] - ++ [bi | exe <- executables pkg_descr, let bi = buildInfo exe] - -checkConditionals :: GenericPackageDescription -> [PackageCheck] -checkConditionals pkg = - catMaybes - [ check (not $ null unknownOSs) $ - PackageDistInexcusable (UnknownOS unknownOSs) - , check (not $ null unknownArches) $ - PackageDistInexcusable (UnknownArch unknownArches) - , check (not $ null unknownImpls) $ - PackageDistInexcusable (UnknownCompiler unknownImpls) - ] - where - unknownOSs = [os | OS (OtherOS os) <- conditions] - unknownArches = [arch | Arch (OtherArch arch) <- conditions] - unknownImpls = [impl | Impl (OtherCompiler impl) _ <- conditions] - conditions = - concatMap fvs (maybeToList (condLibrary pkg)) - ++ concatMap (fvs . snd) (condSubLibraries pkg) - ++ concatMap (fvs . snd) (condForeignLibs pkg) - ++ concatMap (fvs . snd) (condExecutables pkg) - ++ concatMap (fvs . snd) (condTestSuites pkg) - ++ concatMap (fvs . snd) (condBenchmarks pkg) - fvs (CondNode _ _ ifs) = concatMap compfv ifs -- free variables - compfv (CondBranch c ct mct) = condfv c ++ fvs ct ++ maybe [] fvs mct - condfv c = case c of - Var v -> [v] - Lit _ -> [] - CNot c1 -> condfv c1 - COr c1 c2 -> condfv c1 ++ condfv c2 - CAnd c1 c2 -> condfv c1 ++ condfv c2 - -checkFlagNames :: GenericPackageDescription -> [PackageCheck] -checkFlagNames gpd - | null invalidFlagNames = [] - | otherwise = - [PackageDistInexcusable (SuspiciousFlagName invalidFlagNames)] - where - invalidFlagNames = - [ fn - | flag <- genPackageFlags gpd - , let fn = unFlagName (flagName flag) - , invalidFlagName fn +-- | Find a package description file in the given directory. Looks for +-- @.cabal@ files. Like 'Distribution.Simple.Utils.findPackageDesc', +-- but generalized over monads. +findPackageDesc :: Monad m => CheckPackageContentOps m -> m [FilePath] +findPackageDesc ops = do + let dir = "." + files <- getDirectoryContents ops dir + -- to make sure we do not mistake a ~/.cabal/ dir for a .cabal + -- file we filter to exclude dirs and null base file names: + cabalFiles <- + filterM + (doesFileExist ops) + [ dir file + | file <- files + , let (name, ext) = splitExtension file + , not (null name) && ext == ".cabal" ] - -- starts with dash - invalidFlagName ('-' : _) = True - -- mon ascii letter - invalidFlagName cs = any (not . isAscii) cs - -checkUnusedFlags :: GenericPackageDescription -> [PackageCheck] -checkUnusedFlags gpd - | declared == used = [] - | otherwise = - [PackageDistSuspicious (DeclaredUsedFlags declared used)] - where - declared :: Set.Set FlagName - declared = toSetOf (L.genPackageFlags . traverse . L.flagName) gpd - - used :: Set.Set FlagName - used = - mconcat - [ toSetOf (L.condLibrary . traverse . traverseCondTreeV . L._PackageFlag) gpd - , toSetOf (L.condSubLibraries . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd - , toSetOf (L.condForeignLibs . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd - , toSetOf (L.condExecutables . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd - , toSetOf (L.condTestSuites . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd - , toSetOf (L.condBenchmarks . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd - ] - -checkUnicodeXFields :: GenericPackageDescription -> [PackageCheck] -checkUnicodeXFields gpd - | null nonAsciiXFields = [] - | otherwise = - [PackageDistInexcusable (NonASCIICustomField nonAsciiXFields)] - where - nonAsciiXFields :: [String] - nonAsciiXFields = [n | (n, _) <- xfields, any (not . isAscii) n] - - xfields :: [(String, String)] - xfields = - DList.runDList $ - mconcat - [ toDListOf (L.packageDescription . L.customFieldsPD . traverse) gpd - , toDListOf (L.traverseBuildInfos . L.customFieldsBI . traverse) gpd - ] - --- | cabal-version <2.2 + Paths_module + default-extensions: doesn't build. -checkPathsModuleExtensions :: PackageDescription -> [PackageCheck] -checkPathsModuleExtensions = checkAutogenModuleExtensions autogenPathsModuleName RebindableClashPaths - --- | cabal-version <2.2 + PackageInfo_module + default-extensions: doesn't build. -checkPackageInfoModuleExtensions :: PackageDescription -> [PackageCheck] -checkPackageInfoModuleExtensions = checkAutogenModuleExtensions autogenPackageInfoModuleName RebindableClashPackageInfo - --- | cabal-version <2.2 + *_module + default-extensions: doesn't build. -checkAutogenModuleExtensions - :: (PackageDescription -> ModuleName) - -> CheckExplanation - -> PackageDescription - -> [PackageCheck] -checkAutogenModuleExtensions autogenModuleName rebindableClashExplanation pd - | specVersion pd >= CabalSpecV2_2 = [] - | any checkBI (allBuildInfo pd) || any checkLib (allLibraries pd) = - return (PackageBuildImpossible rebindableClashExplanation) - | otherwise = [] - where - mn = autogenModuleName pd - - checkLib :: Library -> Bool - checkLib l = mn `elem` exposedModules l && checkExts (l ^. L.defaultExtensions) - - checkBI :: BuildInfo -> Bool - checkBI bi = - (mn `elem` otherModules bi || mn `elem` autogenModules bi) - && checkExts (bi ^. L.defaultExtensions) - - checkExts exts = rebind `elem` exts && (strings `elem` exts || lists `elem` exts) - where - rebind = EnableExtension RebindableSyntax - strings = EnableExtension OverloadedStrings - lists = EnableExtension OverloadedLists - --- | Checks GHC options from all ghc-*-options fields from the given BuildInfo --- and reports flags that are OK during development process, but are --- unacceptable in a distributed package -checkDevelopmentOnlyFlagsBuildInfo :: BuildInfo -> [PackageCheck] -checkDevelopmentOnlyFlagsBuildInfo bi = - checkDevelopmentOnlyFlagsOptions "ghc-options" (hcOptions GHC bi) - ++ checkDevelopmentOnlyFlagsOptions "ghc-prof-options" (hcProfOptions GHC bi) - ++ checkDevelopmentOnlyFlagsOptions "ghc-shared-options" (hcSharedOptions GHC bi) - --- | Checks the given list of flags belonging to the given field and reports --- flags that are OK during development process, but are unacceptable in a --- distributed package -checkDevelopmentOnlyFlagsOptions :: String -> [String] -> [PackageCheck] -checkDevelopmentOnlyFlagsOptions fieldName ghcOptions = - catMaybes - [ check has_Werror $ - PackageDistInexcusable (WErrorUnneeded fieldName) - , check has_J $ - PackageDistInexcusable (JUnneeded fieldName) - , checkFlags ["-fdefer-type-errors"] $ - PackageDistInexcusable (FDeferTypeErrorsUnneeded fieldName) - , -- -dynamic is not a debug flag - check - ( any - (\opt -> "-d" `isPrefixOf` opt && opt /= "-dynamic") - ghcOptions - ) - $ PackageDistInexcusable (DynamicUnneeded fieldName) - , checkFlags - [ "-fprof-auto" - , "-fprof-auto-top" - , "-fprof-auto-calls" - , "-fprof-cafs" - , "-fno-prof-count-entries" - , "-auto-all" - , "-auto" - , "-caf-all" - ] - $ PackageDistSuspicious (ProfilingUnneeded fieldName) - ] - where - has_Werror = "-Werror" `elem` ghcOptions - has_J = - any - ( \o -> case o of - "-j" -> True - ('-' : 'j' : d : _) -> isDigit d - _ -> False - ) - ghcOptions - checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck - checkFlags flags = check (any (`elem` flags) ghcOptions) - -checkDevelopmentOnlyFlags :: GenericPackageDescription -> [PackageCheck] -checkDevelopmentOnlyFlags pkg = - concatMap - checkDevelopmentOnlyFlagsBuildInfo - [ bi - | (conditions, bi) <- allConditionalBuildInfo - , not (any guardedByManualFlag conditions) - ] - where - guardedByManualFlag = definitelyFalse - - -- We've basically got three-values logic here: True, False or unknown - -- hence this pattern to propagate the unknown cases properly. - definitelyFalse (Var (PackageFlag n)) = maybe False not (Map.lookup n manualFlags) - definitelyFalse (Var _) = False - definitelyFalse (Lit b) = not b - definitelyFalse (CNot c) = definitelyTrue c - definitelyFalse (COr c1 c2) = definitelyFalse c1 && definitelyFalse c2 - definitelyFalse (CAnd c1 c2) = definitelyFalse c1 || definitelyFalse c2 - - definitelyTrue (Var (PackageFlag n)) = fromMaybe False (Map.lookup n manualFlags) - definitelyTrue (Var _) = False - definitelyTrue (Lit b) = b - definitelyTrue (CNot c) = definitelyFalse c - definitelyTrue (COr c1 c2) = definitelyTrue c1 || definitelyTrue c2 - definitelyTrue (CAnd c1 c2) = definitelyTrue c1 && definitelyTrue c2 - - manualFlags = - Map.fromList - [ (flagName flag, flagDefault flag) - | flag <- genPackageFlags pkg - , flagManual flag - ] - - allConditionalBuildInfo :: [([Condition ConfVar], BuildInfo)] - allConditionalBuildInfo = - concatMap - (collectCondTreePaths libBuildInfo) - (maybeToList (condLibrary pkg)) - ++ concatMap - (collectCondTreePaths libBuildInfo . snd) - (condSubLibraries pkg) - ++ concatMap - (collectCondTreePaths buildInfo . snd) - (condExecutables pkg) - ++ concatMap - (collectCondTreePaths testBuildInfo . snd) - (condTestSuites pkg) - ++ concatMap - (collectCondTreePaths benchmarkBuildInfo . snd) - (condBenchmarks pkg) - - -- get all the leaf BuildInfo, paired up with the path (in the tree sense) - -- of if-conditions that guard it - collectCondTreePaths - :: (a -> b) - -> CondTree v c a - -> [([Condition v], b)] - collectCondTreePaths mapData = go [] - where - go conditions condNode = - -- the data at this level in the tree: - (reverse conditions, mapData (condTreeData condNode)) - : concat - [ go (condition : conditions) ifThen - | (CondBranch condition ifThen _) <- condTreeComponents condNode - ] - ++ concat - [ go (condition : conditions) elseThen - | (CondBranch condition _ (Just elseThen)) <- condTreeComponents condNode - ] - --- ------------------------------------------------------------ - --- * Checks involving files in the package - --- ------------------------------------------------------------ - --- | Sanity check things that requires IO. It looks at the files in the --- package and expects to find the package unpacked in at the given file path. -checkPackageFiles :: Verbosity -> PackageDescription -> FilePath -> IO [PackageCheck] -checkPackageFiles verbosity pkg root = do - contentChecks <- checkPackageContent checkFilesIO pkg - preDistributionChecks <- checkPackageFilesPreDistribution verbosity pkg root - -- Sort because different platforms will provide files from - -- `getDirectoryContents` in different orders, and we'd like to be - -- stable for test output. - return (sort contentChecks ++ sort preDistributionChecks) + return cabalFiles + +checkCabalFile :: Monad m => PackageName -> CheckM m () +checkCabalFile pn = do + -- liftInt is a bit more messy than stricter interface, but since + -- each of the following check is exclusive, we can simplify the + -- condition flow. + liftInt + ciPackageOps + ( \ops -> do + -- 1. Get .cabal files. + ds <- findPackageDesc ops + case ds of + [] -> return [PackageBuildImpossible NoDesc] + -- No .cabal file. + [d] -> do + bc <- bomf ops d + return (catMaybes [bc, noMatch d]) + -- BOM + no matching .cabal checks. + _ -> return [PackageBuildImpossible $ MultiDesc ds] + ) where - checkFilesIO = - CheckPackageContentOps - { doesFileExist = System.doesFileExist . relative - , doesDirectoryExist = System.doesDirectoryExist . relative - , getDirectoryContents = System.Directory.getDirectoryContents . relative - , getFileContents = BS.readFile . relative - } - relative path = root path + -- Multiple .cabal files. --- | A record of operations needed to check the contents of packages. --- Used by 'checkPackageContent'. -data CheckPackageContentOps m = CheckPackageContentOps - { doesFileExist :: FilePath -> m Bool - , doesDirectoryExist :: FilePath -> m Bool - , getDirectoryContents :: FilePath -> m [FilePath] - , getFileContents :: FilePath -> m BS.ByteString - } + bomf + :: Monad m + => CheckPackageContentOps m + -> FilePath + -> m (Maybe PackageCheck) + bomf wops wfp = do + b <- BS.isPrefixOf bomUtf8 <$> getFileContents wops wfp + if b + then (return . Just) (PackageDistInexcusable $ BOMStart wfp) + else return Nothing --- | Sanity check things that requires looking at files in the package. --- This is a generalised version of 'checkPackageFiles' that can work in any --- monad for which you can provide 'CheckPackageContentOps' operations. --- --- The point of this extra generality is to allow doing checks in some virtual --- file system, for example a tarball in memory. -checkPackageContent - :: (Monad m, Applicative m) - => CheckPackageContentOps m - -> PackageDescription - -> m [PackageCheck] -checkPackageContent ops pkg = do - cabalBomError <- checkCabalFileBOM ops - cabalNameError <- checkCabalFileName ops pkg - licenseErrors <- checkLicensesExist ops pkg - setupError <- checkSetupExists ops pkg - configureError <- checkConfigureExists ops pkg - localPathErrors <- checkLocalPathsExist ops pkg - vcsLocation <- checkMissingVcsInfo ops pkg - - return $ - licenseErrors - ++ catMaybes [cabalBomError, cabalNameError, setupError, configureError] - ++ localPathErrors - ++ vcsLocation - -checkCabalFileBOM - :: Monad m - => CheckPackageContentOps m - -> m (Maybe PackageCheck) -checkCabalFileBOM ops = do - epdfile <- findPackageDesc ops - case epdfile of - -- MASSIVE HACK. If the Cabal file doesn't exist, that is - -- a very strange situation to be in, because the driver code - -- in 'Distribution.Setup' ought to have noticed already! - -- But this can be an issue, see #3552 and also when - -- --cabal-file is specified. So if you can't find the file, - -- just don't bother with this check. - Left _ -> return Nothing - Right pdfile -> - (flip check pc . BS.isPrefixOf bomUtf8) - `liftM` getFileContents ops pdfile - where - pc = PackageDistInexcusable (BOMStart pdfile) - where bomUtf8 :: BS.ByteString bomUtf8 = BS.pack [0xef, 0xbb, 0xbf] -- U+FEFF encoded as UTF8 - -checkCabalFileName + noMatch :: FilePath -> Maybe PackageCheck + noMatch wd = + let expd = unPackageName pn <.> "cabal" + in if takeFileName wd /= expd + then Just (PackageDistInexcusable $ NotPackageName wd expd) + else Nothing + +checkLicFileExist :: Monad m - => CheckPackageContentOps m - -> PackageDescription - -> m (Maybe PackageCheck) -checkCabalFileName ops pkg = do - -- findPackageDesc already takes care to detect missing/multiple - -- .cabal files; we don't include this check in 'findPackageDesc' in - -- order not to short-cut other checks which call 'findPackageDesc' - epdfile <- findPackageDesc ops - case epdfile of - -- see "MASSIVE HACK" note in 'checkCabalFileBOM' - Left _ -> return Nothing - Right pdfile - | takeFileName pdfile == expectedCabalname -> return Nothing - | otherwise -> - return $ - Just $ - PackageDistInexcusable - (NotPackageName pdfile expectedCabalname) - where - pkgname = unPackageName . packageName $ pkg - expectedCabalname = pkgname <.> "cabal" - --- | Find a package description file in the given directory. Looks for --- @.cabal@ files. Like 'Distribution.Simple.Utils.findPackageDesc', --- but generalized over monads. -findPackageDesc - :: Monad m - => CheckPackageContentOps m - -> m (Either PackageCheck FilePath) - -- ^ .cabal -findPackageDesc ops = - do - let dir = "." - files <- getDirectoryContents ops dir - -- to make sure we do not mistake a ~/.cabal/ dir for a .cabal - -- file we filter to exclude dirs and null base file names: - cabalFiles <- - filterM - (doesFileExist ops) - [ dir file - | file <- files - , let (name, ext) = splitExtension file - , not (null name) && ext == ".cabal" - ] - case cabalFiles of - [] -> return (Left $ PackageBuildImpossible NoDesc) - [cabalFile] -> return (Right cabalFile) - multiple -> - return - ( Left $ - PackageBuildImpossible - (MultiDesc multiple) - ) - -checkLicensesExist - :: (Monad m, Applicative m) - => CheckPackageContentOps m - -> PackageDescription - -> m [PackageCheck] -checkLicensesExist ops pkg = do - exists <- traverse (doesFileExist ops . getSymbolicPath) (licenseFiles pkg) - return - [ PackageBuildWarning (UnknownFile fieldname file) - | (file, False) <- zip (licenseFiles pkg) exists - ] - where - fieldname - | length (licenseFiles pkg) == 1 = "license-file" - | otherwise = "license-files" - -checkSetupExists - :: Monad m - => CheckPackageContentOps m - -> PackageDescription - -> m (Maybe PackageCheck) -checkSetupExists ops pkg = do - let simpleBuild = buildType pkg == Simple - hsexists <- doesFileExist ops "Setup.hs" - lhsexists <- doesFileExist ops "Setup.lhs" - return $ - check (not simpleBuild && not hsexists && not lhsexists) $ - PackageDistInexcusable MissingSetupFile - -checkConfigureExists - :: Monad m - => CheckPackageContentOps m - -> PackageDescription - -> m (Maybe PackageCheck) -checkConfigureExists ops pd - | buildType pd == Configure = do - exists <- doesFileExist ops "configure" - return $ - check (not exists) $ - PackageBuildWarning MissingConfigureScript - | otherwise = return Nothing - -checkLocalPathsExist - :: Monad m - => CheckPackageContentOps m - -> PackageDescription - -> m [PackageCheck] -checkLocalPathsExist ops pkg = do - let dirs = - [ (dir, kind) - | bi <- allBuildInfo pkg - , (dir, kind) <- - [(dir, "extra-lib-dirs") | dir <- extraLibDirs bi] - ++ [(dir, "extra-lib-dirs-static") | dir <- extraLibDirsStatic bi] - ++ [ (dir, "extra-framework-dirs") - | dir <- extraFrameworkDirs bi - ] - ++ [(dir, "include-dirs") | dir <- includeDirs bi] - ++ [(getSymbolicPath dir, "hs-source-dirs") | dir <- hsSourceDirs bi] - , isRelativeOnAnyPlatform dir - ] - missing <- filterM (liftM not . doesDirectoryExist ops . fst) dirs - return - [ PackageBuildWarning (UnknownDirectory kind dir) - | (dir, kind) <- missing - ] - -checkMissingVcsInfo - :: (Monad m, Applicative m) - => CheckPackageContentOps m - -> PackageDescription - -> m [PackageCheck] -checkMissingVcsInfo ops pkg | null (sourceRepos pkg) = do - vcsInUse <- liftM or $ traverse (doesDirectoryExist ops) repoDirnames - if vcsInUse - then return [PackageDistSuspicious MissingSourceControl] - else return [] - where - repoDirnames = - [ dirname | repo <- knownRepoTypes, dirname <- repoTypeDirname repo - ] -checkMissingVcsInfo _ _ = return [] - -repoTypeDirname :: KnownRepoType -> [FilePath] -repoTypeDirname Darcs = ["_darcs"] -repoTypeDirname Git = [".git"] -repoTypeDirname SVN = [".svn"] -repoTypeDirname CVS = ["CVS"] -repoTypeDirname Mercurial = [".hg"] -repoTypeDirname GnuArch = [".arch-params"] -repoTypeDirname Bazaar = [".bzr"] -repoTypeDirname Monotone = ["_MTN"] -repoTypeDirname Pijul = [".pijul"] - --- ------------------------------------------------------------ - --- * Checks involving files in the package - --- ------------------------------------------------------------ - --- | Check the names of all files in a package for portability problems. This --- should be done for example when creating or validating a package tarball. -checkPackageFileNames :: [FilePath] -> [PackageCheck] -checkPackageFileNames = checkPackageFileNamesWithGlob . zip (repeat True) - -checkPackageFileNamesWithGlob :: [(Bool, FilePath)] -> [PackageCheck] -checkPackageFileNamesWithGlob files = - catMaybes $ - checkWindowsPaths files - : [ checkTarPath file - | (_, file) <- files - ] - -checkWindowsPaths :: [(Bool, FilePath)] -> Maybe PackageCheck -checkWindowsPaths paths = - case filter (not . FilePath.Windows.isValid . escape) paths of - [] -> Nothing - ps -> - Just $ - PackageDistInexcusable (InvalidOnWin $ map snd ps) - where - -- force a relative name to catch invalid file names like "f:oo" which - -- otherwise parse as file "oo" in the current directory on the 'f' drive. - escape (isGlob, path) = - (".\\" ++) - -- glob paths will be expanded before being dereferenced, so asterisks - -- shouldn't count against them. - $ - map (\c -> if c == '*' && isGlob then 'x' else c) path - --- | Check a file name is valid for the portable POSIX tar format. --- --- The POSIX tar format has a restriction on the length of file names. It is --- unfortunately not a simple restriction like a maximum length. The exact --- restriction is that either the whole path be 100 characters or less, or it --- be possible to split the path on a directory separator such that the first --- part is 155 characters or less and the second part 100 characters or less. -checkTarPath :: FilePath -> Maybe PackageCheck -checkTarPath path - | length path > 255 = Just longPath - | otherwise = case pack nameMax (reverse (splitPath path)) of - Left err -> Just err - Right [] -> Nothing - Right (h : rest) -> case pack prefixMax remainder of - Left err -> Just err - Right [] -> Nothing - Right (_ : _) -> Just noSplit - where - -- drop the '/' between the name and prefix: - remainder = safeInit h : rest - where - nameMax, prefixMax :: Int - nameMax = 100 - prefixMax = 155 - - pack _ [] = Left emptyName - pack maxLen (c : cs) - | n > maxLen = Left longName - | otherwise = Right (pack' maxLen n cs) - where - n = length c - - pack' maxLen n (c : cs) - | n' <= maxLen = pack' maxLen n' cs - where - n' = n + length c - pack' _ _ cs = cs - - longPath = PackageDistInexcusable (FilePathTooLong path) - longName = PackageDistInexcusable (FilePathNameTooLong path) - noSplit = PackageDistInexcusable (FilePathSplitTooLong path) - emptyName = PackageDistInexcusable FilePathEmpty - --- -------------------------------------------------------------- - --- * Checks for missing content and other pre-distribution checks - --- -------------------------------------------------------------- + => SymbolicPath PackageDir LicenseFile + -> CheckM m () +checkLicFileExist sp = do + let fp = getSymbolicPath sp + checkPkg + (\ops -> not <$> doesFileExist ops fp) + (PackageBuildWarning $ UnknownFile "license-file" sp) + +checkConfigureExists :: Monad m => BuildType -> CheckM m () +checkConfigureExists Configure = + checkPkg + (\ops -> not <$> doesFileExist ops "configure") + (PackageBuildWarning MissingConfigureScript) +checkConfigureExists _ = return () + +checkSetupExists :: Monad m => BuildType -> CheckM m () +checkSetupExists Simple = return () +checkSetupExists _ = + checkPkg + ( \ops -> do + ba <- doesFileExist ops "Setup.hs" + bb <- doesFileExist ops "Setup.lhs" + return (not $ ba || bb) + ) + (PackageDistInexcusable MissingSetupFile) --- | Similar to 'checkPackageContent', 'checkPackageFilesPreDistribution' --- inspects the files included in the package, but is primarily looking for --- files in the working tree that may have been missed or other similar --- problems that can only be detected pre-distribution. +-- The following functions are similar to 'CheckPackageContentOps m' ones, +-- but, as they inspect the files included in the package, but are primarily +-- looking for files in the working tree that may have been missed or other +-- similar problems that can only be detected pre-distribution. -- -- Because Hackage necessarily checks the uploaded tarball, it is too late to -- check these on the server; these checks only make sense in the development --- and package-creation environment. Hence we can use IO, rather than needing --- to pass a 'CheckPackageContentOps' dictionary around. -checkPackageFilesPreDistribution :: Verbosity -> PackageDescription -> FilePath -> IO [PackageCheck] +-- and package-creation environment. +-- This most likely means we need to use IO, but a dictionary +-- 'CheckPreDistributionOps m' is provided in case in the future such +-- information can come from somewhere else (e.g. VCS filesystem). +-- -- Note: this really shouldn't return any 'Inexcusable' warnings, -- because that will make us say that Hackage would reject the package. --- But, because Hackage doesn't run these tests, that will be a lie! -checkPackageFilesPreDistribution = checkGlobFiles +-- But, because Hackage doesn't yet run these tests, that will be a lie! --- | Discover problems with the package's wildcards. -checkGlobFiles - :: Verbosity - -> PackageDescription - -> FilePath - -> IO [PackageCheck] -checkGlobFiles verbosity pkg root = do - -- Get the desirable doc files from package’s directory - rootContents <- System.Directory.getDirectoryContents root - docFiles0 <- - filterM - System.doesFileExist - [ file - | file <- rootContents - , isDesirableExtraDocFile desirableDocFiles file - ] - -- Check the globs - (warnings, unlisted) <- foldrM checkGlob ([], docFiles0) allGlobs - - return $ - if null unlisted - then -- No missing desirable file - warnings - else -- Some missing desirable files - - warnings - ++ let unlisted' = (root ) <$> unlisted - in [ PackageDistSuspiciousWarn - (MissingExpectedDocFiles extraDocFilesSupport unlisted') - ] +checkGlobFile + :: Monad m + => CabalSpecVersion + -> FilePath -- Glob pattern. + -> FilePath -- Folder to check. + -> CabalField -- .cabal field we are checking. + -> CheckM m () +checkGlobFile cv ddir title fp = do + let adjDdir = if null ddir then "." else ddir + dir + | title == "data-files" = adjDdir + | otherwise = "." + + case parseFileGlob cv fp of + -- We just skip over parse errors here; they're reported elsewhere. + Left _ -> return () + Right parsedGlob -> do + liftInt ciPreDistOps $ \po -> do + rs <- runDirFileGlobM po dir parsedGlob + return $ checkGlobResult title fp rs + +-- | Checks for matchless globs and too strict matching (<2.4 spec). +checkGlobResult + :: CabalField -- .cabal field we are checking + -> FilePath -- Glob pattern (to show the user + -- which pattern is the offending + -- one). + -> [GlobResult FilePath] -- List of glob results. + -> [PackageCheck] +checkGlobResult title fp rs = dirCheck ++ catMaybes (map getWarning rs) where - -- `extra-doc-files` is supported only from version 1.18 - extraDocFilesSupport = specVersion pkg >= CabalSpecV1_18 - adjustedDataDir = if null (dataDir pkg) then root else root dataDir pkg - -- Cabal fields with globs - allGlobs :: [(String, Bool, FilePath, FilePath)] - allGlobs = - concat - [ (,,,) "extra-source-files" (not extraDocFilesSupport) root - <$> extraSrcFiles pkg - , (,,,) "extra-doc-files" True root <$> extraDocFiles pkg - , (,,,) "data-files" False adjustedDataDir <$> dataFiles pkg - ] - - -- For each field with globs (see allGlobs), look for: - -- • errors (missing directory, no match) - -- • omitted documentation files (changelog) - checkGlob - :: (String, Bool, FilePath, FilePath) - -> ([PackageCheck], [FilePath]) - -> IO ([PackageCheck], [FilePath]) - checkGlob (field, isDocField, dir, glob) acc@(warnings, docFiles1) = - -- Note: we just skip over parse errors here; they're reported elsewhere. - case parseFileGlob (specVersion pkg) glob of - Left _ -> return acc - Right parsedGlob -> do - results <- runDirFileGlob verbosity (root dir) parsedGlob - let acc0 = (warnings, True, docFiles1, []) - return $ case foldr checkGlobResult acc0 results of - (individualWarn, noMatchesWarn, docFiles1', wrongPaths) -> - let wrongFieldWarnings = - [ PackageDistSuspiciousWarn - ( WrongFieldForExpectedDocFiles - extraDocFilesSupport - field - wrongPaths - ) - | not (null wrongPaths) - ] - in ( if noMatchesWarn - then - [PackageDistSuspiciousWarn (GlobNoMatch field glob)] - ++ individualWarn - ++ wrongFieldWarnings - else individualWarn ++ wrongFieldWarnings - , docFiles1' - ) - where - checkGlobResult - :: GlobResult FilePath - -> ([PackageCheck], Bool, [FilePath], [FilePath]) - -> ([PackageCheck], Bool, [FilePath], [FilePath]) - checkGlobResult result (ws, noMatchesWarn, docFiles2, wrongPaths) = - let noMatchesWarn' = - noMatchesWarn - && not (suppressesNoMatchesWarning result) - in case getWarning field glob result of - -- No match: add warning and do no further check - Left w -> - ( w : ws - , noMatchesWarn' - , docFiles2 - , wrongPaths - ) - -- Match: check doc files - Right path -> - let path' = makeRelative root (normalise path) - (docFiles2', wrongPaths') = - checkDoc - isDocField - path' - docFiles2 - wrongPaths - in ( ws - , noMatchesWarn' - , docFiles2' - , wrongPaths' - ) - - -- Check whether a path is a desirable doc: if so, check if it is in the - -- field "extra-doc-files". - checkDoc - :: Bool -- Is it "extra-doc-files" ? - -> FilePath -- Path to test - -> [FilePath] -- Pending doc files to check - -> [FilePath] -- Previous wrong paths - -> ([FilePath], [FilePath]) -- Updated paths - checkDoc isDocField path docFiles wrongFieldPaths = - if path `elem` docFiles - then -- Found desirable doc file - - ( delete path docFiles - , if isDocField then wrongFieldPaths else path : wrongFieldPaths - ) - else -- Not a desirable doc file - - ( docFiles - , wrongFieldPaths - ) - - -- Predicate for desirable documentation file on Hackage server - isDesirableExtraDocFile :: ([FilePath], [FilePath]) -> FilePath -> Bool - isDesirableExtraDocFile (basenames, extensions) path = - basename `elem` basenames && ext `elem` extensions - where - (basename, ext) = splitExtension (map toLower path) - - -- Changelog patterns (basenames & extensions) - -- Source: hackage-server/src/Distribution/Server/Packages/ChangeLog.hs - desirableChangeLog = - [ "news" - , "changelog" - , "change_log" - , "changes" - ] - desirableChangeLogExtensions = ["", ".txt", ".md", ".markdown", ".rst"] - -- [TODO] Check readme. Observations: - -- • Readme is not necessary if package description is good. - -- • Some readmes exists only for repository browsing. - -- • There is currently no reliable way to check what a good - -- description is; there will be complains if the criterion is - -- based on the length or number of words (can of worms). - -- -- Readme patterns - -- -- Source: hackage-server/src/Distribution/Server/Packages/Readme.hs - -- desirableReadme = ["readme"] - desirableDocFiles = (desirableChangeLog, desirableChangeLogExtensions) + dirCheck + | all (not . withoutNoMatchesWarning) rs = + [PackageDistSuspiciousWarn $ GlobNoMatch title fp] + | otherwise = [] -- If there's a missing directory in play, since our globs don't - -- (currently) support disjunction, that will always mean there are no - -- matches. The no matches error in this case is strictly less informative - -- than the missing directory error, so sit on it. - suppressesNoMatchesWarning (GlobMatch _) = True - suppressesNoMatchesWarning (GlobWarnMultiDot _) = False - suppressesNoMatchesWarning (GlobMissingDirectory _) = True - - getWarning - :: String - -> FilePath - -> GlobResult FilePath - -> Either PackageCheck FilePath - getWarning _ _ (GlobMatch path) = - Right path + -- (currently) support disjunction, that will always mean there are + -- no matches. The no matches error in this case is strictly less + -- informative than the missing directory error. + withoutNoMatchesWarning (GlobMatch _) = True + withoutNoMatchesWarning (GlobWarnMultiDot _) = False + withoutNoMatchesWarning (GlobMissingDirectory _) = True + + getWarning :: GlobResult FilePath -> Maybe PackageCheck + getWarning (GlobMatch _) = Nothing -- Before Cabal 2.4, the extensions of globs had to match the file -- exactly. This has been relaxed in 2.4 to allow matching only the - -- suffix. This warning detects when pre-2.4 package descriptions are - -- omitting files purely because of the stricter check. - getWarning field glob (GlobWarnMultiDot file) = - Left (PackageDistSuspiciousWarn (GlobExactMatch field glob file)) - getWarning field glob (GlobMissingDirectory dir) = - Left (PackageDistSuspiciousWarn (GlobNoDir field glob dir)) - --- | Check that setup dependencies, have proper bounds. --- In particular, @base@ and @Cabal@ upper bounds are mandatory. -checkSetupVersions :: GenericPackageDescription -> [PackageCheck] -checkSetupVersions pkg = - [ emitError nameStr - | (name, vr) <- Map.toList deps - , not (hasUpperBound vr) - , let nameStr = unPackageName name - , nameStr `elem` criticalPkgs - ] - where - criticalPkgs = ["Cabal", "base"] - deps = toDependencyVersionsMap (foldMap setupDepends . setupBuildInfo) pkg - emitError nm = - PackageDistInexcusable (UpperBoundSetup nm) - -checkDuplicateModules :: GenericPackageDescription -> [PackageCheck] -checkDuplicateModules pkg = - concatMap checkLib (maybe id (:) (condLibrary pkg) . map snd $ condSubLibraries pkg) - ++ concatMap checkExe (map snd $ condExecutables pkg) - ++ concatMap checkTest (map snd $ condTestSuites pkg) - ++ concatMap checkBench (map snd $ condBenchmarks pkg) - where - -- the duplicate modules check is has not been thoroughly vetted for backpack - checkLib = checkDups "library" (\l -> explicitLibModules l ++ map moduleReexportName (reexportedModules l)) - checkExe = checkDups "executable" exeModules - checkTest = checkDups "test suite" testModules - checkBench = checkDups "benchmark" benchmarkModules - checkDups s getModules t = - let sumPair (x, x') (y, y') = (x + x' :: Int, y + y' :: Int) - mergePair (x, x') (y, y') = (x + x', max y y') - maxPair (x, x') (y, y') = (max x x', max y y') - libMap = - foldCondTree - Map.empty - (\(_, v) -> Map.fromListWith sumPair . map (\x -> (x, (1, 1))) $ getModules v) - (Map.unionWith mergePair) -- if a module may occur in nonexclusive branches count it twice strictly and once loosely. - (Map.unionWith maxPair) -- a module occurs the max of times it might appear in exclusive branches - t - dupLibsStrict = Map.keys $ Map.filter ((> 1) . fst) libMap - dupLibsLax = Map.keys $ Map.filter ((> 1) . snd) libMap - in if not (null dupLibsLax) - then - [ PackageBuildImpossible - (DuplicateModule s dupLibsLax) - ] - else - if not (null dupLibsStrict) - then - [ PackageDistSuspicious - (PotentialDupModule s dupLibsStrict) - ] - else [] + -- suffix. This warning detects when pre-2.4 package descriptions + -- are omitting files purely because of the stricter check. + getWarning (GlobWarnMultiDot file) = + Just $ PackageDistSuspiciousWarn (GlobExactMatch title fp file) + getWarning (GlobMissingDirectory dir) = + Just $ PackageDistSuspiciousWarn (GlobNoDir title fp dir) -- ------------------------------------------------------------ +-- Other exports +-- ------------------------------------------------------------ --- * Utils +-- | Wraps `ParseWarning` into `PackageCheck`. +wrapParseWarning :: FilePath -> PWarning -> PackageCheck +wrapParseWarning fp pw = PackageDistSuspicious (ParseWarning fp pw) + +-- TODO: as Jul 2022 there is no severity indication attached PWarnType. +-- Once that is added, we can output something more appropriate +-- than PackageDistSuspicious for every parse warning. +-- (see: Cabal-syntax/src/Distribution/Parsec/Warning.hs) +-- ------------------------------------------------------------ +-- Ancillaries -- ------------------------------------------------------------ -toDependencyVersionsMap :: (PackageDescription -> [Dependency]) -> GenericPackageDescription -> Map PackageName VersionRange -toDependencyVersionsMap selectDependencies pkg = case typicalPkg pkg of - Right (pkgs', _) -> - let - self :: PackageName - self = pkgName $ package pkgs' - in - Map.fromListWith intersectVersionRanges $ - [ (pname, vr) - | Dependency pname vr _ <- selectDependencies pkgs' - , pname /= self - ] - -- Just in case finalizePD fails for any reason, - -- or if the package doesn't depend on the base package at all, - -- no deps is no checks. - _ -> Map.empty - -quote :: String -> String -quote s = "'" ++ s ++ "'" - -commaSep :: [String] -> String -commaSep = intercalate ", " +-- Gets a list of dependencies from a Library target to pass to PVP related +-- functions. We are not doing checks here: this is not imprecise, as the +-- library itself *will* be checked for PVP errors. +-- Same for branch merging, +-- each of those branch will be checked one by one. +extractAssocDeps + :: UnqualComponentName -- Name of the target library + -> CondTree ConfVar [Dependency] Library + -> AssocDep +extractAssocDeps n ct = + let a = ignoreConditions ct + in -- Merging is fine here, remember the specific + -- library dependencies will be checked branch + -- by branch. + (n, snd a) + +-- | August 2022: this function is an oddity due to the historical +-- GenericPackageDescription/PackageDescription split (check +-- Distribution.Types.PackageDescription for a description of the relationship +-- between GPD and PD. +-- It is only maintained not to break interface, should be deprecated in the +-- future in favour of `checkPackage` when PD and GPD are refactored sensibly. +pd2gpd :: PackageDescription -> GenericPackageDescription +pd2gpd pd = gpd + where + gpd :: GenericPackageDescription + gpd = + emptyGenericPackageDescription + { packageDescription = pd + , condLibrary = fmap t2c (library pd) + , condSubLibraries = map (t2cName ln id) (subLibraries pd) + , condForeignLibs = + map + (t2cName foreignLibName id) + (foreignLibs pd) + , condExecutables = + map + (t2cName exeName id) + (executables pd) + , condTestSuites = + map + (t2cName testName remTest) + (testSuites pd) + , condBenchmarks = + map + (t2cName benchmarkName remBench) + (benchmarks pd) + } -dups :: Ord a => [a] -> [a] -dups xs = [x | (x : _ : _) <- group (sort xs)] + -- From target to simple, unconditional CondTree. + t2c :: a -> CondTree ConfVar [Dependency] a + t2c a = CondNode a [] [] + + -- From named target to unconditional CondTree. Notice we have + -- a function to extract the name *and* a function to modify + -- the target. This is needed for 'initTargetAnnotation' to work + -- properly and to contain all the quirks inside 'pd2gpd'. + t2cName + :: (a -> UnqualComponentName) + -> (a -> a) + -> a + -> (UnqualComponentName, CondTree ConfVar [Dependency] a) + t2cName nf mf a = (nf a, t2c . mf $ a) + + ln :: Library -> UnqualComponentName + ln wl = case libName wl of + (LSubLibName u) -> u + LMainLibName -> mkUnqualComponentName "main-library" + + remTest :: TestSuite -> TestSuite + remTest t = t{testName = mempty} + + remBench :: Benchmark -> Benchmark + remBench b = b{benchmarkName = mempty} + +-- checkMissingDocs will check that we don’t have an interesting file +-- (changes.txt, Changelog.md, NEWS, etc.) in our work-tree which is not +-- present in our .cabal file. +checkMissingDocs + :: Monad m + => [Glob] -- data-files globs. + -> [Glob] -- extra-source-files globs. + -> [Glob] -- extra-doc-files globs. + -> CheckM m () +checkMissingDocs dgs esgs edgs = do + extraDocSupport <- (>= CabalSpecV1_18) <$> asksCM ccSpecVersion + + -- Everything in this block uses CheckPreDistributionOps interface. + liftInt + ciPreDistOps + ( \ops -> do + -- 1. Get root files, see if they are interesting to us. + rootContents <- getDirectoryContentsM ops "." + -- Recall getDirectoryContentsM arg is relative to root path. + let des = filter isDesirableExtraDocFile rootContents + + -- 2. Realise Globs. + let realGlob t = + concatMap globMatches + <$> mapM (runDirFileGlobM ops "") t + rgs <- realGlob dgs + res <- realGlob esgs + red <- realGlob edgs + + -- 3. Check if anything in 1. is missing in 2. + let mcs = checkDoc extraDocSupport des (rgs ++ res ++ red) + + -- 4. Check if files are present but in the wrong field. + let pcsData = checkDocMove extraDocSupport "data-files" des rgs + pcsSource = + if extraDocSupport + then + checkDocMove + extraDocSupport + "extra-source-files" + des + res + else [] + pcs = pcsData ++ pcsSource -fileExtensionSupportedLanguage :: FilePath -> Bool -fileExtensionSupportedLanguage path = - isHaskell || isC + return (mcs ++ pcs) + ) where - extension = takeExtension path - isHaskell = extension `elem` [".hs", ".lhs"] - isC = isJust (filenameCDialect extension) + -- From Distribution.Simple.Glob. + globMatches :: [GlobResult a] -> [a] + globMatches input = [a | GlobMatch a <- input] --- | Whether a path is a good relative path. We aren't worried about perfect --- cross-platform compatibility here; this function just checks the paths in --- the (local) @.cabal@ file, while only Hackage needs the portability. --- --- >>> let test fp = putStrLn $ show (isGoodRelativeDirectoryPath fp) ++ "; " ++ show (isGoodRelativeFilePath fp) --- --- Note that "foo./bar.hs" would be invalid on Windows. --- --- >>> traverse_ test ["foo/bar/quu", "a/b.hs", "foo./bar.hs"] --- Nothing; Nothing --- Nothing; Nothing --- Nothing; Nothing --- --- Trailing slash is not allowed for files, for directories it is ok. --- --- >>> test "foo/" --- Nothing; Just "trailing slash" --- --- Leading @./@ is fine, but @.@ and @./@ are not valid files. --- --- >>> traverse_ test [".", "./", "./foo/bar"] --- Nothing; Just "trailing dot segment" --- Nothing; Just "trailing slash" --- Nothing; Nothing --- --- Lastly, not good file nor directory cases: --- --- >>> traverse_ test ["", "/tmp/src", "foo//bar", "foo/.", "foo/./bar", "foo/../bar"] --- Just "empty path"; Just "empty path" --- Just "posix absolute path"; Just "posix absolute path" --- Just "empty path segment"; Just "empty path segment" --- Just "trailing same directory segment: ."; Just "trailing same directory segment: ." --- Just "same directory segment: ."; Just "same directory segment: ." --- Just "parent directory segment: .."; Just "parent directory segment: .." --- --- For the last case, 'isGoodRelativeGlob' doesn't warn: --- --- >>> traverse_ (print . isGoodRelativeGlob) ["foo/../bar"] --- Just "parent directory segment: .." -isGoodRelativeFilePath :: FilePath -> Maybe String -isGoodRelativeFilePath = state0 - where - -- initial state - state0 [] = Just "empty path" - state0 (c : cs) - | c == '.' = state1 cs - | c == '/' = Just "posix absolute path" - | otherwise = state5 cs - - -- after initial . - state1 [] = Just "trailing dot segment" - state1 (c : cs) - | c == '.' = state4 cs - | c == '/' = state2 cs - | otherwise = state5 cs - - -- after ./ or after / between segments - state2 [] = Just "trailing slash" - state2 (c : cs) - | c == '.' = state3 cs - | c == '/' = Just "empty path segment" - | otherwise = state5 cs - - -- after non-first segment's . - state3 [] = Just "trailing same directory segment: ." - state3 (c : cs) - | c == '.' = state4 cs - | c == '/' = Just "same directory segment: ." - | otherwise = state5 cs - - -- after .. - state4 [] = Just "trailing parent directory segment: .." - state4 (c : cs) - | c == '.' = state5 cs - | c == '/' = Just "parent directory segment: .." - | otherwise = state5 cs - - -- in a segment which is ok. - state5 [] = Nothing - state5 (c : cs) - | c == '.' = state5 cs - | c == '/' = state2 cs - | otherwise = state5 cs - --- | See 'isGoodRelativeFilePath'. --- --- This is barebones function. We check whether the glob is a valid file --- by replacing stars @*@ with @x@ses. -isGoodRelativeGlob :: FilePath -> Maybe String -isGoodRelativeGlob = isGoodRelativeFilePath . map f - where - f '*' = 'x' - f c = c + checkDoc + :: Bool -- Cabal spec ≥ 1.18? + -> [FilePath] -- Desirables. + -> [FilePath] -- Actuals. + -> [PackageCheck] + checkDoc b ds as = + let fds = map ("." ) $ filter (flip notElem as) ds + in if null fds + then [] + else + [ PackageDistSuspiciousWarn $ + MissingExpectedDocFiles b fds + ] + + checkDocMove + :: Bool -- Cabal spec ≥ 1.18? + -> CabalField -- Name of the field. + -> [FilePath] -- Desirables. + -> [FilePath] -- Actuals. + -> [PackageCheck] + checkDocMove b field ds as = + let fds = filter (flip elem as) ds + in if null fds + then [] + else + [ PackageDistSuspiciousWarn $ + WrongFieldForExpectedDocFiles b field fds + ] --- | See 'isGoodRelativeFilePath'. -isGoodRelativeDirectoryPath :: FilePath -> Maybe String -isGoodRelativeDirectoryPath = state0 +-- Predicate for desirable documentation file on Hackage server. +isDesirableExtraDocFile :: FilePath -> Bool +isDesirableExtraDocFile path = + basename `elem` desirableChangeLog + && ext `elem` desirableChangeLogExtensions where - -- initial state - state0 [] = Just "empty path" - state0 (c : cs) - | c == '.' = state5 cs - | c == '/' = Just "posix absolute path" - | otherwise = state4 cs - - -- after initial ./ or after / between segments - state1 [] = Nothing - state1 (c : cs) - | c == '.' = state2 cs - | c == '/' = Just "empty path segment" - | otherwise = state4 cs - - -- after non-first setgment's . - state2 [] = Just "trailing same directory segment: ." - state2 (c : cs) - | c == '.' = state3 cs - | c == '/' = Just "same directory segment: ." - | otherwise = state4 cs - - -- after .. - state3 [] = Just "trailing parent directory segment: .." - state3 (c : cs) - | c == '.' = state4 cs - | c == '/' = Just "parent directory segment: .." - | otherwise = state4 cs - - -- in a segment which is ok. - state4 [] = Nothing - state4 (c : cs) - | c == '.' = state4 cs - | c == '/' = state1 cs - | otherwise = state4 cs - - -- after initial . - state5 [] = Nothing -- "." - state5 (c : cs) - | c == '.' = state3 cs - | c == '/' = state1 cs - | otherwise = state4 cs - --- [Note: Good relative paths] --- --- Using @kleene@ we can define an extended regex: --- --- @ --- import Algebra.Lattice --- import Kleene --- import Kleene.ERE (ERE (..), intersections) --- --- data C = CDot | CSlash | CChar --- deriving (Eq, Ord, Enum, Bounded, Show) --- --- reservedR :: ERE C --- reservedR = notChar CSlash --- --- pathPieceR :: ERE C --- pathPieceR = intersections --- [ plus reservedR --- , ERENot (string [CDot]) --- , ERENot (string [CDot,CDot]) --- ] --- --- filePathR :: ERE C --- filePathR = optional (string [CDot, CSlash]) <> pathPieceR <> star (char CSlash <> pathPieceR) --- --- dirPathR :: ERE C --- dirPathR = (char CDot \/ filePathR) <> optional (char CSlash) --- --- plus :: ERE C -> ERE C --- plus r = r <> star r --- --- optional :: ERE C -> ERE C --- optional r = mempty \/ r --- @ --- --- Results in following state machine for @filePathR@ --- --- @ --- 0 -> \x -> if --- | x <= CDot -> 1 --- | otherwise -> 5 --- 1 -> \x -> if --- | x <= CDot -> 4 --- | x <= CSlash -> 2 --- | otherwise -> 5 --- 2 -> \x -> if --- | x <= CDot -> 3 --- | otherwise -> 5 --- 3 -> \x -> if --- | x <= CDot -> 4 --- | otherwise -> 5 --- 4 -> \x -> if --- | x <= CDot -> 5 --- | otherwise -> 5 --- 5+ -> \x -> if --- | x <= CDot -> 5 --- | x <= CSlash -> 2 --- | otherwise -> 5 --- @ --- --- and @dirPathR@: --- --- @ --- 0 -> \x -> if --- | x <= CDot -> 5 --- | otherwise -> 4 --- 1+ -> \x -> if --- | x <= CDot -> 2 --- | otherwise -> 4 --- 2 -> \x -> if --- | x <= CDot -> 3 --- | otherwise -> 4 --- 3 -> \x -> if --- | x <= CDot -> 4 --- | otherwise -> 4 --- 4+ -> \x -> if --- | x <= CDot -> 4 --- | x <= CSlash -> 1 --- | otherwise -> 4 --- 5+ -> \x -> if --- | x <= CDot -> 3 --- | x <= CSlash -> 1 --- | otherwise -> 4 --- @ + (basename, ext) = splitExtension (map toLower path) --- --- TODO: What we really want to do is test if there exists any --- configuration in which the base version is unbounded above. --- However that's a bit tricky because there are many possible --- configurations. As a cheap easy and safe approximation we will --- pick a single "typical" configuration and check if that has an --- open upper bound. To get a typical configuration we finalise --- using no package index and the current platform. -typicalPkg - :: GenericPackageDescription - -> Either [Dependency] (PackageDescription, FlagAssignment) -typicalPkg = - finalizePD - mempty - defaultComponentRequestedSpec - (const True) - buildPlatform - ( unknownCompilerInfo - (CompilerId buildCompilerFlavor nullVersion) - NoAbiTag - ) - [] - -addConditionalExp :: String -> String -addConditionalExp expl = - expl - ++ " Alternatively, if you want to use this, make it conditional based " - ++ "on a Cabal configuration flag (with 'manual: True' and 'default: " - ++ "False') and enable that flag during development." + -- Changelog patterns (basenames & extensions) + -- Source: hackage-server/src/Distribution/Server/Packages/ChangeLog.hs + desirableChangeLog = ["news", "changelog", "change_log", "changes"] + desirableChangeLogExtensions = ["", ".txt", ".md", ".markdown", ".rst"] + +-- [TODO] Check readme. Observations: +-- • Readme is not necessary if package description is good. +-- • Some readmes exists only for repository browsing. +-- • There is currently no reliable way to check what a good +-- description is; there will be complains if the criterion +-- is based on the length or number of words (can of worms). +-- -- Readme patterns +-- -- Source: hackage-server/src/Distribution/Server/Packages/Readme.hs +-- desirableReadme = ["readme"] + +-- Remove duplicates from list. +dups :: Ord a => [a] -> [a] +dups xs = [x | (x : _ : _) <- group (sort xs)] diff --git a/Cabal/src/Distribution/PackageDescription/Check/Common.hs b/Cabal/src/Distribution/PackageDescription/Check/Common.hs new file mode 100644 index 00000000000..4c528831430 --- /dev/null +++ b/Cabal/src/Distribution/PackageDescription/Check/Common.hs @@ -0,0 +1,149 @@ +-- | +-- Module : Distribution.PackageDescription.Check.Common +-- Copyright : Francesco Ariis 2022 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Common types/functions to various check modules which are *no* part of +-- Distribution.PackageDescription.Check.Monad. +module Distribution.PackageDescription.Check.Common + ( AssocDep + , CabalField + , PathKind (..) + , checkCustomField + , partitionDeps + , checkPVP + , checkPVPs + ) where + +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.Compat.NonEmptySet (toNonEmpty) +import Distribution.Package +import Distribution.PackageDescription +import Distribution.PackageDescription.Check.Monad +import Distribution.Utils.Generic (isAscii) +import Distribution.Version + +import Control.Monad + +-- Type of FilePath. +data PathKind + = PathKindFile + | PathKindDirectory + | PathKindGlob + deriving (Eq) + +-- | .cabal field we are referring to. As now it is just a synonym to help +-- reading the code, in the future it might take advantage of typification +-- in Cabal-syntax. +type CabalField = String + +checkCustomField :: Monad m => (String, String) -> CheckM m () +checkCustomField (n, _) = + checkP + (any (not . isAscii) n) + (PackageDistInexcusable $ NonASCIICustomField [n]) + +-- ------------------------------------------------------------ +-- PVP types/functions +-- ------------------------------------------------------------ + +-- A library name / dependencies association list. Ultimately to be +-- fed to PVP check. +type AssocDep = (UnqualComponentName, [Dependency]) + +-- Convenience function to partition important dependencies by name. To +-- be used together with checkPVP. Important: usually “base” or “Cabal”, +-- as the error is slightly different. +-- Note that `partitionDeps` will also filter out dependencies which are +-- already present in a inherithed fashion (e.g. an exe which imports the +-- main library will not need to specify upper bounds on shared dependencies, +-- hence we do not return those). +-- +partitionDeps + :: Monad m + => [AssocDep] -- Possibly inherited dependencies, i.e. + -- dependencies from internal/main libs. + -> [UnqualComponentName] -- List of package names ("base", "Cabal"…) + -> [Dependency] -- Dependencies to check. + -> CheckM m ([Dependency], [Dependency]) +partitionDeps ads ns ds = do + -- Shared dependencies from “intra .cabal” libraries. + let + -- names of our dependencies + dqs = map unqualName ds + -- shared targets that match + fads = filter (flip elem dqs . fst) ads + -- the names of such targets + inNam = nub $ map fst fads :: [UnqualComponentName] + -- the dependencies of such targets + inDep = concatMap snd fads :: [Dependency] + + -- We exclude from checks: + -- 1. dependencies which are shared with main library / a + -- sublibrary; and of course + -- 2. the names of main library / sub libraries themselves. + -- + -- So in myPackage.cabal + -- library + -- build-depends: text < 5 + -- ⁝ + -- build-depends: myPackage, ← no warning, internal + -- text, ← no warning, inherited + -- monadacme ← warning! + let fFun d = + notElem (unqualName d) inNam + && notElem + (unqualName d) + (map unqualName inDep) + ds' = filter fFun ds + + return $ partition (flip elem ns . unqualName) ds' + where + -- Return *sublibrary* name if exists (internal), + -- otherwise package name. + unqualName :: Dependency -> UnqualComponentName + unqualName (Dependency n _ nel) = + case head (toNonEmpty nel) of + (LSubLibName ln) -> ln + _ -> packageNameToUnqualComponentName n + +-- PVP dependency check (one warning message per dependency, usually +-- for important dependencies like base). +checkPVP + :: Monad m + => (String -> PackageCheck) -- Warn message dependend on name + -- (e.g. "base", "Cabal"). + -> [Dependency] + -> CheckM m () +checkPVP ckf ds = do + let ods = checkPVPPrim ds + mapM_ (tellP . ckf . unPackageName . depPkgName) ods + +-- PVP dependency check for a list of dependencies. Some code duplication +-- is sadly needed to provide more ergonimic error messages. +checkPVPs + :: Monad m + => ( [String] + -> PackageCheck -- Grouped error message, depends on a + -- set of names. + ) + -> [Dependency] -- Deps to analyse. + -> CheckM m () +checkPVPs cf ds + | null ns = return () + | otherwise = tellP (cf ns) + where + ods = checkPVPPrim ds + ns = map (unPackageName . depPkgName) ods + +-- Returns dependencies without upper bounds. +checkPVPPrim :: [Dependency] -> [Dependency] +checkPVPPrim ds = filter withoutUpper ds + where + withoutUpper :: Dependency -> Bool + withoutUpper (Dependency _ ver _) = not . hasUpperBound $ ver diff --git a/Cabal/src/Distribution/PackageDescription/Check/Conditional.hs b/Cabal/src/Distribution/PackageDescription/Check/Conditional.hs new file mode 100644 index 00000000000..2d4963e434a --- /dev/null +++ b/Cabal/src/Distribution/PackageDescription/Check/Conditional.hs @@ -0,0 +1,221 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +-- | +-- Module : Distribution.PackageDescription.Check.Conditional +-- Copyright : Lennart Kolmodin 2008, Francesco Ariis 2023 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Checks on conditional targets (libraries, executables, etc. that are +-- still inside a CondTree and related checks that can only be performed +-- here (variables, duplicated modules). +module Distribution.PackageDescription.Check.Conditional + ( checkCondTarget + , checkDuplicateModules + ) where + +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.Compiler +import Distribution.ModuleName (ModuleName) +import Distribution.Package +import Distribution.PackageDescription +import Distribution.PackageDescription.Check.Monad +import Distribution.System + +import qualified Data.Map as Map + +import Control.Monad + +-- As a prerequisite to some checks, we transform a target CondTree into +-- a CondTree of “target + useful context”. +-- This is slightly clearer, is easier to walk without resorting to +-- list comprehensions, allows us in the future to apply some sensible +-- “optimisations” to checks (exclusive branches, etc.). + +-- | @nf@ function is needed to appropriately name some targets which need +-- to be spoonfed (otherwise name appears as ""). +initTargetAnnotation + :: Monoid a + => (UnqualComponentName -> a -> a) -- Naming function for targets. + -> UnqualComponentName + -> TargetAnnotation a +initTargetAnnotation nf n = TargetAnnotation (nf n mempty) False + +-- | We “build up” target from various slices. +updateTargetAnnotation + :: Monoid a + => a -- A target (lib, exe, test, …) + -> TargetAnnotation a + -> TargetAnnotation a +updateTargetAnnotation t ta = ta{taTarget = taTarget ta <> t} + +-- | Before walking a target 'CondTree', we need to annotate it with +-- information relevant to the checks (read 'TaraAnn' and 'checkCondTarget' +-- doc for more info). +annotateCondTree + :: forall a + . Monoid a + => [PackageFlag] -- User flags. + -> TargetAnnotation a + -> CondTree ConfVar [Dependency] a + -> CondTree ConfVar [Dependency] (TargetAnnotation a) +annotateCondTree fs ta (CondNode a c bs) = + let ta' = updateTargetAnnotation a ta + bs' = map (annotateBranch ta') bs + in CondNode ta' c bs' + where + annotateBranch + :: TargetAnnotation a + -> CondBranch ConfVar [Dependency] a + -> CondBranch + ConfVar + [Dependency] + (TargetAnnotation a) + annotateBranch wta (CondBranch k t mf) = + let uf = isPkgFlagCond k + wta' = wta{taPackageFlag = taPackageFlag wta || uf} + atf = annotateCondTree fs + in CondBranch + k + (atf wta' t) + (atf wta <$> mf) + -- Note how we are passing the *old* wta + -- in the `else` branch, since we are not + -- under that flag. + + -- We only want to pick up variables that are flags and that are + -- \*off* by default. + isPkgFlagCond :: Condition ConfVar -> Bool + isPkgFlagCond (Lit _) = False + isPkgFlagCond (Var (PackageFlag f)) = elem f defOffFlags + isPkgFlagCond (Var _) = False + isPkgFlagCond (CNot cn) = not (isPkgFlagCond cn) + isPkgFlagCond (CAnd ca cb) = isPkgFlagCond ca || isPkgFlagCond cb + isPkgFlagCond (COr ca cb) = isPkgFlagCond ca && isPkgFlagCond cb + + -- Package flags that are off by default *and* that are manual. + defOffFlags = + map flagName $ + filter + ( \f -> + not (flagDefault f) + && flagManual f + ) + fs + +-- | A conditional target is a library, exe, benchmark etc., destructured +-- in a CondTree. Traversing method: we render the branches, pass a +-- relevant context, collect checks. +checkCondTarget + :: forall m a + . (Monad m, Monoid a) + => [PackageFlag] -- User flags. + -> (a -> CheckM m ()) -- Check function (a = target). + -> (UnqualComponentName -> a -> a) + -- Naming function (some targets + -- need to have their name + -- spoonfed to them. + -> (UnqualComponentName, CondTree ConfVar [Dependency] a) + -- Target name/condtree. + -> CheckM m () +checkCondTarget fs cf nf (unqualName, ct) = + wTree $ annotateCondTree fs (initTargetAnnotation nf unqualName) ct + where + -- Walking the tree. Remember that CondTree is not a binary + -- tree but a /rose/tree. + wTree + :: CondTree ConfVar [Dependency] (TargetAnnotation a) + -> CheckM m () + wTree (CondNode ta _ bs) + -- There are no branches (and [] == True) *or* every branch + -- is “simple” (i.e. missing a 'condBranchIfFalse' part). + -- This is convenient but not necessarily correct in all + -- cases; a more precise way would be to check incompatibility + -- among simple branches conditions (or introduce a principled + -- `cond` construct in `.cabal` files. + | all isSimple bs = do + localCM (initCheckCtx ta) (cf $ taTarget ta) + mapM_ wBranch bs + -- If there are T/F conditions, there is no need to check + -- the intermediate 'TargetAnnotation' too. + | otherwise = do + mapM_ wBranch bs + + isSimple + :: CondBranch ConfVar [Dependency] (TargetAnnotation a) + -> Bool + isSimple (CondBranch _ _ Nothing) = True + isSimple (CondBranch _ _ (Just _)) = False + + wBranch + :: CondBranch ConfVar [Dependency] (TargetAnnotation a) + -> CheckM m () + wBranch (CondBranch k t mf) = do + checkCondVars k + wTree t + maybe (return ()) wTree mf + +-- | Condvar checking (misspelled OS in if conditions, etc). +checkCondVars :: Monad m => Condition ConfVar -> CheckM m () +checkCondVars cond = + let (_, vs) = simplifyCondition cond (\v -> Left v) + in -- Using simplifyCondition is convenient and correct, + -- if checks become more complex we can always walk + -- 'Condition'. + mapM_ vcheck vs + where + vcheck :: Monad m => ConfVar -> CheckM m () + vcheck (OS (OtherOS os)) = + tellP (PackageDistInexcusable $ UnknownOS [os]) + vcheck (Arch (OtherArch arch)) = + tellP (PackageDistInexcusable $ UnknownArch [arch]) + vcheck (Impl (OtherCompiler os) _) = + tellP (PackageDistInexcusable $ UnknownCompiler [os]) + vcheck _ = return () + +-- Checking duplicated modules cannot unfortunately be done in the +-- “tree checking”. This is because of the monoidal instance in some targets, +-- where e.g. merged dependencies are `nub`’d, hence losing information for +-- this particular check. +checkDuplicateModules :: GenericPackageDescription -> [PackageCheck] +checkDuplicateModules pkg = + concatMap checkLib (maybe id (:) (condLibrary pkg) . map snd $ condSubLibraries pkg) + ++ concatMap checkExe (map snd $ condExecutables pkg) + ++ concatMap checkTest (map snd $ condTestSuites pkg) + ++ concatMap checkBench (map snd $ condBenchmarks pkg) + where + -- the duplicate modules check is has not been thoroughly vetted for backpack + checkLib = checkDups "library" (\l -> explicitLibModules l ++ map moduleReexportName (reexportedModules l)) + checkExe = checkDups "executable" exeModules + checkTest = checkDups "test suite" testModules + checkBench = checkDups "benchmark" benchmarkModules + checkDups :: String -> (a -> [ModuleName]) -> CondTree v c a -> [PackageCheck] + checkDups s getModules t = + let sumPair (x, x') (y, y') = (x + x' :: Int, y + y' :: Int) + mergePair (x, x') (y, y') = (x + x', max y y') + maxPair (x, x') (y, y') = (max x x', max y y') + libMap = + foldCondTree + Map.empty + (\(_, v) -> Map.fromListWith sumPair . map (\x -> (x, (1, 1))) $ getModules v) + (Map.unionWith mergePair) -- if a module may occur in nonexclusive branches count it twice strictly and once loosely. + (Map.unionWith maxPair) -- a module occurs the max of times it might appear in exclusive branches + t + dupLibsStrict = Map.keys $ Map.filter ((> 1) . fst) libMap + dupLibsLax = Map.keys $ Map.filter ((> 1) . snd) libMap + in if not (null dupLibsLax) + then + [ PackageBuildImpossible + (DuplicateModule s dupLibsLax) + ] + else + if not (null dupLibsStrict) + then + [ PackageDistSuspicious + (PotentialDupModule s dupLibsStrict) + ] + else [] diff --git a/Cabal/src/Distribution/PackageDescription/Check/Monad.hs b/Cabal/src/Distribution/PackageDescription/Check/Monad.hs new file mode 100644 index 00000000000..9e375e8d9b8 --- /dev/null +++ b/Cabal/src/Distribution/PackageDescription/Check/Monad.hs @@ -0,0 +1,372 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | +-- Module : Distribution.PackageDescription.Check.Monad +-- Copyright : Francesco Ariis 2022 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Primitives for package checking: check types and monadic interface. +-- Having these primitives in a different module allows us to appropriately +-- limit/manage the interface to suit checking needs. +module Distribution.PackageDescription.Check.Monad + ( -- * Types and constructors + CheckM (..) + , execCheckM + , CheckInterface (..) + , CheckPackageContentOps (..) + , CheckPreDistributionOps (..) + , TargetAnnotation (..) + , PackageCheck (..) + , CheckExplanation (..) + , CEField (..) + , CEType (..) + , WarnLang (..) + , CheckCtx (..) + , pristineCheckCtx + , initCheckCtx + , PNames (..) + + -- * Operations + , ppPackageCheck + , isHackageDistError + , asksCM + , localCM + , checkP + , checkPkg + , liftInt + , tellP + , checkSpecVer + ) where + +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.CabalSpecVersion (CabalSpecVersion) +import Distribution.Package (packageName) +import Distribution.PackageDescription.Check.Warning +import Distribution.Simple.BuildToolDepends (desugarBuildToolSimple) +import Distribution.Simple.Glob (Glob, GlobResult) +import Distribution.Types.ExeDependency (ExeDependency) +import Distribution.Types.GenericPackageDescription +import Distribution.Types.LegacyExeDependency (LegacyExeDependency) +import Distribution.Types.PackageDescription (package, specVersion) +import Distribution.Types.PackageId (PackageIdentifier) +import Distribution.Types.UnqualComponentName + +import qualified Control.Monad.Reader as Reader +import qualified Control.Monad.Trans.Class as Trans +import qualified Control.Monad.Writer as Writer +import qualified Data.ByteString.Lazy as BS +import qualified Data.Set as Set + +import Control.Monad + +-- Monadic interface for for Distribution.PackageDescription.Check. +-- +-- Monadic checking allows us to have a fine grained control on checks +-- (e.g. omitting warning checks in certain situations). + +-- * Interfaces + +-- + +-- | Which interface to we have available/should we use? (to perform: pure +-- checks, package checks, pre-distribution checks.) +data CheckInterface m = CheckInterface + { ciPureChecks :: Bool + , -- Perform pure checks? + ciPackageOps :: Maybe (CheckPackageContentOps m) + , -- If you want to perform package contents + -- checks, provide an interface. + ciPreDistOps :: Maybe (CheckPreDistributionOps m) + -- If you want to work-tree checks, provide + -- an interface. + } + +-- | A record of operations needed to check the contents of packages. +-- Abstracted over `m` to provide flexibility (could be IO, a .tar.gz +-- file, etc). +data CheckPackageContentOps m = CheckPackageContentOps + { doesFileExist :: FilePath -> m Bool + , doesDirectoryExist :: FilePath -> m Bool + , getDirectoryContents :: FilePath -> m [FilePath] + , getFileContents :: FilePath -> m BS.ByteString + } + +-- | A record of operations needed to check contents *of the work tree* +-- (compare it with 'CheckPackageContentOps'). This is still `m` abstracted +-- in case in the future we can obtain the same infos other than from IO +-- (e.g. a VCS work tree). +data CheckPreDistributionOps m = CheckPreDistributionOps + { runDirFileGlobM :: FilePath -> Glob -> m [GlobResult FilePath] + , getDirectoryContentsM :: FilePath -> m [FilePath] + } + +-- | Context to perform checks (will be the Reader part in your monad). +data CheckCtx m = CheckCtx + { ccInterface :: CheckInterface m + , -- Interface for checks. + + -- Contextual infos for checks. + ccFlag :: Bool + , -- Are we under a user flag? + + -- Convenience bits that we prefer to carry + -- in our Reader monad instead of passing it + -- via ->, as they are often useful and often + -- in deeply nested places in the GPD tree. + ccSpecVersion :: CabalSpecVersion + , -- Cabal version. + ccDesugar :: LegacyExeDependency -> Maybe ExeDependency + , -- A desugaring function from + -- Distribution.Simple.BuildToolDepends + -- (desugarBuildToolSimple). Again since it + -- eats PackageName and a list of executable + -- names, it is more convenient to pass it + -- via Reader. + ccNames :: PNames + -- Various names (id, libs, execs, tests, + -- benchs), convenience. + } + +-- | Creates a pristing 'CheckCtx'. With pristine we mean everything that +-- can be deduced by GPD but *not* user flags information. +pristineCheckCtx + :: Monad m + => CheckInterface m + -> GenericPackageDescription + -> CheckCtx m +pristineCheckCtx ci gpd = + let ens = map fst (condExecutables gpd) + in CheckCtx + ci + False + (specVersion . packageDescription $ gpd) + (desugarBuildToolSimple (packageName gpd) ens) + (initPNames gpd) + +-- | Adds useful bits to 'CheckCtx' (as now, whether we are operating under +-- a user off-by-default flag). +initCheckCtx :: Monad m => TargetAnnotation a -> CheckCtx m -> CheckCtx m +initCheckCtx t c = c{ccFlag = taPackageFlag t} + +-- | 'TargetAnnotation' collects contextual information on the target we are +-- realising: a buildup of the various slices of the target (a library, +-- executable, etc. — is a monoid) whether we are under an off-by-default +-- package flag. +data TargetAnnotation a = TargetAnnotation + { taTarget :: a + , -- The target we are building (lib, exe, etc.) + taPackageFlag :: Bool + -- Whether we are under an off-by-default package flag. + } + deriving (Show, Eq, Ord) + +-- | A collection os names, shipping tuples around is annoying. +data PNames = PNames + { pnPackageId :: PackageIdentifier -- Package ID… + -- … and a bunch of lib, exe, test, bench names. + , pnSubLibs :: [UnqualComponentName] + , pnExecs :: [UnqualComponentName] + , pnTests :: [UnqualComponentName] + , pnBenchs :: [UnqualComponentName] + } + +-- | Init names from a GPD. +initPNames :: GenericPackageDescription -> PNames +initPNames gpd = + PNames + (package . packageDescription $ gpd) + (map fst $ condSubLibraries gpd) + (map fst $ condExecutables gpd) + (map fst $ condTestSuites gpd) + (map fst $ condBenchmarks gpd) + +-- | Check monad, carrying a context, collecting 'PackageCheck's. +-- Using Set for writer (automatic sort) is useful for output stability +-- on different platforms. +-- It is nothing more than a monad stack with Reader+Writer. +-- `m` is the monad that could be used to do package/file checks. +newtype CheckM m a + = CheckM + ( Reader.ReaderT + (CheckCtx m) + ( Writer.WriterT + (Set.Set PackageCheck) + m + ) + a + ) + deriving (Functor, Applicative, Monad) + +-- Not autoderiving MonadReader and MonadWriter gives us better +-- control on the interface of CheckM. + +-- | Execute a CheckM monad, leaving `m [PackageCheck]` which can be +-- run in the appropriate `m` environment (IO, pure, …). +execCheckM :: Monad m => CheckM m () -> CheckCtx m -> m [PackageCheck] +execCheckM (CheckM rwm) ctx = + let wm = Reader.runReaderT rwm ctx + m = Writer.execWriterT wm + in Set.toList <$> m + +-- | As 'checkP' but always succeeding. +tellP :: Monad m => PackageCheck -> CheckM m () +tellP = checkP True + +-- | Add a package warning withoutu performing any check. +tellCM :: Monad m => PackageCheck -> CheckM m () +tellCM ck = do + cf <- asksCM ccFlag + unless + (cf && canSkip ck) + -- Do not push this message if the warning is not severe *and* + -- we are under a non-default package flag. + (CheckM . Writer.tell $ Set.singleton ck) + where + -- Check if we can skip this error if we are under a + -- non-default user flag. + canSkip :: PackageCheck -> Bool + canSkip wck = not (isSevereLocal wck) || isErrAllowable wck + + isSevereLocal :: PackageCheck -> Bool + isSevereLocal (PackageBuildImpossible _) = True + isSevereLocal (PackageBuildWarning _) = True + isSevereLocal (PackageDistSuspicious _) = False + isSevereLocal (PackageDistSuspiciousWarn _) = False + isSevereLocal (PackageDistInexcusable _) = True + + -- There are some errors which, even though severe, will + -- be allowed by Hackage *if* under a non-default flag. + isErrAllowable :: PackageCheck -> Bool + isErrAllowable c = case extractCheckExplantion c of + (WErrorUnneeded _) -> True + (JUnneeded _) -> True + (FDeferTypeErrorsUnneeded _) -> True + (DynamicUnneeded _) -> True + (ProfilingUnneeded _) -> True + _ -> False + +-- | Lift a monadic computation to CM. +liftCM :: Monad m => m a -> CheckM m a +liftCM ma = CheckM . Trans.lift . Trans.lift $ ma + +-- | Lift a monadic action via an interface. Missing interface, no action. +liftInt + :: forall m i + . Monad m + => (CheckInterface m -> Maybe (i m)) + -- Check interface, may or may not exist. If it does not, + -- the check simply will not be performed. + -> (i m -> m [PackageCheck]) + -- The actual check to perform with the above-mentioned + -- interface. Note the [] around `PackageCheck`, this is + -- meant to perform/collect multiple checks. + -> CheckM m () +liftInt acc f = do + ops <- asksCM (acc . ccInterface) + maybe (return ()) l ops + where + l :: i m -> CheckM m () + l wi = do + cks <- liftCM (f wi) + mapM_ (check True) cks + +-- | Most basic check function. You do not want to export this, rather export +-- “smart” functions (checkP, checkPkg) to enforce relevant properties. +check + :: Monad m + => Bool -- Is there something to warn about? + -> PackageCheck -- Warn message. + -> CheckM m () +check True ck = tellCM ck +check False _ = return () + +-- | Pure check not requiring IO or other interfaces. +checkP + :: Monad m + => Bool -- Is there something to warn about? + -> PackageCheck -- Warn message. + -> CheckM m () +checkP b ck = do + pb <- asksCM (ciPureChecks . ccInterface) + when pb (check b ck) + +-- Check with 'CheckPackageContentOps' operations (i.e. package file checks). +-- +checkPkg + :: forall m + . Monad m + => (CheckPackageContentOps m -> m Bool) + -- Actual check to perform with CPC interface + -> PackageCheck + -- Warn message. + -> CheckM m () +checkPkg f ck = checkInt ciPackageOps f ck + +-- | Generalised version for checks that need an interface. We pass a Reader +-- accessor to such interface ‘i’, a check function. +checkIntDep + :: forall m i + . Monad m + => (CheckInterface m -> Maybe (i m)) + -- Check interface, may or may not exist. If it does not, + -- the check simply will not be performed. + -> (i m -> m (Maybe PackageCheck)) + -- The actual check to perform (single check). + -> CheckM m () +checkIntDep acc mck = do + po <- asksCM (acc . ccInterface) + maybe (return ()) (lc . mck) po + where + lc :: Monad m => m (Maybe PackageCheck) -> CheckM m () + lc wmck = do + b <- liftCM wmck + maybe (return ()) (check True) b + +-- | As 'checkIntDep', but 'PackageCheck' does not depend on the monadic +-- computation. +checkInt + :: forall m i + . Monad m + => (CheckInterface m -> Maybe (i m)) + -- Where to get the interface (if available). + -> (i m -> m Bool) + -- Condition to check + -> PackageCheck + -- Warning message to add (does not depend on `m`). + -> CheckM m () +checkInt acc f ck = + checkIntDep + acc + ( \ops -> do + b <- f ops + if b + then return $ Just ck + else return Nothing + ) + +-- | `local` (from Control.Monad.Reader) for CheckM. +localCM :: Monad m => (CheckCtx m -> CheckCtx m) -> CheckM m () -> CheckM m () +localCM cf (CheckM im) = CheckM $ Reader.local cf im + +-- | `ask` (from Control.Monad.Reader) for CheckM. +asksCM :: Monad m => (CheckCtx m -> a) -> CheckM m a +asksCM f = CheckM $ Reader.asks f + +-- As checkP, but with an additional condition: the check will be performed +-- only if our spec version is < `vc`. +checkSpecVer + :: Monad m + => CabalSpecVersion -- Perform this check only if our + -- spec version is < than this. + -> Bool -- Check condition. + -> PackageCheck -- Check message. + -> CheckM m () +checkSpecVer vc cond c = do + vp <- asksCM ccSpecVersion + unless (vp >= vc) (checkP cond c) diff --git a/Cabal/src/Distribution/PackageDescription/Check/Paths.hs b/Cabal/src/Distribution/PackageDescription/Check/Paths.hs new file mode 100644 index 00000000000..f389c6797be --- /dev/null +++ b/Cabal/src/Distribution/PackageDescription/Check/Paths.hs @@ -0,0 +1,412 @@ +-- | +-- Module : Distribution.PackageDescription.Check.Paths +-- Copyright : Lennart Kolmodin 2008, Francesco Ariis 2023 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Functions to check filepaths, directories, globs, etc. +module Distribution.PackageDescription.Check.Paths + ( checkGlob + , checkPath + , fileExtensionSupportedLanguage + , isGoodRelativeDirectoryPath + , isGoodRelativeFilePath + , isGoodRelativeGlob + , isInsideDist + ) where + +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.PackageDescription.Check.Common +import Distribution.PackageDescription.Check.Monad +import Distribution.Simple.CCompiler +import Distribution.Simple.Glob +import Distribution.Simple.Utils hiding (findPackageDesc, notice) +import System.FilePath (splitDirectories, splitPath, takeExtension) + +import qualified System.FilePath.Windows as FilePath.Windows (isValid) + +fileExtensionSupportedLanguage :: FilePath -> Bool +fileExtensionSupportedLanguage path = + isHaskell || isC + where + extension = takeExtension path + isHaskell = extension `elem` [".hs", ".lhs"] + isC = isJust (filenameCDialect extension) + +-- Boolean: are absolute paths allowed? +checkPath + :: Monad m + => Bool -- Can be absolute path? + -> CabalField -- .cabal field that we are checking. + -> PathKind -- Path type. + -> FilePath -- Path. + -> CheckM m () +checkPath isAbs title kind path = do + checkP + (isOutsideTree path) + (PackageBuildWarning $ RelativeOutside title path) + checkP + (isInsideDist path) + (PackageDistInexcusable $ DistPoint (Just title) path) + checkPackageFileNamesWithGlob kind path + + -- Skip if "can be absolute path". + checkP + (not isAbs && isAbsoluteOnAnyPlatform path) + (PackageDistInexcusable $ AbsolutePath title path) + case grl path kind of + Just e -> + checkP + (not isAbs) + (PackageDistInexcusable $ BadRelativePath title path e) + Nothing -> return () + checkWindowsPath (kind == PathKindGlob) path + where + isOutsideTree wpath = case splitDirectories wpath of + ".." : _ -> True + "." : ".." : _ -> True + _ -> False + + -- These are not paths, but globs... + grl wfp PathKindFile = isGoodRelativeFilePath wfp + grl wfp PathKindGlob = isGoodRelativeGlob wfp + grl wfp PathKindDirectory = isGoodRelativeDirectoryPath wfp + +-- | Is a 'FilePath' inside `dist`, `dist-newstyle` and friends? +isInsideDist :: FilePath -> Bool +isInsideDist path = + case map lowercase (splitDirectories path) of + "dist" : _ -> True + "." : "dist" : _ -> True + "dist-newstyle" : _ -> True + "." : "dist-newstyle" : _ -> True + _ -> False + +checkPackageFileNamesWithGlob + :: Monad m + => PathKind + -> FilePath -- Filepath or possibly a glob pattern. + -> CheckM m () +checkPackageFileNamesWithGlob kind fp = do + checkWindowsPath (kind == PathKindGlob) fp + checkTarPath fp + +checkWindowsPath + :: Monad m + => Bool -- Is it a glob pattern? + -> FilePath -- Path. + -> CheckM m () +checkWindowsPath isGlob path = + checkP + (not . FilePath.Windows.isValid $ escape isGlob path) + (PackageDistInexcusable $ InvalidOnWin [path]) + where + -- Force a relative name to catch invalid file names like "f:oo" which + -- otherwise parse as file "oo" in the current directory on the 'f' drive. + escape :: Bool -> String -> String + escape wisGlob wpath = + (".\\" ++) + -- Glob paths will be expanded before being dereferenced, so asterisks + -- shouldn't count against them. + $ + map (\c -> if c == '*' && wisGlob then 'x' else c) wpath + +-- | Check a file name is valid for the portable POSIX tar format. +-- +-- The POSIX tar format has a restriction on the length of file names. It is +-- unfortunately not a simple restriction like a maximum length. The exact +-- restriction is that either the whole path be 100 characters or less, or it +-- be possible to split the path on a directory separator such that the first +-- part is 155 characters or less and the second part 100 characters or less. +checkTarPath :: Monad m => FilePath -> CheckM m () +checkTarPath path + | length path > 255 = tellP longPath + | otherwise = case pack nameMax (reverse (splitPath path)) of + Left err -> tellP err + Right [] -> return () + Right (h : rest) -> case pack prefixMax remainder of + Left err -> tellP err + Right [] -> return () + Right (_ : _) -> tellP noSplit + where + -- drop the '/' between the name and prefix: + remainder = safeInit h : rest + where + nameMax, prefixMax :: Int + nameMax = 100 + prefixMax = 155 + + pack _ [] = Left emptyName + pack maxLen (c : cs) + | n > maxLen = Left longName + | otherwise = Right (pack' maxLen n cs) + where + n = length c + + pack' maxLen n (c : cs) + | n' <= maxLen = pack' maxLen n' cs + where + n' = n + length c + pack' _ _ cs = cs + + longPath = PackageDistInexcusable (FilePathTooLong path) + longName = PackageDistInexcusable (FilePathNameTooLong path) + noSplit = PackageDistInexcusable (FilePathSplitTooLong path) + emptyName = PackageDistInexcusable FilePathEmpty + +-- `checkGlob` checks glob patterns and returns good ones for further +-- processing. +checkGlob + :: Monad m + => CabalField -- .cabal field we are checking. + -> FilePath -- glob filepath pattern + -> CheckM m (Maybe Glob) +checkGlob title pat = do + ver <- asksCM ccSpecVersion + + -- Glob sanity check. + case parseFileGlob ver pat of + Left e -> do + tellP + ( PackageDistInexcusable $ + GlobSyntaxError title (explainGlobSyntaxError pat e) + ) + return Nothing + Right wglob -> do + -- \* Miscellaneous checks on sane glob. + -- Checks for recursive glob in root. + checkP + (isRecursiveInRoot wglob) + ( PackageDistSuspiciousWarn $ + RecursiveGlobInRoot title pat + ) + return (Just wglob) + +-- | Whether a path is a good relative path. We aren't worried about perfect +-- cross-platform compatibility here; this function just checks the paths in +-- the (local) @.cabal@ file, while only Hackage needs the portability. +-- +-- >>> let test fp = putStrLn $ show (isGoodRelativeDirectoryPath fp) ++ "; " ++ show (isGoodRelativeFilePath fp) +-- +-- Note that "foo./bar.hs" would be invalid on Windows. +-- +-- >>> traverse_ test ["foo/bar/quu", "a/b.hs", "foo./bar.hs"] +-- Nothing; Nothing +-- Nothing; Nothing +-- Nothing; Nothing +-- +-- Trailing slash is not allowed for files, for directories it is ok. +-- +-- >>> test "foo/" +-- Nothing; Just "trailing slash" +-- +-- Leading @./@ is fine, but @.@ and @./@ are not valid files. +-- +-- >>> traverse_ test [".", "./", "./foo/bar"] +-- Nothing; Just "trailing dot segment" +-- Nothing; Just "trailing slash" +-- Nothing; Nothing +-- +-- Lastly, not good file nor directory cases: +-- +-- >>> traverse_ test ["", "/tmp/src", "foo//bar", "foo/.", "foo/./bar", "foo/../bar"] +-- Just "empty path"; Just "empty path" +-- Just "posix absolute path"; Just "posix absolute path" +-- Just "empty path segment"; Just "empty path segment" +-- Just "trailing same directory segment: ."; Just "trailing same directory segment: ." +-- Just "same directory segment: ."; Just "same directory segment: ." +-- Just "parent directory segment: .."; Just "parent directory segment: .." +-- +-- For the last case, 'isGoodRelativeGlob' doesn't warn: +-- +-- >>> traverse_ (print . isGoodRelativeGlob) ["foo/../bar"] +-- Just "parent directory segment: .." +isGoodRelativeFilePath :: FilePath -> Maybe String +isGoodRelativeFilePath = state0 + where + -- initial state + state0 [] = Just "empty path" + state0 (c : cs) + | c == '.' = state1 cs + | c == '/' = Just "posix absolute path" + | otherwise = state5 cs + + -- after initial . + state1 [] = Just "trailing dot segment" + state1 (c : cs) + | c == '.' = state4 cs + | c == '/' = state2 cs + | otherwise = state5 cs + + -- after ./ or after / between segments + state2 [] = Just "trailing slash" + state2 (c : cs) + | c == '.' = state3 cs + | c == '/' = Just "empty path segment" + | otherwise = state5 cs + + -- after non-first segment's . + state3 [] = Just "trailing same directory segment: ." + state3 (c : cs) + | c == '.' = state4 cs + | c == '/' = Just "same directory segment: ." + | otherwise = state5 cs + + -- after .. + state4 [] = Just "trailing parent directory segment: .." + state4 (c : cs) + | c == '.' = state5 cs + | c == '/' = Just "parent directory segment: .." + | otherwise = state5 cs + + -- in a segment which is ok. + state5 [] = Nothing + state5 (c : cs) + | c == '.' = state5 cs + | c == '/' = state2 cs + | otherwise = state5 cs + +-- | See 'isGoodRelativeFilePath'. +-- +-- This is barebones function. We check whether the glob is a valid file +-- by replacing stars @*@ with @x@ses. +isGoodRelativeGlob :: FilePath -> Maybe String +isGoodRelativeGlob = isGoodRelativeFilePath . map f + where + f '*' = 'x' + f c = c + +-- | See 'isGoodRelativeFilePath'. +isGoodRelativeDirectoryPath :: FilePath -> Maybe String +isGoodRelativeDirectoryPath = state0 + where + -- initial state + state0 [] = Just "empty path" + state0 (c : cs) + | c == '.' = state5 cs + | c == '/' = Just "posix absolute path" + | otherwise = state4 cs + + -- after initial ./ or after / between segments + state1 [] = Nothing + state1 (c : cs) + | c == '.' = state2 cs + | c == '/' = Just "empty path segment" + | otherwise = state4 cs + + -- after non-first setgment's . + state2 [] = Just "trailing same directory segment: ." + state2 (c : cs) + | c == '.' = state3 cs + | c == '/' = Just "same directory segment: ." + | otherwise = state4 cs + + -- after .. + state3 [] = Just "trailing parent directory segment: .." + state3 (c : cs) + | c == '.' = state4 cs + | c == '/' = Just "parent directory segment: .." + | otherwise = state4 cs + + -- in a segment which is ok. + state4 [] = Nothing + state4 (c : cs) + | c == '.' = state4 cs + | c == '/' = state1 cs + | otherwise = state4 cs + + -- after initial . + state5 [] = Nothing -- "." + state5 (c : cs) + | c == '.' = state3 cs + | c == '/' = state1 cs + | otherwise = state4 cs + +-- [Note: Good relative paths] +-- +-- Using @kleene@ we can define an extended regex: +-- +-- @ +-- import Algebra.Lattice +-- import Kleene +-- import Kleene.ERE (ERE (..), intersections) +-- +-- data C = CDot | CSlash | CChar +-- deriving (Eq, Ord, Enum, Bounded, Show) +-- +-- reservedR :: ERE C +-- reservedR = notChar CSlash +-- +-- pathPieceR :: ERE C +-- pathPieceR = intersections +-- [ plus reservedR +-- , ERENot (string [CDot]) +-- , ERENot (string [CDot,CDot]) +-- ] +-- +-- filePathR :: ERE C +-- filePathR = optional (string [CDot, CSlash]) <> pathPieceR <> star (char CSlash <> pathPieceR) +-- +-- dirPathR :: ERE C +-- dirPathR = (char CDot \/ filePathR) <> optional (char CSlash) +-- +-- plus :: ERE C -> ERE C +-- plus r = r <> star r +-- +-- optional :: ERE C -> ERE C +-- optional r = mempty \/ r +-- @ +-- +-- Results in following state machine for @filePathR@ +-- +-- @ +-- 0 -> \x -> if +-- | x <= CDot -> 1 +-- | otherwise -> 5 +-- 1 -> \x -> if +-- | x <= CDot -> 4 +-- | x <= CSlash -> 2 +-- | otherwise -> 5 +-- 2 -> \x -> if +-- | x <= CDot -> 3 +-- | otherwise -> 5 +-- 3 -> \x -> if +-- | x <= CDot -> 4 +-- | otherwise -> 5 +-- 4 -> \x -> if +-- | x <= CDot -> 5 +-- | otherwise -> 5 +-- 5+ -> \x -> if +-- | x <= CDot -> 5 +-- | x <= CSlash -> 2 +-- | otherwise -> 5 +-- @ +-- +-- and @dirPathR@: +-- +-- @ +-- 0 -> \x -> if +-- | x <= CDot -> 5 +-- | otherwise -> 4 +-- 1+ -> \x -> if +-- | x <= CDot -> 2 +-- | otherwise -> 4 +-- 2 -> \x -> if +-- | x <= CDot -> 3 +-- | otherwise -> 4 +-- 3 -> \x -> if +-- | x <= CDot -> 4 +-- | otherwise -> 4 +-- 4+ -> \x -> if +-- | x <= CDot -> 4 +-- | x <= CSlash -> 1 +-- | otherwise -> 4 +-- 5+ -> \x -> if +-- | x <= CDot -> 3 +-- | x <= CSlash -> 1 +-- | otherwise -> 4 +-- @ diff --git a/Cabal/src/Distribution/PackageDescription/Check/Target.hs b/Cabal/src/Distribution/PackageDescription/Check/Target.hs new file mode 100644 index 00000000000..99ae5a8d379 --- /dev/null +++ b/Cabal/src/Distribution/PackageDescription/Check/Target.hs @@ -0,0 +1,1050 @@ +-- | +-- Module : Distribution.PackageDescription.Check.Target +-- Copyright : Lennart Kolmodin 2008, Francesco Ariis 2023 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Fully-realised target (library, executable, …) checking functions. +module Distribution.PackageDescription.Check.Target + ( checkLibrary + , checkForeignLib + , checkExecutable + , checkTestSuite + , checkBenchmark + ) where + +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.CabalSpecVersion +import Distribution.Compat.Lens +import Distribution.Compiler +import Distribution.ModuleName (ModuleName) +import Distribution.Package +import Distribution.PackageDescription +import Distribution.PackageDescription.Check.Common +import Distribution.PackageDescription.Check.Monad +import Distribution.PackageDescription.Check.Paths +import Distribution.Pretty (prettyShow) +import Distribution.Simple.BuildPaths + ( autogenPackageInfoModuleName + , autogenPathsModuleName + ) +import Distribution.Simple.Utils hiding (findPackageDesc, notice) +import Distribution.Types.PackageName.Magic +import Distribution.Utils.Path +import Distribution.Version +import Language.Haskell.Extension +import System.FilePath (takeExtension) + +import Control.Monad + +import qualified Distribution.Types.BuildInfo.Lens as L + +checkLibrary + :: Monad m + => Bool -- Is this a sublibrary? + -> [AssocDep] -- “Inherited” dependencies for PVP checks. + -> Library + -> CheckM m () +checkLibrary + isSub + ads + lib@( Library + libName_ + _exposedModules_ + reexportedModules_ + signatures_ + _libExposed_ + _libVisibility_ + libBuildInfo_ + ) = do + checkP + (libName_ == LMainLibName && isSub) + (PackageBuildImpossible UnnamedInternal) + -- TODO: bogus if a required-signature was passed through. + checkP + (null (explicitLibModules lib) && null reexportedModules_) + (PackageDistSuspiciousWarn (NoModulesExposed libName_)) + -- TODO parse-caught check, can safely remove. + checkSpecVer + CabalSpecV2_0 + (not . null $ signatures_) + (PackageDistInexcusable SignaturesCabal2) + -- autogen/includes checks. + checkP + ( not $ + all + (flip elem (explicitLibModules lib)) + (libModulesAutogen lib) + ) + (PackageBuildImpossible AutogenNotExposed) + -- check that all autogen-includes appear on includes or + -- install-includes. + checkP + ( not $ + all + (flip elem (allExplicitIncludes lib)) + (view L.autogenIncludes lib) + ) + $ (PackageBuildImpossible AutogenIncludesNotIncluded) + + -- § Build infos. + checkBuildInfo + (CETLibrary libName_) + (explicitLibModules lib) + ads + libBuildInfo_ + + -- Feature checks. + -- check use of reexported-modules sections + checkSpecVer + CabalSpecV1_22 + (not . null $ reexportedModules_) + (PackageDistInexcusable CVReexported) + where + allExplicitIncludes :: L.HasBuildInfo a => a -> [FilePath] + allExplicitIncludes x = + view L.includes x + ++ view L.installIncludes x + +checkForeignLib :: Monad m => ForeignLib -> CheckM m () +checkForeignLib + ( ForeignLib + foreignLibName_ + _foreignLibType_ + _foreignLibOptions_ + foreignLibBuildInfo_ + _foreignLibVersionInfo_ + _foreignLibVersionLinux_ + _foreignLibModDefFile_ + ) = do + checkBuildInfo + (CETForeignLibrary foreignLibName_) + [] + [] + foreignLibBuildInfo_ + +checkExecutable + :: Monad m + => [AssocDep] -- “Inherited” dependencies for PVP checks. + -> Executable + -> CheckM m () +checkExecutable + ads + exe@( Executable + exeName_ + modulePath_ + _exeScope_ + buildInfo_ + ) = do + -- Target type/name (exe). + let cet = CETExecutable exeName_ + + -- § Exe specific checks + checkP + (null modulePath_) + (PackageBuildImpossible (NoMainIs exeName_)) + -- This check does not apply to scripts. + pid <- asksCM (pnPackageId . ccNames) + checkP + ( pid /= fakePackageId + && not (null modulePath_) + && not (fileExtensionSupportedLanguage $ modulePath_) + ) + (PackageBuildImpossible NoHsLhsMain) + + -- § Features check + checkSpecVer + CabalSpecV1_18 + ( fileExtensionSupportedLanguage modulePath_ + && takeExtension modulePath_ `notElem` [".hs", ".lhs"] + ) + (PackageDistInexcusable MainCCabal1_18) + + -- Alas exeModules ad exeModulesAutogen (exported from + -- Distribution.Types.Executable) take `Executable` as a parameter. + checkP + (not $ all (flip elem (exeModules exe)) (exeModulesAutogen exe)) + (PackageBuildImpossible $ AutogenNoOther cet) + checkP + ( not $ + all + (flip elem (view L.includes exe)) + (view L.autogenIncludes exe) + ) + (PackageBuildImpossible AutogenIncludesNotIncludedExe) + + -- § Build info checks. + checkBuildInfo cet [] ads buildInfo_ + +checkTestSuite + :: Monad m + => [AssocDep] -- “Inherited” dependencies for PVP checks. + -> TestSuite + -> CheckM m () +checkTestSuite + ads + ts@( TestSuite + testName_ + testInterface_ + testBuildInfo_ + _testCodeGenerators_ + ) = do + -- Target type/name (test). + let cet = CETTest testName_ + + -- § TS specific checks. + -- TODO caught by the parser, can remove safely + case testInterface_ of + TestSuiteUnsupported tt@(TestTypeUnknown _ _) -> + tellP (PackageBuildWarning $ TestsuiteTypeNotKnown tt) + TestSuiteUnsupported tt -> + tellP (PackageBuildWarning $ TestsuiteNotSupported tt) + _ -> return () + checkP + mainIsWrongExt + (PackageBuildImpossible NoHsLhsMain) + checkP + ( not $ + all + (flip elem (testModules ts)) + (testModulesAutogen ts) + ) + (PackageBuildImpossible $ AutogenNoOther cet) + checkP + ( not $ + all + (flip elem (view L.includes ts)) + (view L.autogenIncludes ts) + ) + (PackageBuildImpossible AutogenIncludesNotIncludedExe) + + -- § Feature checks. + checkSpecVer + CabalSpecV1_18 + (mainIsNotHsExt && not mainIsWrongExt) + (PackageDistInexcusable MainCCabal1_18) + + -- § Build info checks. + checkBuildInfo cet [] ads testBuildInfo_ + where + mainIsWrongExt = + case testInterface_ of + TestSuiteExeV10 _ f -> not (fileExtensionSupportedLanguage f) + _ -> False + + mainIsNotHsExt = + case testInterface_ of + TestSuiteExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"] + _ -> False + +checkBenchmark + :: Monad m + => [AssocDep] -- “Inherited” dependencies for PVP checks. + -> Benchmark + -> CheckM m () +checkBenchmark + ads + bm@( Benchmark + benchmarkName_ + benchmarkInterface_ + benchmarkBuildInfo_ + ) = do + -- Target type/name (benchmark). + let cet = CETBenchmark benchmarkName_ + + -- § Interface & bm specific tests. + case benchmarkInterface_ of + BenchmarkUnsupported tt@(BenchmarkTypeUnknown _ _) -> + tellP (PackageBuildWarning $ BenchmarkTypeNotKnown tt) + BenchmarkUnsupported tt -> + tellP (PackageBuildWarning $ BenchmarkNotSupported tt) + _ -> return () + checkP + mainIsWrongExt + (PackageBuildImpossible NoHsLhsMainBench) + + checkP + ( not $ + all + (flip elem (benchmarkModules bm)) + (benchmarkModulesAutogen bm) + ) + (PackageBuildImpossible $ AutogenNoOther cet) + + checkP + ( not $ + all + (flip elem (view L.includes bm)) + (view L.autogenIncludes bm) + ) + (PackageBuildImpossible AutogenIncludesNotIncludedExe) + + -- § BuildInfo checks. + checkBuildInfo cet [] ads benchmarkBuildInfo_ + where + -- Cannot abstract with similar function in checkTestSuite, + -- they are different. + mainIsWrongExt = + case benchmarkInterface_ of + BenchmarkExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"] + _ -> False + +-- ------------------------------------------------------------ +-- Build info +-- ------------------------------------------------------------ + +-- Check a great deal of things in buildInfo. +-- With 'checkBuildInfo' we cannot follow the usual “pattern match +-- everything” method, for the number of BuildInfo fields (almost 50) +-- but more importantly because accessing options, etc. is done +-- with functions from 'Distribution.Types.BuildInfo' (e.g. 'hcOptions'). +-- Duplicating the effort here means risk of diverging definitions for +-- little gain (most likely if a field is added to BI, the relevant +-- function will be tweaked in Distribution.Types.BuildInfo too). +checkBuildInfo + :: Monad m + => CEType -- Name and type of the target. + -> [ModuleName] -- Additional module names which cannot be + -- extracted from BuildInfo (mainly: exposed + -- library modules). + -> [AssocDep] -- Inherited “internal” (main lib, named + -- internal libs) dependencies. + -> BuildInfo + -> CheckM m () +checkBuildInfo cet ams ads bi = do + -- For the sake of clarity, we split che checks in various + -- (top level) functions, even if we are not actually going + -- deeper in the traversal. + + checkBuildInfoOptions (cet2bit cet) bi + checkBuildInfoPathsContent bi + checkBuildInfoPathsWellFormedness bi + + sv <- asksCM ccSpecVersion + checkBuildInfoFeatures bi sv + + checkAutogenModules ams bi + + -- PVP: we check for base and all other deps. + (ids, rds) <- + partitionDeps + ads + [mkUnqualComponentName "base"] + (mergeDependencies $ targetBuildDepends bi) + let ick = const (PackageDistInexcusable BaseNoUpperBounds) + rck = PackageDistSuspiciousWarn . MissingUpperBounds cet + checkPVP ick ids + unless + (isInternalTarget cet) + (checkPVPs rck rds) + + -- Custom fields well-formedness (ASCII). + mapM_ checkCustomField (customFieldsBI bi) + + -- Content. + mapM_ (checkLocalPathExist "extra-lib-dirs") (extraLibDirs bi) + mapM_ + (checkLocalPathExist "extra-lib-dirs-static") + (extraLibDirsStatic bi) + mapM_ + (checkLocalPathExist "extra-framework-dirs") + (extraFrameworkDirs bi) + mapM_ (checkLocalPathExist "include-dirs") (includeDirs bi) + mapM_ + (checkLocalPathExist "hs-source-dirs" . getSymbolicPath) + (hsSourceDirs bi) + +-- Well formedness of BI contents (no `Haskell2015`, no deprecated +-- extensions etc). +checkBuildInfoPathsContent :: Monad m => BuildInfo -> CheckM m () +checkBuildInfoPathsContent bi = do + mapM_ checkLang (allLanguages bi) + mapM_ checkExt (allExtensions bi) + mapM_ checkIntDep (targetBuildDepends bi) + df <- asksCM ccDesugar + -- This way we can use the same function for legacy&non exedeps. + let ds = buildToolDepends bi ++ catMaybes (map df $ buildTools bi) + mapM_ checkBTDep ds + where + checkLang :: Monad m => Language -> CheckM m () + checkLang (UnknownLanguage n) = + tellP (PackageBuildWarning (UnknownLanguages [n])) + checkLang _ = return () + + checkExt :: Monad m => Extension -> CheckM m () + checkExt (UnknownExtension n) + | n `elem` map prettyShow knownLanguages = + tellP (PackageBuildWarning (LanguagesAsExtension [n])) + | otherwise = + tellP (PackageBuildWarning (UnknownExtensions [n])) + checkExt n = do + let dss = filter (\(a, _) -> a == n) deprecatedExtensions + checkP + (not . null $ dss) + (PackageDistSuspicious $ DeprecatedExtensions dss) + + checkIntDep :: Monad m => Dependency -> CheckM m () + checkIntDep d@(Dependency name vrange _) = do + mpn <- + asksCM + ( packageNameToUnqualComponentName + . pkgName + . pnPackageId + . ccNames + ) + lns <- asksCM (pnSubLibs . ccNames) + pVer <- asksCM (pkgVersion . pnPackageId . ccNames) + let allLibNs = mpn : lns + when + ( mpn == packageNameToUnqualComponentName name + -- Make sure it is not a library with the + -- same name from another package. + && packageNameToUnqualComponentName name `elem` allLibNs + ) + ( checkP + (not $ pVer `withinRange` vrange) + (PackageBuildImpossible $ ImpossibleInternalDep [d]) + ) + + checkBTDep :: Monad m => ExeDependency -> CheckM m () + checkBTDep ed@(ExeDependency n name vrange) = do + exns <- asksCM (pnExecs . ccNames) + pVer <- asksCM (pkgVersion . pnPackageId . ccNames) + pNam <- asksCM (pkgName . pnPackageId . ccNames) + checkP + ( n == pNam + && name `notElem` exns -- internal + -- not present + ) + (PackageBuildImpossible $ MissingInternalExe [ed]) + when + (name `elem` exns) + ( checkP + (not $ pVer `withinRange` vrange) + (PackageBuildImpossible $ ImpossibleInternalExe [ed]) + ) + +-- Paths well-formedness check for BuildInfo. +checkBuildInfoPathsWellFormedness :: Monad m => BuildInfo -> CheckM m () +checkBuildInfoPathsWellFormedness bi = do + mapM_ (checkPath False "asm-sources" PathKindFile) (asmSources bi) + mapM_ (checkPath False "cmm-sources" PathKindFile) (cmmSources bi) + mapM_ (checkPath False "c-sources" PathKindFile) (cSources bi) + mapM_ (checkPath False "cxx-sources" PathKindFile) (cxxSources bi) + mapM_ (checkPath False "js-sources" PathKindFile) (jsSources bi) + mapM_ + (checkPath False "install-includes" PathKindFile) + (installIncludes bi) + mapM_ + (checkPath False "hs-source-dirs" PathKindDirectory . getSymbolicPath) + (hsSourceDirs bi) + -- Possibly absolute paths. + mapM_ (checkPath True "includes" PathKindFile) (includes bi) + mapM_ + (checkPath True "include-dirs" PathKindDirectory) + (includeDirs bi) + mapM_ + (checkPath True "extra-lib-dirs" PathKindDirectory) + (extraLibDirs bi) + mapM_ + (checkPath True "extra-lib-dirs-static" PathKindDirectory) + (extraLibDirsStatic bi) + mapM_ checkOptionPath (perCompilerFlavorToList $ options bi) + where + checkOptionPath + :: Monad m + => (CompilerFlavor, [FilePath]) + -> CheckM m () + checkOptionPath (GHC, paths) = + mapM_ + ( \path -> + checkP + (isInsideDist path) + (PackageDistInexcusable $ DistPoint Nothing path) + ) + paths + checkOptionPath _ = return () + +-- Checks for features that can be present in BuildInfo only with certain +-- CabalSpecVersion. +checkBuildInfoFeatures + :: Monad m + => BuildInfo + -> CabalSpecVersion + -> CheckM m () +checkBuildInfoFeatures bi sv = do + -- Default language can be used only w/ spec ≥ 1.10 + checkSpecVer + CabalSpecV1_10 + (isJust $ defaultLanguage bi) + (PackageBuildWarning CVDefaultLanguage) + -- CheckSpecVer sv. + checkP + ( sv >= CabalSpecV1_10 + && sv < CabalSpecV3_4 + && isNothing (defaultLanguage bi) + ) + (PackageBuildWarning CVDefaultLanguageComponent) + -- Check use of 'extra-framework-dirs' field. + checkSpecVer + CabalSpecV1_24 + (not . null $ extraFrameworkDirs bi) + (PackageDistSuspiciousWarn CVExtraFrameworkDirs) + -- Check use of default-extensions field don't need to do the + -- equivalent check for other-extensions. + checkSpecVer + CabalSpecV1_10 + (not . null $ defaultExtensions bi) + (PackageBuildWarning CVDefaultExtensions) + -- Check use of extensions field + checkP + (sv >= CabalSpecV1_10 && (not . null $ oldExtensions bi)) + (PackageBuildWarning CVExtensionsDeprecated) + + -- asm-sources, cmm-sources and friends only w/ spec ≥ 1.10 + checkCVSources (asmSources bi) + checkCVSources (cmmSources bi) + checkCVSources (extraBundledLibs bi) + checkCVSources (extraLibFlavours bi) + + -- extra-dynamic-library-flavours requires ≥ 3.0 + checkSpecVer + CabalSpecV3_0 + (not . null $ extraDynLibFlavours bi) + (PackageDistInexcusable $ CVExtraDynamic [extraDynLibFlavours bi]) + -- virtual-modules requires ≥ 2.2 + checkSpecVer CabalSpecV2_2 (not . null $ virtualModules bi) $ + (PackageDistInexcusable CVVirtualModules) + -- Check use of thinning and renaming. + checkSpecVer + CabalSpecV2_0 + (not . null $ mixins bi) + (PackageDistInexcusable CVMixins) + + checkBuildInfoExtensions bi + where + checkCVSources :: Monad m => [FilePath] -> CheckM m () + checkCVSources cvs = + checkSpecVer + CabalSpecV3_0 + (not . null $ cvs) + (PackageDistInexcusable CVSources) + +-- Tests for extensions usage which can break Cabal < 1.4. +checkBuildInfoExtensions :: Monad m => BuildInfo -> CheckM m () +checkBuildInfoExtensions bi = do + let exts = allExtensions bi + extCabal1_2 = nub $ filter (`elem` compatExtensionsExtra) exts + extCabal1_4 = nub $ filter (`notElem` compatExtensions) exts + -- As of Cabal-1.4 we can add new extensions without worrying + -- about breaking old versions of cabal. + checkSpecVer + CabalSpecV1_2 + (not . null $ extCabal1_2) + ( PackageDistInexcusable $ + CVExtensions CabalSpecV1_2 extCabal1_2 + ) + checkSpecVer + CabalSpecV1_4 + (not . null $ extCabal1_4) + ( PackageDistInexcusable $ + CVExtensions CabalSpecV1_4 extCabal1_4 + ) + where + -- The known extensions in Cabal-1.2.3 + compatExtensions :: [Extension] + compatExtensions = + map + EnableExtension + [ OverlappingInstances + , UndecidableInstances + , IncoherentInstances + , RecursiveDo + , ParallelListComp + , MultiParamTypeClasses + , FunctionalDependencies + , Rank2Types + , RankNTypes + , PolymorphicComponents + , ExistentialQuantification + , ScopedTypeVariables + , ImplicitParams + , FlexibleContexts + , FlexibleInstances + , EmptyDataDecls + , CPP + , BangPatterns + , TypeSynonymInstances + , TemplateHaskell + , ForeignFunctionInterface + , Arrows + , Generics + , NamedFieldPuns + , PatternGuards + , GeneralizedNewtypeDeriving + , ExtensibleRecords + , RestrictedTypeSynonyms + , HereDocuments + ] + ++ map + DisableExtension + [MonomorphismRestriction, ImplicitPrelude] + ++ compatExtensionsExtra + + -- The extra known extensions in Cabal-1.2.3 vs Cabal-1.1.6 + -- (Cabal-1.1.6 came with ghc-6.6. Cabal-1.2 came with ghc-6.8) + compatExtensionsExtra :: [Extension] + compatExtensionsExtra = + map + EnableExtension + [ KindSignatures + , MagicHash + , TypeFamilies + , StandaloneDeriving + , UnicodeSyntax + , PatternSignatures + , UnliftedFFITypes + , LiberalTypeSynonyms + , TypeOperators + , RecordWildCards + , RecordPuns + , DisambiguateRecordFields + , OverloadedStrings + , GADTs + , RelaxedPolyRec + , ExtendedDefaultRules + , UnboxedTuples + , DeriveDataTypeable + , ConstrainedClassMethods + ] + ++ map + DisableExtension + [MonoPatBinds] + +-- Autogenerated modules (Paths_, PackageInfo_) checks. We could pass this +-- function something more specific than the whole BuildInfo, but it would be +-- a tuple of [ModuleName] lists, error prone. +checkAutogenModules + :: Monad m + => [ModuleName] -- Additional modules not present + -- in BuildInfo (e.g. exposed library + -- modules). + -> BuildInfo + -> CheckM m () +checkAutogenModules ams bi = do + pkgId <- asksCM (pnPackageId . ccNames) + let + -- It is an unfortunate reality that autogenPathsModuleName + -- and autogenPackageInfoModuleName work on PackageDescription + -- while not needing it all, but just the `package` bit. + minimalPD = emptyPackageDescription{package = pkgId} + autoPathsName = autogenPathsModuleName minimalPD + autoInfoModuleName = autogenPackageInfoModuleName minimalPD + + -- Autogenerated module + some default extension build failure. + autogenCheck autoPathsName CVAutogenPaths + rebindableClashCheck autoPathsName RebindableClashPaths + + -- Paths_* module + some default extension build failure. + autogenCheck autoInfoModuleName CVAutogenPackageInfo + rebindableClashCheck autoInfoModuleName RebindableClashPackageInfo + where + autogenCheck + :: Monad m + => ModuleName + -> CheckExplanation + -> CheckM m () + autogenCheck name warning = do + sv <- asksCM ccSpecVersion + let allModsForAuto = ams ++ otherModules bi + checkP + ( sv >= CabalSpecV2_0 + && elem name allModsForAuto + && notElem name (autogenModules bi) + ) + (PackageDistInexcusable warning) + + rebindableClashCheck + :: Monad m + => ModuleName + -> CheckExplanation + -> CheckM m () + rebindableClashCheck name warning = do + checkSpecVer + CabalSpecV2_2 + ( ( name `elem` otherModules bi + || name `elem` autogenModules bi + ) + && checkExts + ) + (PackageBuildImpossible warning) + + -- Do we have some peculiar extensions active which would interfere + -- (cabal-version <2.2) with Paths_modules? + checkExts :: Bool + checkExts = + let exts = defaultExtensions bi + in rebind `elem` exts + && (strings `elem` exts || lists `elem` exts) + where + rebind = EnableExtension RebindableSyntax + strings = EnableExtension OverloadedStrings + lists = EnableExtension OverloadedLists + +checkLocalPathExist + :: Monad m + => String -- .cabal field where we found the error. + -> FilePath + -> CheckM m () +checkLocalPathExist title dir = + checkPkg + ( \ops -> do + dn <- not <$> doesDirectoryExist ops dir + let rp = not (isAbsoluteOnAnyPlatform dir) + return (rp && dn) + ) + (PackageBuildWarning $ UnknownDirectory title dir) + +-- PVP -- + +-- Sometimes we read (or end up with) “straddle” deps declarations +-- like this: +-- +-- build-depends: base > 3, base < 4 +-- +-- `mergeDependencies` reduces that to base > 3 && < 4, _while_ maintaining +-- dependencies order in the list (better UX). +mergeDependencies :: [Dependency] -> [Dependency] +mergeDependencies [] = [] +mergeDependencies l@(d : _) = + let (sames, diffs) = partition ((== depName d) . depName) l + merged = + Dependency + (depPkgName d) + ( foldl intersectVersionRanges anyVersion $ + map depVerRange sames + ) + (depLibraries d) + in merged : mergeDependencies diffs + where + depName :: Dependency -> String + depName wd = unPackageName . depPkgName $ wd + +-- Is this an internal target? We do not perform PVP checks on those, +-- see https://github.com/haskell/cabal/pull/8361#issuecomment-1577547091 +isInternalTarget :: CEType -> Bool +isInternalTarget (CETLibrary{}) = False +isInternalTarget (CETForeignLibrary{}) = False +isInternalTarget (CETExecutable{}) = False +isInternalTarget (CETTest{}) = True +isInternalTarget (CETBenchmark{}) = True +isInternalTarget (CETSetup{}) = False + +-- ------------------------------------------------------------ +-- Options +-- ------------------------------------------------------------ + +-- Target type for option checking. +data BITarget = BITLib | BITTestBench | BITOther + deriving (Eq, Show) + +cet2bit :: CEType -> BITarget +cet2bit (CETLibrary{}) = BITLib +cet2bit (CETForeignLibrary{}) = BITLib +cet2bit (CETExecutable{}) = BITOther +cet2bit (CETTest{}) = BITTestBench +cet2bit (CETBenchmark{}) = BITTestBench +cet2bit CETSetup = BITOther + +-- General check on all options (ghc, C, C++, …) for common inaccuracies. +checkBuildInfoOptions :: Monad m => BITarget -> BuildInfo -> CheckM m () +checkBuildInfoOptions t bi = do + checkGHCOptions "ghc-options" t (hcOptions GHC bi) + checkGHCOptions "ghc-prof-options" t (hcProfOptions GHC bi) + checkGHCOptions "ghc-shared-options" t (hcSharedOptions GHC bi) + let ldOpts = ldOptions bi + checkCLikeOptions LangC "cc-options" (ccOptions bi) ldOpts + checkCLikeOptions LangCPlusPlus "cxx-options" (cxxOptions bi) ldOpts + checkCPPOptions (cppOptions bi) + +-- | Checks GHC options for commonly misused or non-portable flags. +checkGHCOptions + :: Monad m + => CabalField -- .cabal field name where we found the error. + -> BITarget -- Target type. + -> [String] -- Options (alas in String form). + -> CheckM m () +checkGHCOptions title t opts = do + checkGeneral + case t of + BITLib -> sequence_ [checkLib, checkNonTestBench] + BITTestBench -> checkTestBench + BITOther -> checkNonTestBench + where + checkFlags :: Monad m => [String] -> PackageCheck -> CheckM m () + checkFlags fs ck = checkP (any (`elem` fs) opts) ck + + checkFlagsP + :: Monad m + => (String -> Bool) + -> (String -> PackageCheck) + -> CheckM m () + checkFlagsP p ckc = + case filter p opts of + [] -> return () + (_ : _) -> tellP (ckc title) + + checkGeneral = do + checkFlags + ["-fasm"] + (PackageDistInexcusable $ OptFasm title) + checkFlags + ["-fhpc"] + (PackageDistInexcusable $ OptHpc title) + checkFlags + ["-prof"] + (PackageBuildWarning $ OptProf title) + -- Does not apply to scripts. + -- Why do we need this? See #8963. + pid <- asksCM (pnPackageId . ccNames) + unless (pid == fakePackageId) $ + checkFlags + ["-o"] + (PackageBuildWarning $ OptO title) + checkFlags + ["-hide-package"] + (PackageBuildWarning $ OptHide title) + checkFlags + ["--make"] + (PackageBuildWarning $ OptMake title) + checkFlags + ["-O", "-O1"] + (PackageDistInexcusable $ OptOOne title) + checkFlags + ["-O2"] + (PackageDistSuspiciousWarn $ OptOTwo title) + checkFlags + ["-split-sections"] + (PackageBuildWarning $ OptSplitSections title) + checkFlags + ["-split-objs"] + (PackageBuildWarning $ OptSplitObjs title) + checkFlags + ["-optl-Wl,-s", "-optl-s"] + (PackageDistInexcusable $ OptWls title) + checkFlags + ["-fglasgow-exts"] + (PackageDistSuspicious $ OptExts title) + let ghcNoRts = rmRtsOpts opts + checkAlternatives + title + "extensions" + [ (flag, prettyShow extension) + | flag <- ghcNoRts + , Just extension <- [ghcExtension flag] + ] + checkAlternatives + title + "extensions" + [ (flag, extension) + | flag@('-' : 'X' : extension) <- ghcNoRts + ] + checkAlternatives + title + "cpp-options" + ( [(flag, flag) | flag@('-' : 'D' : _) <- ghcNoRts] + ++ [(flag, flag) | flag@('-' : 'U' : _) <- ghcNoRts] + ) + checkAlternatives + title + "include-dirs" + [(flag, dir) | flag@('-' : 'I' : dir) <- ghcNoRts] + checkAlternatives + title + "extra-libraries" + [(flag, lib) | flag@('-' : 'l' : lib) <- ghcNoRts] + checkAlternatives + title + "extra-libraries-static" + [(flag, lib) | flag@('-' : 'l' : lib) <- ghcNoRts] + checkAlternatives + title + "extra-lib-dirs" + [(flag, dir) | flag@('-' : 'L' : dir) <- ghcNoRts] + checkAlternatives + title + "extra-lib-dirs-static" + [(flag, dir) | flag@('-' : 'L' : dir) <- ghcNoRts] + checkAlternatives + title + "frameworks" + [ (flag, fmwk) + | (flag@"-framework", fmwk) <- + zip ghcNoRts (safeTail ghcNoRts) + ] + checkAlternatives + title + "extra-framework-dirs" + [ (flag, dir) + | (flag@"-framework-path", dir) <- + zip ghcNoRts (safeTail ghcNoRts) + ] + -- Old `checkDevelopmentOnlyFlagsOptions` section + checkFlags + ["-Werror"] + (PackageDistInexcusable $ WErrorUnneeded title) + checkFlags + ["-fdefer-type-errors"] + (PackageDistInexcusable $ FDeferTypeErrorsUnneeded title) + checkFlags + [ "-fprof-auto" + , "-fprof-auto-top" + , "-fprof-auto-calls" + , "-fprof-cafs" + , "-fno-prof-count-entries" + , "-auto-all" + , "-auto" + , "-caf-all" + ] + (PackageDistSuspicious $ ProfilingUnneeded title) + checkFlagsP + ( \opt -> + "-d" `isPrefixOf` opt + && opt /= "-dynamic" + ) + (PackageDistInexcusable . DynamicUnneeded) + checkFlagsP + ( \opt -> case opt of + "-j" -> True + ('-' : 'j' : d : _) -> isDigit d + _ -> False + ) + (PackageDistInexcusable . JUnneeded) + + checkLib = do + checkP + ("-rtsopts" `elem` opts) + (PackageBuildWarning $ OptRts title) + checkP + (any (\opt -> "-with-rtsopts" `isPrefixOf` opt) opts) + (PackageBuildWarning $ OptWithRts title) + + checkTestBench = do + checkFlags + ["-O0", "-Onot"] + (PackageDistSuspiciousWarn $ OptONot title) + + checkNonTestBench = do + checkFlags + ["-O0", "-Onot"] + (PackageDistSuspicious $ OptONot title) + + ghcExtension ('-' : 'f' : name) = case name of + "allow-overlapping-instances" -> enable OverlappingInstances + "no-allow-overlapping-instances" -> disable OverlappingInstances + "th" -> enable TemplateHaskell + "no-th" -> disable TemplateHaskell + "ffi" -> enable ForeignFunctionInterface + "no-ffi" -> disable ForeignFunctionInterface + "fi" -> enable ForeignFunctionInterface + "no-fi" -> disable ForeignFunctionInterface + "monomorphism-restriction" -> enable MonomorphismRestriction + "no-monomorphism-restriction" -> disable MonomorphismRestriction + "mono-pat-binds" -> enable MonoPatBinds + "no-mono-pat-binds" -> disable MonoPatBinds + "allow-undecidable-instances" -> enable UndecidableInstances + "no-allow-undecidable-instances" -> disable UndecidableInstances + "allow-incoherent-instances" -> enable IncoherentInstances + "no-allow-incoherent-instances" -> disable IncoherentInstances + "arrows" -> enable Arrows + "no-arrows" -> disable Arrows + "generics" -> enable Generics + "no-generics" -> disable Generics + "implicit-prelude" -> enable ImplicitPrelude + "no-implicit-prelude" -> disable ImplicitPrelude + "implicit-params" -> enable ImplicitParams + "no-implicit-params" -> disable ImplicitParams + "bang-patterns" -> enable BangPatterns + "no-bang-patterns" -> disable BangPatterns + "scoped-type-variables" -> enable ScopedTypeVariables + "no-scoped-type-variables" -> disable ScopedTypeVariables + "extended-default-rules" -> enable ExtendedDefaultRules + "no-extended-default-rules" -> disable ExtendedDefaultRules + _ -> Nothing + ghcExtension "-cpp" = enable CPP + ghcExtension _ = Nothing + + enable e = Just (EnableExtension e) + disable e = Just (DisableExtension e) + + rmRtsOpts :: [String] -> [String] + rmRtsOpts ("-with-rtsopts" : _ : xs) = rmRtsOpts xs + rmRtsOpts (x : xs) = x : rmRtsOpts xs + rmRtsOpts [] = [] + +checkCLikeOptions + :: Monad m + => WarnLang -- Language we are warning about (C or C++). + -> CabalField -- Field where we found the error. + -> [String] -- Options in string form. + -> [String] -- Link options in String form. + -> CheckM m () +checkCLikeOptions label prefix opts ldOpts = do + checkAlternatives + prefix + "include-dirs" + [(flag, dir) | flag@('-' : 'I' : dir) <- opts] + checkAlternatives + prefix + "extra-libraries" + [(flag, lib) | flag@('-' : 'l' : lib) <- opts] + checkAlternatives + prefix + "extra-lib-dirs" + [(flag, dir) | flag@('-' : 'L' : dir) <- opts] + + checkAlternatives + "ld-options" + "extra-libraries" + [(flag, lib) | flag@('-' : 'l' : lib) <- ldOpts] + checkAlternatives + "ld-options" + "extra-lib-dirs" + [(flag, dir) | flag@('-' : 'L' : dir) <- ldOpts] + + checkP + (any (`elem` ["-O", "-Os", "-O0", "-O1", "-O2", "-O3"]) opts) + (PackageDistSuspicious $ COptONumber prefix label) + +checkAlternatives + :: Monad m + => CabalField -- Wrong field. + -> CabalField -- Appropriate field. + -> [(String, String)] -- List of good and bad flags. + -> CheckM m () +checkAlternatives badField goodField flags = do + let (badFlags, _) = unzip flags + checkP + (not $ null badFlags) + (PackageBuildWarning $ OptAlternatives badField goodField flags) + +checkCPPOptions + :: Monad m + => [String] -- Options in String form. + -> CheckM m () +checkCPPOptions opts = do + checkAlternatives + "cpp-options" + "include-dirs" + [(flag, dir) | flag@('-' : 'I' : dir) <- opts] + mapM_ + ( \opt -> + checkP + (not $ any (`isPrefixOf` opt) ["-D", "-U", "-I"]) + (PackageBuildWarning (COptCPP opt)) + ) + opts diff --git a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs new file mode 100644 index 00000000000..a8d9ac78195 --- /dev/null +++ b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs @@ -0,0 +1,1009 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | +-- Module : Distribution.PackageDescription.Check.Warning +-- Copyright : Francesco Ariis 2022 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Warning types, messages, severity and associated functions. +module Distribution.PackageDescription.Check.Warning + ( -- * Types and constructors + PackageCheck (..) + , CheckExplanation (..) + , CEField (..) + , CEType (..) + , WarnLang (..) + + -- * Operations + , ppPackageCheck + , isHackageDistError + , extractCheckExplantion + ) where + +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.CabalSpecVersion (CabalSpecVersion, showCabalSpecVersion) +import Distribution.License (License, knownLicenses) +import Distribution.ModuleName (ModuleName) +import Distribution.Parsec.Warning (PWarning, showPWarning) +import Distribution.Pretty (prettyShow) +import Distribution.Types.BenchmarkType (BenchmarkType, knownBenchmarkTypes) +import Distribution.Types.Dependency (Dependency (..)) +import Distribution.Types.ExeDependency (ExeDependency) +import Distribution.Types.Flag (FlagName, unFlagName) +import Distribution.Types.LibraryName (LibraryName (..), showLibraryName) +import Distribution.Types.PackageName (PackageName) +import Distribution.Types.TestType (TestType, knownTestTypes) +import Distribution.Types.UnqualComponentName +import Distribution.Types.Version (Version) +import Distribution.Utils.Path + ( LicenseFile + , PackageDir + , SymbolicPath + , getSymbolicPath + ) +import Language.Haskell.Extension (Extension) + +import qualified Data.List as List +import qualified Data.Set as Set + +-- ------------------------------------------------------------ +-- Check types and explanations +-- ------------------------------------------------------------ + +-- | Results of some kind of failed package check. +-- +-- There are a range of severities, from merely dubious to totally insane. +-- All of them come with a human readable explanation. In future we may augment +-- them with more machine readable explanations, for example to help an IDE +-- suggest automatic corrections. +data PackageCheck + = -- | This package description is no good. There's no way it's going to + -- build sensibly. This should give an error at configure time. + PackageBuildImpossible {explanation :: CheckExplanation} + | -- | A problem that is likely to affect building the package, or an + -- issue that we'd like every package author to be aware of, even if + -- the package is never distributed. + PackageBuildWarning {explanation :: CheckExplanation} + | -- | An issue that might not be a problem for the package author but + -- might be annoying or detrimental when the package is distributed to + -- users. We should encourage distributed packages to be free from these + -- issues, but occasionally there are justifiable reasons so we cannot + -- ban them entirely. + PackageDistSuspicious {explanation :: CheckExplanation} + | -- | Like PackageDistSuspicious but will only display warnings + -- rather than causing abnormal exit when you run 'cabal check'. + PackageDistSuspiciousWarn {explanation :: CheckExplanation} + | -- | An issue that is OK in the author's environment but is almost + -- certain to be a portability problem for other environments. We can + -- quite legitimately refuse to publicly distribute packages with these + -- problems. + PackageDistInexcusable {explanation :: CheckExplanation} + deriving (Eq, Ord) + +-- | Pretty printing 'PackageCheck'. +ppPackageCheck :: PackageCheck -> String +ppPackageCheck e = ppExplanation (explanation e) + +-- | Broken 'Show' instance (not bijective with Read), alas external packages +-- depend on it. +instance Show PackageCheck where + show notice = ppPackageCheck notice + +-- | Would Hackage refuse a package because of this error? +isHackageDistError :: PackageCheck -> Bool +isHackageDistError = \case + (PackageBuildImpossible{}) -> True + (PackageBuildWarning{}) -> True + (PackageDistInexcusable{}) -> True + (PackageDistSuspicious{}) -> False + (PackageDistSuspiciousWarn{}) -> False + +-- | Explanations of 'PackageCheck`'s errors/warnings. +-- +-- ☞ N.B: if you add a constructor here, remeber to change the documentation +-- in @doc/cabal-commands.rst@! Same if you modify it, you need to adjust the +-- documentation! +data CheckExplanation + = ParseWarning FilePath PWarning + | NoNameField + | NoVersionField + | NoTarget + | UnnamedInternal + | DuplicateSections [UnqualComponentName] + | IllegalLibraryName PackageName + | NoModulesExposed LibraryName + | SignaturesCabal2 + | AutogenNotExposed + | AutogenIncludesNotIncluded + | NoMainIs UnqualComponentName + | NoHsLhsMain + | MainCCabal1_18 + | AutogenNoOther CEType + | AutogenIncludesNotIncludedExe + | TestsuiteTypeNotKnown TestType + | TestsuiteNotSupported TestType + | BenchmarkTypeNotKnown BenchmarkType + | BenchmarkNotSupported BenchmarkType + | NoHsLhsMainBench + | InvalidNameWin PackageName + | ZPrefix + | NoBuildType + | NoCustomSetup + | UnknownCompilers [String] + | UnknownLanguages [String] + | UnknownExtensions [String] + | LanguagesAsExtension [String] + | DeprecatedExtensions [(Extension, Maybe Extension)] + | MissingField CEField + | SynopsisTooLong + | ShortDesc + | InvalidTestWith [Dependency] + | ImpossibleInternalDep [Dependency] + | ImpossibleInternalExe [ExeDependency] + | MissingInternalExe [ExeDependency] + | NONELicense + | NoLicense + | AllRightsReservedLicense + | LicenseMessParse License + | UnrecognisedLicense String + | UncommonBSD4 + | UnknownLicenseVersion License [Version] + | NoLicenseFile + | UnrecognisedSourceRepo String + | MissingType + | MissingLocation + | MissingModule + | MissingTag + | SubdirRelPath + | SubdirGoodRelPath String + | OptFasm String + | OptHpc String + | OptProf String + | OptO String + | OptHide String + | OptMake String + | OptONot String + | OptOOne String + | OptOTwo String + | OptSplitSections String + | OptSplitObjs String + | OptWls String + | OptExts String + | OptRts String + | OptWithRts String + | COptONumber String WarnLang + | COptCPP String + | OptAlternatives String String [(String, String)] + | RelativeOutside String FilePath + | AbsolutePath String FilePath + | BadRelativePath String FilePath String + | DistPoint (Maybe String) FilePath + | GlobSyntaxError String String + | RecursiveGlobInRoot String FilePath + | InvalidOnWin [FilePath] + | FilePathTooLong FilePath + | FilePathNameTooLong FilePath + | FilePathSplitTooLong FilePath + | FilePathEmpty + | CVTestSuite + | CVDefaultLanguage + | CVDefaultLanguageComponent + | CVExtraDocFiles + | CVMultiLib + | CVReexported + | CVMixins + | CVExtraFrameworkDirs + | CVDefaultExtensions + | CVExtensionsDeprecated + | CVSources + | CVExtraDynamic [[String]] + | CVVirtualModules + | CVSourceRepository + | CVExtensions CabalSpecVersion [Extension] + | CVCustomSetup + | CVExpliticDepsCustomSetup + | CVAutogenPaths + | CVAutogenPackageInfo + | GlobNoMatch String String + | GlobExactMatch String String FilePath + | GlobNoDir String String FilePath + | UnknownOS [String] + | UnknownArch [String] + | UnknownCompiler [String] + | BaseNoUpperBounds + | MissingUpperBounds CEType [String] + | SuspiciousFlagName [String] + | DeclaredUsedFlags (Set.Set FlagName) (Set.Set FlagName) + | NonASCIICustomField [String] + | RebindableClashPaths + | RebindableClashPackageInfo + | WErrorUnneeded String + | JUnneeded String + | FDeferTypeErrorsUnneeded String + | DynamicUnneeded String + | ProfilingUnneeded String + | UpperBoundSetup String + | DuplicateModule String [ModuleName] + | PotentialDupModule String [ModuleName] + | BOMStart FilePath + | NotPackageName FilePath String + | NoDesc + | MultiDesc [String] + | UnknownFile String (SymbolicPath PackageDir LicenseFile) + | MissingSetupFile + | MissingConfigureScript + | UnknownDirectory String FilePath + | MissingSourceControl + | MissingExpectedDocFiles Bool [FilePath] + | WrongFieldForExpectedDocFiles Bool String [FilePath] + deriving (Eq, Ord, Show) + +-- TODO Some checks have a constructor in list form +-- (e.g. `SomeWarn [n]`), CheckM m () correctly catches warnings in +-- different stanzas in different checks (so it is not one soup). +-- +-- Ideally [SomeWar [a], SomeWar [b]] would be translated into +-- SomeWar [a,b] in the few cases where it is appropriate for UX +-- and left separated otherwise. +-- To achieve this the Writer part of CheckM could be modified +-- to be a ad hoc monoid. + +-- Convenience. +extractCheckExplantion :: PackageCheck -> CheckExplanation +extractCheckExplantion (PackageBuildImpossible e) = e +extractCheckExplantion (PackageBuildWarning e) = e +extractCheckExplantion (PackageDistSuspicious e) = e +extractCheckExplantion (PackageDistSuspiciousWarn e) = e +extractCheckExplantion (PackageDistInexcusable e) = e + +-- | Which stanza does `CheckExplanation` refer to? +data CEType + = CETLibrary LibraryName + | CETForeignLibrary UnqualComponentName + | CETExecutable UnqualComponentName + | CETTest UnqualComponentName + | CETBenchmark UnqualComponentName + | CETSetup + deriving (Eq, Ord, Show) + +-- | Pretty printing `CEType`. +ppCET :: CEType -> String +ppCET cet = case cet of + CETLibrary ln -> showLibraryName ln + CETForeignLibrary n -> "foreign library" ++ qn n + CETExecutable n -> "executable" ++ qn n + CETTest n -> "test suite" ++ qn n + CETBenchmark n -> "benchmark" ++ qn n + CETSetup -> "custom-setup" + where + qn :: UnqualComponentName -> String + qn wn = (" " ++) . quote . prettyShow $ wn + +-- | Which field does `CheckExplanation` refer to? +data CEField + = CEFCategory + | CEFMaintainer + | CEFSynopsis + | CEFDescription + | CEFSynOrDesc + deriving (Eq, Ord, Show) + +-- | Pretty printing `CEField`. +ppCEField :: CEField -> String +ppCEField CEFCategory = "category" +ppCEField CEFMaintainer = "maintainer" +ppCEField CEFSynopsis = "synopsis" +ppCEField CEFDescription = "description" +ppCEField CEFSynOrDesc = "synopsis' or 'description" + +-- | Which language are we referring to in our warning message? +data WarnLang = LangC | LangCPlusPlus + deriving (Eq, Ord, Show) + +-- | Pretty printing `WarnLang`. +ppWarnLang :: WarnLang -> String +ppWarnLang LangC = "C" +ppWarnLang LangCPlusPlus = "C++" + +-- | Pretty printing `CheckExplanation`. +ppExplanation :: CheckExplanation -> String +ppExplanation (ParseWarning fp pp) = showPWarning fp pp +ppExplanation NoNameField = "No 'name' field." +ppExplanation NoVersionField = "No 'version' field." +ppExplanation NoTarget = + "No executables, libraries, tests, or benchmarks found. Nothing to do." +ppExplanation UnnamedInternal = + "Found one or more unnamed internal libraries. Only the non-internal" + ++ " library can have the same name as the package." +ppExplanation (DuplicateSections duplicateNames) = + "Duplicate sections: " + ++ commaSep (map unUnqualComponentName duplicateNames) + ++ ". The name of every library, executable, test suite," + ++ " and benchmark section in the package must be unique." +ppExplanation (IllegalLibraryName pname) = + "Illegal internal library name " + ++ prettyShow pname + ++ ". Internal libraries cannot have the same name as the package." + ++ " Maybe you wanted a non-internal library?" + ++ " If so, rewrite the section stanza" + ++ " from 'library: '" + ++ prettyShow pname + ++ "' to 'library'." +ppExplanation (NoModulesExposed lName) = + showLibraryName lName ++ " does not expose any modules" +ppExplanation SignaturesCabal2 = + "To use the 'signatures' field the package needs to specify " + ++ "at least 'cabal-version: 2.0'." +ppExplanation AutogenNotExposed = + "An 'autogen-module' is neither on 'exposed-modules' nor 'other-modules'." +ppExplanation AutogenIncludesNotIncluded = + "An include in 'autogen-includes' is neither in 'includes' nor " + ++ "'install-includes'." +ppExplanation (NoMainIs eName) = + "No 'main-is' field found for executable " ++ prettyShow eName +ppExplanation NoHsLhsMain = + "The 'main-is' field must specify a '.hs' or '.lhs' file " + ++ "(even if it is generated by a preprocessor), " + ++ "or it may specify a C/C++/obj-C source file." +ppExplanation MainCCabal1_18 = + "The package uses a C/C++/obj-C source file for the 'main-is' field. " + ++ "To use this feature you need to specify 'cabal-version: 1.18' or" + ++ " higher." +ppExplanation (AutogenNoOther ct) = + "On " + ++ ppCET ct + ++ " an 'autogen-module'" + ++ " is not on 'other-modules'" +ppExplanation AutogenIncludesNotIncludedExe = + "An include in 'autogen-includes' is not in 'includes'." +ppExplanation (TestsuiteTypeNotKnown tt) = + quote (prettyShow tt) + ++ " is not a known type of test suite. " + ++ "Either remove the 'type' field or use a known type. " + ++ "The known test suite types are: " + ++ commaSep (map prettyShow knownTestTypes) +ppExplanation (TestsuiteNotSupported tt) = + quote (prettyShow tt) + ++ " is not a supported test suite version. " + ++ "Either remove the 'type' field or use a known type. " + ++ "The known test suite types are: " + ++ commaSep (map prettyShow knownTestTypes) +ppExplanation (BenchmarkTypeNotKnown tt) = + quote (prettyShow tt) + ++ " is not a known type of benchmark. " + ++ "Either remove the 'type' field or use a known type. " + ++ "The known benchmark types are: " + ++ commaSep (map prettyShow knownBenchmarkTypes) +ppExplanation (BenchmarkNotSupported tt) = + quote (prettyShow tt) + ++ " is not a supported benchmark version. " + ++ "Either remove the 'type' field or use a known type. " + ++ "The known benchmark types are: " + ++ commaSep (map prettyShow knownBenchmarkTypes) +ppExplanation NoHsLhsMainBench = + "The 'main-is' field must specify a '.hs' or '.lhs' file " + ++ "(even if it is generated by a preprocessor)." +ppExplanation (InvalidNameWin pkg) = + "The package name '" + ++ prettyShow pkg + ++ "' is " + ++ "invalid on Windows. Many tools need to convert package names to " + ++ "file names, so using this name would cause problems." +ppExplanation ZPrefix = + "Package names with the prefix 'z-' are reserved by Cabal and " + ++ "cannot be used." +ppExplanation NoBuildType = + "No 'build-type' specified. If you do not need a custom Setup.hs or " + ++ "./configure script then use 'build-type: Simple'." +ppExplanation NoCustomSetup = + "Ignoring the 'custom-setup' section because the 'build-type' is " + ++ "not 'Custom'. Use 'build-type: Custom' if you need to use a " + ++ "custom Setup.hs script." +ppExplanation (UnknownCompilers unknownCompilers) = + "Unknown compiler " + ++ commaSep (map quote unknownCompilers) + ++ " in 'tested-with' field." +ppExplanation (UnknownLanguages unknownLanguages) = + "Unknown languages: " ++ commaSep unknownLanguages +ppExplanation (UnknownExtensions unknownExtensions) = + "Unknown extensions: " ++ commaSep unknownExtensions +ppExplanation (LanguagesAsExtension languagesUsedAsExtensions) = + "Languages listed as extensions: " + ++ commaSep languagesUsedAsExtensions + ++ ". Languages must be specified in either the 'default-language' " + ++ " or the 'other-languages' field." +ppExplanation (DeprecatedExtensions ourDeprecatedExtensions) = + "Deprecated extensions: " + ++ commaSep (map (quote . prettyShow . fst) ourDeprecatedExtensions) + ++ ". " + ++ unwords + [ "Instead of '" + ++ prettyShow ext + ++ "' use '" + ++ prettyShow replacement + ++ "'." + | (ext, Just replacement) <- ourDeprecatedExtensions + ] +ppExplanation (MissingField cef) = + "No '" ++ ppCEField cef ++ "' field." +ppExplanation SynopsisTooLong = + "The 'synopsis' field is rather long (max 80 chars is recommended)." +ppExplanation ShortDesc = + "The 'description' field should be longer than the 'synopsis' field. " + ++ "It's useful to provide an informative 'description' to allow " + ++ "Haskell programmers who have never heard about your package to " + ++ "understand the purpose of your package. " + ++ "The 'description' field content is typically shown by tooling " + ++ "(e.g. 'cabal info', Haddock, Hackage) below the 'synopsis' which " + ++ "serves as a headline. " + ++ "Please refer to for more details." +ppExplanation (InvalidTestWith testedWithImpossibleRanges) = + "Invalid 'tested-with' version range: " + ++ commaSep (map prettyShow testedWithImpossibleRanges) + ++ ". To indicate that you have tested a package with multiple " + ++ "different versions of the same compiler use multiple entries, " + ++ "for example 'tested-with: GHC==6.10.4, GHC==6.12.3' and not " + ++ "'tested-with: GHC==6.10.4 && ==6.12.3'." +ppExplanation (ImpossibleInternalDep depInternalLibWithImpossibleVersion) = + "The package has an impossible version range for a dependency on an " + ++ "internal library: " + ++ commaSep (map prettyShow depInternalLibWithImpossibleVersion) + ++ ". This version range does not include the current package, and must " + ++ "be removed as the current package's library will always be used." +ppExplanation (ImpossibleInternalExe depInternalExecWithImpossibleVersion) = + "The package has an impossible version range for a dependency on an " + ++ "internal executable: " + ++ commaSep (map prettyShow depInternalExecWithImpossibleVersion) + ++ ". This version range does not include the current package, and must " + ++ "be removed as the current package's executable will always be used." +ppExplanation (MissingInternalExe depInternalExeWithImpossibleVersion) = + "The package depends on a missing internal executable: " + ++ commaSep (map prettyShow depInternalExeWithImpossibleVersion) +ppExplanation NONELicense = "The 'license' field is missing or is NONE." +ppExplanation NoLicense = "The 'license' field is missing." +ppExplanation AllRightsReservedLicense = + "The 'license' is AllRightsReserved. Is that really what you want?" +ppExplanation (LicenseMessParse lic) = + "Unfortunately the license " + ++ quote (prettyShow lic) + ++ " messes up the parser in earlier Cabal versions so you need to " + ++ "specify 'cabal-version: >= 1.4'. Alternatively if you require " + ++ "compatibility with earlier Cabal versions then use 'OtherLicense'." +ppExplanation (UnrecognisedLicense l) = + quote ("license: " ++ l) + ++ " is not a recognised license. The " + ++ "known licenses are: " + ++ commaSep (map prettyShow knownLicenses) +ppExplanation UncommonBSD4 = + "Using 'license: BSD4' is almost always a misunderstanding. 'BSD4' " + ++ "refers to the old 4-clause BSD license with the advertising " + ++ "clause. 'BSD3' refers the new 3-clause BSD license." +ppExplanation (UnknownLicenseVersion lic known) = + "'license: " + ++ prettyShow lic + ++ "' is not a known " + ++ "version of that license. The known versions are " + ++ commaSep (map prettyShow known) + ++ ". If this is not a mistake and you think it should be a known " + ++ "version then please file a ticket." +ppExplanation NoLicenseFile = "A 'license-file' is not specified." +ppExplanation (UnrecognisedSourceRepo kind) = + quote kind + ++ " is not a recognised kind of source-repository. " + ++ "The repo kind is usually 'head' or 'this'" +ppExplanation MissingType = + "The source-repository 'type' is a required field." +ppExplanation MissingLocation = + "The source-repository 'location' is a required field." +ppExplanation MissingModule = + "For a CVS source-repository, the 'module' is a required field." +ppExplanation MissingTag = + "For the 'this' kind of source-repository, the 'tag' is a required " + ++ "field. It should specify the tag corresponding to this version " + ++ "or release of the package." +ppExplanation SubdirRelPath = + "The 'subdir' field of a source-repository must be a relative path." +ppExplanation (SubdirGoodRelPath err) = + "The 'subdir' field of a source-repository is not a good relative path: " + ++ show err +ppExplanation (OptFasm fieldName) = + "'" + ++ fieldName + ++ ": -fasm' is unnecessary and will not work on CPU " + ++ "architectures other than x86, x86-64, ppc or sparc." +ppExplanation (OptHpc fieldName) = + "'" + ++ fieldName + ++ ": -fhpc' is not necessary. Use the configure flag " + ++ " --enable-coverage instead." +ppExplanation (OptProf fieldName) = + "'" + ++ fieldName + ++ ": -prof' is not necessary and will lead to problems " + ++ "when used on a library. Use the configure flag " + ++ "--enable-library-profiling and/or --enable-profiling." +ppExplanation (OptO fieldName) = + "'" + ++ fieldName + ++ ": -o' is not needed. " + ++ "The output files are named automatically." +ppExplanation (OptHide fieldName) = + "'" + ++ fieldName + ++ ": -hide-package' is never needed. " + ++ "Cabal hides all packages." +ppExplanation (OptMake fieldName) = + "'" + ++ fieldName + ++ ": --make' is never needed. Cabal uses this automatically." +ppExplanation (OptONot fieldName) = + "'" + ++ fieldName + ++ ": -O0' is not needed. " + ++ "Use the --disable-optimization configure flag." +ppExplanation (OptOOne fieldName) = + "'" + ++ fieldName + ++ ": -O' is not needed. " + ++ "Cabal automatically adds the '-O' flag. " + ++ "Setting it yourself interferes with the --disable-optimization flag." +ppExplanation (OptOTwo fieldName) = + "'" + ++ fieldName + ++ ": -O2' is rarely needed. " + ++ "Check that it is giving a real benefit " + ++ "and not just imposing longer compile times on your users." +ppExplanation (OptSplitSections fieldName) = + "'" + ++ fieldName + ++ ": -split-sections' is not needed. " + ++ "Use the --enable-split-sections configure flag." +ppExplanation (OptSplitObjs fieldName) = + "'" + ++ fieldName + ++ ": -split-objs' is not needed. " + ++ "Use the --enable-split-objs configure flag." +ppExplanation (OptWls fieldName) = + "'" + ++ fieldName + ++ ": -optl-Wl,-s' is not needed and is not portable to" + ++ " all operating systems. Cabal 1.4 and later automatically strip" + ++ " executables. Cabal also has a flag --disable-executable-stripping" + ++ " which is necessary when building packages for some Linux" + ++ " distributions and using '-optl-Wl,-s' prevents that from working." +ppExplanation (OptExts fieldName) = + "Instead of '" + ++ fieldName + ++ ": -fglasgow-exts' it is preferable to use " + ++ "the 'extensions' field." +ppExplanation (OptRts fieldName) = + "'" + ++ fieldName + ++ ": -rtsopts' has no effect for libraries. It should " + ++ "only be used for executables." +ppExplanation (OptWithRts fieldName) = + "'" + ++ fieldName + ++ ": -with-rtsopts' has no effect for libraries. It " + ++ "should only be used for executables." +ppExplanation (COptONumber prefix label) = + "'" + ++ prefix + ++ ": -O[n]' is generally not needed. When building with " + ++ " optimisations Cabal automatically adds '-O2' for " + ++ ppWarnLang label + ++ " code. Setting it yourself interferes with the" + ++ " --disable-optimization flag." +ppExplanation (COptCPP opt) = + "'cpp-options: " ++ opt ++ "' is not a portable C-preprocessor flag." +ppExplanation (OptAlternatives badField goodField flags) = + "Instead of " + ++ quote (badField ++ ": " ++ unwords badFlags) + ++ " use " + ++ quote (goodField ++ ": " ++ unwords goodFlags) + where + (badFlags, goodFlags) = unzip flags +ppExplanation (RelativeOutside field path) = + quote (field ++ ": " ++ path) + ++ " is a relative path outside of the source tree. " + ++ "This will not work when generating a tarball with 'sdist'." +ppExplanation (AbsolutePath field path) = + quote (field ++ ": " ++ path) + ++ " specifies an absolute path, but the " + ++ quote field + ++ " field must use relative paths." +ppExplanation (BadRelativePath field path err) = + quote (field ++ ": " ++ path) + ++ " is not a good relative path: " + ++ show err +ppExplanation (DistPoint mfield path) = + incipit + ++ " points inside the 'dist' " + ++ "directory. This is not reliable because the location of this " + ++ "directory is configurable by the user (or package manager). In " + ++ "addition, the layout of the 'dist' directory is subject to change " + ++ "in future versions of Cabal." + where + -- mfiled Nothing -> the path is inside `ghc-options` + incipit = + maybe + ("'ghc-options' path " ++ quote path) + (\field -> quote (field ++ ": " ++ path)) + mfield +ppExplanation (GlobSyntaxError field expl) = + "In the '" ++ field ++ "' field: " ++ expl +ppExplanation (RecursiveGlobInRoot field glob) = + "In the '" + ++ field + ++ "': glob '" + ++ glob + ++ "' starts at project root directory, this might " + ++ "include `.git/`, ``dist-newstyle/``, or other large directories!" +ppExplanation (InvalidOnWin paths) = + "The " + ++ quotes paths + ++ " invalid on Windows, which " + ++ "would cause portability problems for this package. Windows file " + ++ "names cannot contain any of the characters \":*?<>|\" and there " + ++ "a few reserved names including \"aux\", \"nul\", \"con\", " + ++ "\"prn\", \"com1-9\", \"lpt1-9\" and \"clock$\"." + where + quotes [failed] = "path " ++ quote failed ++ " is" + quotes failed = + "paths " + ++ commaSep (map quote failed) + ++ " are" +ppExplanation (FilePathTooLong path) = + "The following file name is too long to store in a portable POSIX " + ++ "format tar archive. The maximum length is 255 ASCII characters.\n" + ++ "The file in question is:\n " + ++ path +ppExplanation (FilePathNameTooLong path) = + "The following file name is too long to store in a portable POSIX " + ++ "format tar archive. The maximum length for the name part (including " + ++ "extension) is 100 ASCII characters. The maximum length for any " + ++ "individual directory component is 155.\n" + ++ "The file in question is:\n " + ++ path +ppExplanation (FilePathSplitTooLong path) = + "The following file name is too long to store in a portable POSIX " + ++ "format tar archive. While the total length is less than 255 ASCII " + ++ "characters, there are unfortunately further restrictions. It has to " + ++ "be possible to split the file path on a directory separator into " + ++ "two parts such that the first part fits in 155 characters or less " + ++ "and the second part fits in 100 characters or less. Basically you " + ++ "have to make the file name or directory names shorter, or you could " + ++ "split a long directory name into nested subdirectories with shorter " + ++ "names.\nThe file in question is:\n " + ++ path +ppExplanation FilePathEmpty = + "Encountered a file with an empty name, something is very wrong! " + ++ "Files with an empty name cannot be stored in a tar archive or in " + ++ "standard file systems." +ppExplanation CVTestSuite = + "The 'test-suite' section is new in Cabal 1.10. " + ++ "Unfortunately it messes up the parser in older Cabal versions " + ++ "so you must specify at least 'cabal-version: >= 1.8', but note " + ++ "that only Cabal 1.10 and later can actually run such test suites." +ppExplanation CVDefaultLanguage = + "To use the 'default-language' field the package needs to specify " + ++ "at least 'cabal-version: >= 1.10'." +ppExplanation CVDefaultLanguageComponent = + "Packages using 'cabal-version: >= 1.10' and before 'cabal-version: 3.4' " + ++ "must specify the 'default-language' field for each component (e.g. " + ++ "Haskell98 or Haskell2010). If a component uses different languages " + ++ "in different modules then list the other ones in the " + ++ "'other-languages' field." +ppExplanation CVExtraDocFiles = + "To use the 'extra-doc-files' field the package needs to specify " + ++ "'cabal-version: 1.18' or higher." +ppExplanation CVMultiLib = + "To use multiple 'library' sections or a named library section " + ++ "the package needs to specify at least 'cabal-version: 2.0'." +ppExplanation CVReexported = + "To use the 'reexported-module' field the package needs to specify " + ++ "'cabal-version: 1.22' or higher." +ppExplanation CVMixins = + "To use the 'mixins' field the package needs to specify " + ++ "at least 'cabal-version: 2.0'." +ppExplanation CVExtraFrameworkDirs = + "To use the 'extra-framework-dirs' field the package needs to specify" + ++ " 'cabal-version: 1.24' or higher." +ppExplanation CVDefaultExtensions = + "To use the 'default-extensions' field the package needs to specify " + ++ "at least 'cabal-version: >= 1.10'." +ppExplanation CVExtensionsDeprecated = + "For packages using 'cabal-version: >= 1.10' the 'extensions' " + ++ "field is deprecated. The new 'default-extensions' field lists " + ++ "extensions that are used in all modules in the component, while " + ++ "the 'other-extensions' field lists extensions that are used in " + ++ "some modules, e.g. via the {-# LANGUAGE #-} pragma." +ppExplanation CVSources = + "The use of 'asm-sources', 'cmm-sources', 'extra-bundled-libraries' " + ++ " and 'extra-library-flavours' requires the package " + ++ " to specify at least 'cabal-version: 3.0'." +ppExplanation (CVExtraDynamic flavs) = + "The use of 'extra-dynamic-library-flavours' requires the package " + ++ " to specify at least 'cabal-version: 3.0'. The flavours are: " + ++ commaSep (concat flavs) +ppExplanation CVVirtualModules = + "The use of 'virtual-modules' requires the package " + ++ " to specify at least 'cabal-version: 2.2'." +ppExplanation CVSourceRepository = + "The 'source-repository' section is new in Cabal 1.6. " + ++ "Unfortunately it messes up the parser in earlier Cabal versions " + ++ "so you need to specify 'cabal-version: >= 1.6'." +ppExplanation (CVExtensions version extCab12) = + "Unfortunately the language extensions " + ++ commaSep (map (quote . prettyShow) extCab12) + ++ " break the parser in earlier Cabal versions so you need to " + ++ "specify 'cabal-version: >= " + ++ showCabalSpecVersion version + ++ "'. Alternatively if you require compatibility with earlier " + ++ "Cabal versions then you may be able to use an equivalent " + ++ "compiler-specific flag." +ppExplanation CVCustomSetup = + "Packages using 'cabal-version: 1.24' or higher with 'build-type: Custom' " + ++ "must use a 'custom-setup' section with a 'setup-depends' field " + ++ "that specifies the dependencies of the Setup.hs script itself. " + ++ "The 'setup-depends' field uses the same syntax as 'build-depends', " + ++ "so a simple example would be 'setup-depends: base, Cabal'." +ppExplanation CVExpliticDepsCustomSetup = + "From version 1.24 cabal supports specifying explicit dependencies " + ++ "for Custom setup scripts. Consider using 'cabal-version: 1.24' or " + ++ "higher and adding a 'custom-setup' section with a 'setup-depends' " + ++ "field that specifies the dependencies of the Setup.hs script " + ++ "itself. The 'setup-depends' field uses the same syntax as " + ++ "'build-depends', so a simple example would be 'setup-depends: base, " + ++ "Cabal'." +ppExplanation CVAutogenPaths = + "Packages using 'cabal-version: 2.0' and the autogenerated " + ++ "module Paths_* must include it also on the 'autogen-modules' field " + ++ "besides 'exposed-modules' and 'other-modules'. This specifies that " + ++ "the module does not come with the package and is generated on " + ++ "setup. Modules built with a custom Setup.hs script also go here " + ++ "to ensure that commands like sdist don't fail." +ppExplanation CVAutogenPackageInfo = + "Packages using 'cabal-version: 2.0' and the autogenerated " + ++ "module PackageInfo_* must include it in 'autogen-modules' as well as" + ++ " 'exposed-modules' and 'other-modules'. This specifies that " + ++ "the module does not come with the package and is generated on " + ++ "setup. Modules built with a custom Setup.hs script also go here " + ++ "to ensure that commands like sdist don't fail." +ppExplanation (GlobNoMatch field glob) = + "In '" + ++ field + ++ "': the pattern '" + ++ glob + ++ "' does not" + ++ " match any files." +ppExplanation (GlobExactMatch field glob file) = + "In '" + ++ field + ++ "': the pattern '" + ++ glob + ++ "' does not" + ++ " match the file '" + ++ file + ++ "' because the extensions do not" + ++ " exactly match (e.g., foo.en.html does not exactly match *.html)." + ++ " To enable looser suffix-only matching, set 'cabal-version: 2.4' or" + ++ " higher." +ppExplanation (GlobNoDir field glob dir) = + "In '" + ++ field + ++ "': the pattern '" + ++ glob + ++ "' attempts to" + ++ " match files in the directory '" + ++ dir + ++ "', but there is no" + ++ " directory by that name." +ppExplanation (UnknownOS unknownOSs) = + "Unknown operating system name " ++ commaSep (map quote unknownOSs) +ppExplanation (UnknownArch unknownArches) = + "Unknown architecture name " ++ commaSep (map quote unknownArches) +ppExplanation (UnknownCompiler unknownImpls) = + "Unknown compiler name " ++ commaSep (map quote unknownImpls) +ppExplanation BaseNoUpperBounds = + "The dependency 'build-depends: base' does not specify an upper " + ++ "bound on the version number. Each major release of the 'base' " + ++ "package changes the API in various ways and most packages will " + ++ "need some changes to compile with it. The recommended practice " + ++ "is to specify an upper bound on the version of the 'base' " + ++ "package. This ensures your package will continue to build when a " + ++ "new major version of the 'base' package is released. If you are " + ++ "not sure what upper bound to use then use the next major " + ++ "version. For example if you have tested your package with 'base' " + ++ "version 4.5 and 4.6 then use 'build-depends: base >= 4.5 && < 4.7'." +ppExplanation (MissingUpperBounds ct names) = + let separator = "\n - " + in "On " + ++ ppCET ct + ++ ", " + ++ "these packages miss upper bounds:" + ++ separator + ++ List.intercalate separator names + ++ "\n" + ++ "Please add them. There is more information at https://pvp.haskell.org/" +ppExplanation (SuspiciousFlagName invalidFlagNames) = + "Suspicious flag names: " + ++ unwords invalidFlagNames + ++ ". " + ++ "To avoid ambiguity in command line interfaces, a flag shouldn't " + ++ "start with a dash. Also for better compatibility, flag names " + ++ "shouldn't contain non-ascii characters." +ppExplanation (DeclaredUsedFlags declared used) = + "Declared and used flag sets differ: " + ++ s declared + ++ " /= " + ++ s used + ++ ". " + where + s :: Set.Set FlagName -> String + s = commaSep . map unFlagName . Set.toList +ppExplanation (NonASCIICustomField nonAsciiXFields) = + "Non ascii custom fields: " + ++ unwords nonAsciiXFields + ++ ". " + ++ "For better compatibility, custom field names " + ++ "shouldn't contain non-ascii characters." +ppExplanation RebindableClashPaths = + "Packages using RebindableSyntax with OverloadedStrings or" + ++ " OverloadedLists in default-extensions, in conjunction with the" + ++ " autogenerated module Paths_*, are known to cause compile failures" + ++ " with Cabal < 2.2. To use these default-extensions with a Paths_*" + ++ " autogen module, specify at least 'cabal-version: 2.2'." +ppExplanation RebindableClashPackageInfo = + "Packages using RebindableSyntax with OverloadedStrings or" + ++ " OverloadedLists in default-extensions, in conjunction with the" + ++ " autogenerated module PackageInfo_*, are known to cause compile failures" + ++ " with Cabal < 2.2. To use these default-extensions with a PackageInfo_*" + ++ " autogen module, specify at least 'cabal-version: 2.2'." +ppExplanation (WErrorUnneeded fieldName) = + addConditionalExp $ + "'" + ++ fieldName + ++ ": -Werror' makes the package easy to " + ++ "break with future GHC versions because new GHC versions often " + ++ "add new warnings." +ppExplanation (JUnneeded fieldName) = + addConditionalExp $ + "'" + ++ fieldName + ++ ": -j[N]' can make sense for a particular user's setup," + ++ " but it is not appropriate for a distributed package." +ppExplanation (FDeferTypeErrorsUnneeded fieldName) = + addConditionalExp $ + "'" + ++ fieldName + ++ ": -fdefer-type-errors' is fine during development " + ++ "but is not appropriate for a distributed package." +ppExplanation (DynamicUnneeded fieldName) = + addConditionalExp $ + "'" + ++ fieldName + ++ ": -d*' debug flags are not appropriate " + ++ "for a distributed package." +ppExplanation (ProfilingUnneeded fieldName) = + addConditionalExp $ + "'" + ++ fieldName + ++ ": -fprof*' profiling flags are typically not " + ++ "appropriate for a distributed library package. These flags are " + ++ "useful to profile this package, but when profiling other packages " + ++ "that use this one these flags clutter the profile output with " + ++ "excessive detail. If you think other packages really want to see " + ++ "cost centres from this package then use '-fprof-auto-exported' " + ++ "which puts cost centres only on exported functions." +ppExplanation (UpperBoundSetup nm) = + "The dependency 'setup-depends: '" + ++ nm + ++ "' does not specify an " + ++ "upper bound on the version number. Each major release of the " + ++ "'" + ++ nm + ++ "' package changes the API in various ways and most " + ++ "packages will need some changes to compile with it. If you are " + ++ "not sure what upper bound to use then use the next major " + ++ "version." +ppExplanation (DuplicateModule s dupLibsLax) = + "Duplicate modules in " + ++ s + ++ ": " + ++ commaSep (map prettyShow dupLibsLax) +ppExplanation (PotentialDupModule s dupLibsStrict) = + "Potential duplicate modules (subject to conditionals) in " + ++ s + ++ ": " + ++ commaSep (map prettyShow dupLibsStrict) +ppExplanation (BOMStart pdfile) = + pdfile + ++ " starts with an Unicode byte order mark (BOM)." + ++ " This may cause problems with older cabal versions." +ppExplanation (NotPackageName pdfile expectedCabalname) = + "The filename " + ++ quote pdfile + ++ " does not match package name " + ++ "(expected: " + ++ quote expectedCabalname + ++ ")" +ppExplanation NoDesc = + "No cabal file found.\n" + ++ "Please create a package description file .cabal" +ppExplanation (MultiDesc multiple) = + "Multiple cabal files found while checking.\n" + ++ "Please use only one of: " + ++ commaSep multiple +ppExplanation (UnknownFile fieldname file) = + "The '" + ++ fieldname + ++ "' field refers to the file " + ++ quote (getSymbolicPath file) + ++ " which does not exist." +ppExplanation MissingSetupFile = + "The package is missing a Setup.hs or Setup.lhs script." +ppExplanation MissingConfigureScript = + "The 'build-type' is 'Configure' but there is no 'configure' script. " + ++ "You probably need to run 'autoreconf -i' to generate it." +ppExplanation (UnknownDirectory kind dir) = + quote (kind ++ ": " ++ dir) + ++ " specifies a directory which does not exist." +ppExplanation MissingSourceControl = + "When distributing packages, it is encouraged to specify source " + ++ "control information in the .cabal file using one or more " + ++ "'source-repository' sections. See the Cabal user guide for " + ++ "details." +ppExplanation (MissingExpectedDocFiles extraDocFileSupport paths) = + "Please consider including the " + ++ quotes paths + ++ " in the '" + ++ targetField + ++ "' section of the .cabal file " + ++ "if it contains useful information for users of the package." + where + quotes [p] = "file " ++ quote p + quotes ps = "files " ++ commaSep (map quote ps) + targetField = + if extraDocFileSupport + then "extra-doc-files" + else "extra-source-files" +ppExplanation (WrongFieldForExpectedDocFiles extraDocFileSupport field paths) = + "Please consider moving the " + ++ quotes paths + ++ " from the '" + ++ field + ++ "' section of the .cabal file " + ++ "to the section '" + ++ targetField + ++ "'." + where + quotes [p] = "file " ++ quote p + quotes ps = "files " ++ commaSep (map quote ps) + targetField = + if extraDocFileSupport + then "extra-doc-files" + else "extra-source-files" + +-- * Formatting utilities + +commaSep :: [String] -> String +commaSep = List.intercalate ", " + +quote :: String -> String +quote s = "'" ++ s ++ "'" + +addConditionalExp :: String -> String +addConditionalExp expl = + expl + ++ " Alternatively, if you want to use this, make it conditional based " + ++ "on a Cabal configuration flag (with 'manual: True' and 'default: " + ++ "False') and enable that flag during development." diff --git a/Cabal/src/Distribution/Simple/BuildToolDepends.hs b/Cabal/src/Distribution/Simple/BuildToolDepends.hs index 486cd2049d9..01592a0970e 100644 --- a/Cabal/src/Distribution/Simple/BuildToolDepends.hs +++ b/Cabal/src/Distribution/Simple/BuildToolDepends.hs @@ -13,7 +13,34 @@ import qualified Data.Map as Map import Distribution.Package import Distribution.PackageDescription --- | Desugar a "build-tools" entry into proper a executable dependency if +-- | Same as 'desugarBuildTool', but requires atomic informations (package +-- name, executable names) instead of a whole 'PackageDescription'. +desugarBuildToolSimple + :: PackageName + -> [UnqualComponentName] + -> LegacyExeDependency + -> Maybe ExeDependency +desugarBuildToolSimple pname exeNames (LegacyExeDependency name reqVer) + | foundLocal = Just $ ExeDependency pname toolName reqVer + | otherwise = Map.lookup name allowMap + where + toolName = mkUnqualComponentName name + foundLocal = toolName `elem` exeNames + allowlist = + [ "hscolour" + , "haddock" + , "happy" + , "alex" + , "hsc2hs" + , "c2hs" + , "cpphs" + , "greencard" + , "hspec-discover" + ] + allowMap = Map.fromList $ flip map allowlist $ \n -> + (n, ExeDependency (mkPackageName n) (mkUnqualComponentName n) reqVer) + +-- | Desugar a "build-tools" entry into a proper executable dependency if -- possible. -- -- An entry can be so desugared in two cases: @@ -31,26 +58,10 @@ desugarBuildTool -> LegacyExeDependency -> Maybe ExeDependency desugarBuildTool pkg led = - if foundLocal - then Just $ ExeDependency (packageName pkg) toolName reqVer - else Map.lookup name whiteMap - where - LegacyExeDependency name reqVer = led - toolName = mkUnqualComponentName name - foundLocal = toolName `elem` map exeName (executables pkg) - whitelist = - [ "hscolour" - , "haddock" - , "happy" - , "alex" - , "hsc2hs" - , "c2hs" - , "cpphs" - , "greencard" - , "hspec-discover" - ] - whiteMap = Map.fromList $ flip map whitelist $ \n -> - (n, ExeDependency (mkPackageName n) (mkUnqualComponentName n) reqVer) + desugarBuildToolSimple + (packageName pkg) + (map exeName $ executables pkg) + led -- | Get everything from "build-tool-depends", along with entries from -- "build-tools" that we know how to desugar. diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs index f35f98f4fcb..1c9188a2a6b 100644 --- a/Cabal/src/Distribution/Simple/Configure.hs +++ b/Cabal/src/Distribution/Simple/Configure.hs @@ -2290,7 +2290,7 @@ checkPackageProblems -> IO () checkPackageProblems verbosity dir gpkg pkg = do ioChecks <- checkPackageFiles verbosity pkg dir - let pureChecks = checkPackage gpkg (Just pkg) + let pureChecks = checkPackage gpkg (errors, warnings) = partitionEithers (M.mapMaybe classEW $ pureChecks ++ ioChecks) if null errors diff --git a/cabal-install/src/Distribution/Client/Check.hs b/cabal-install/src/Distribution/Client/Check.hs index ffd2e6c7ec3..bfcea3f74f3 100644 --- a/cabal-install/src/Distribution/Client/Check.hs +++ b/cabal-install/src/Distribution/Client/Check.hs @@ -24,7 +24,6 @@ import Prelude () import Distribution.Client.Utils.Parsec (renderParseError) import Distribution.PackageDescription (GenericPackageDescription) import Distribution.PackageDescription.Check -import Distribution.PackageDescription.Configuration (flattenPackageDescription) import Distribution.PackageDescription.Parsec ( parseGenericPackageDescription , runParseResult @@ -66,22 +65,8 @@ check verbosity = do (ws, ppd) <- readGenericPackageDescriptionCheck verbosity pdfile -- convert parse warnings into PackageChecks let ws' = map (wrapParseWarning pdfile) ws - -- flatten the generic package description into a regular package - -- description - -- TODO: this may give more warnings than it should give; - -- consider two branches of a condition, one saying - -- ghc-options: -Wall - -- and the other - -- ghc-options: -Werror - -- joined into - -- ghc-options: -Wall -Werror - -- checkPackages will yield a warning on the last line, but it - -- would not on each individual branch. - -- However, this is the same way hackage does it, so we will yield - -- the exact same errors as it will. - let pkg_desc = flattenPackageDescription ppd - ioChecks <- checkPackageFiles verbosity pkg_desc "." - let packageChecks = ioChecks ++ checkPackage ppd (Just pkg_desc) ++ ws' + ioChecks <- checkPackageFilesGPD verbosity ppd "." + let packageChecks = ioChecks ++ checkPackage ppd ++ ws' CM.mapM_ (outputGroupCheck verbosity) (groupChecks packageChecks) diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs index db3bff2640b..9307aae8feb 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -491,7 +491,7 @@ exAvSrcPkg ex = -- Furthermore we ignore missing upper bound warnings because -- they are not related to this test suite, and are tested -- with golden tests. - let checks = C.checkPackage (srcpkgDescription package) Nothing + let checks = C.checkPackage (srcpkgDescription package) in filter (\x -> not (isMissingUpperBound x) && not (isUnknownLangExt x)) checks in if null pkgCheckErrors then package diff --git a/cabal-testsuite/PackageTests/AutogenModules/Package/my.cabal b/cabal-testsuite/PackageTests/AutogenModules/Package/my.cabal index 37dfcbf7bce..2ddd13ed619 100644 --- a/cabal-testsuite/PackageTests/AutogenModules/Package/my.cabal +++ b/cabal-testsuite/PackageTests/AutogenModules/Package/my.cabal @@ -14,7 +14,7 @@ description: Library default-language: Haskell2010 - build-depends: base + build-depends: base == 4.* exposed-modules: MyLibrary PackageInfo_AutogenModules @@ -28,7 +28,7 @@ Library Executable Exe default-language: Haskell2010 main-is: Dummy.hs - build-depends: base + build-depends: base == 4.* other-modules: MyExeModule PackageInfo_AutogenModules @@ -41,7 +41,7 @@ Test-Suite Test default-language: Haskell2010 main-is: Dummy.hs type: exitcode-stdio-1.0 - build-depends: base + build-depends: base == 4.* other-modules: MyTestModule PackageInfo_AutogenModules @@ -54,7 +54,7 @@ Benchmark Bench default-language: Haskell2010 main-is: Dummy.hs type: exitcode-stdio-1.0 - build-depends: base + build-depends: base == 4.* other-modules: MyBenchModule PackageInfo_AutogenModules diff --git a/cabal-testsuite/PackageTests/AutogenModules/SrcDist/AutogenModules.cabal b/cabal-testsuite/PackageTests/AutogenModules/SrcDist/AutogenModules.cabal index 8c8f1a98b89..0976dbf493a 100644 --- a/cabal-testsuite/PackageTests/AutogenModules/SrcDist/AutogenModules.cabal +++ b/cabal-testsuite/PackageTests/AutogenModules/SrcDist/AutogenModules.cabal @@ -14,7 +14,7 @@ description: Library default-language: Haskell2010 - build-depends: base + build-depends: base == 4.* exposed-modules: MyLibrary PackageInfo_AutogenModules @@ -30,7 +30,7 @@ Library Executable Exe default-language: Haskell2010 main-is: Dummy.hs - build-depends: base + build-depends: base == 4.* other-modules: MyExeModule PackageInfo_AutogenModules @@ -45,7 +45,7 @@ Test-Suite Test default-language: Haskell2010 main-is: Dummy.hs type: exitcode-stdio-1.0 - build-depends: base + build-depends: base == 4.* other-modules: MyTestModule PackageInfo_AutogenModules @@ -60,7 +60,7 @@ Benchmark Bench default-language: Haskell2010 main-is: Dummy.hs type: exitcode-stdio-1.0 - build-depends: base + build-depends: base == 4.* other-modules: MyBenchModule PackageInfo_AutogenModules diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/cabal.out index 5710d84e88c..bfff695159e 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/cabal.out +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/cabal.out @@ -1,4 +1,4 @@ # cabal check The package will not build sanely due to these errors: -Error: The package has an impossible version range for a dependency on an internal library: pkg:internal >1.0. This version range does not include the current package, and must be removed as the current package's library will always be used. +Error: The package has an impossible version range for a dependency on an internal library: pkg:internal >1.0 && <2.0. This version range does not include the current package, and must be removed as the current package's library will always be used. Error: Hackage would reject this package. diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/pkg.cabal b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/pkg.cabal index 71c35a369a3..ffebdd5ee04 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/pkg.cabal +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/pkg.cabal @@ -10,7 +10,7 @@ license: GPL-3.0-or-later library exposed-modules: Module build-depends: base == 4.*, - internal > 1.0 + internal > 1.0 && < 2.0 default-language: Haskell2010 library internal diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/cabal.out new file mode 100644 index 00000000000..37aa169b416 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/cabal.out @@ -0,0 +1,2 @@ +# cabal check +No errors or warnings could be found in the package. diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/cabal.test.hs b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/cabal.test.hs new file mode 100644 index 00000000000..856a1aaad81 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/cabal.test.hs @@ -0,0 +1,4 @@ +import Test.Cabal.Prelude + +-- Do not output warning when an -O2 is behind a cabal flag. +main = cabalTest $ cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/pkg.cabal b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/pkg.cabal new file mode 100644 index 00000000000..da87e698285 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/pkg.cabal @@ -0,0 +1,18 @@ +cabal-version: 2.2 +name: pkg +version: 0 +category: example +maintainer: none@example.com +synopsis: synopsys +description: description +license: GPL-3.0-or-later + +flag force-O2 + default: False + manual: True + +library + exposed-modules: Foo + default-language: Haskell2010 + if flag(force-O2) + ghc-options: -O2 diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.out new file mode 100644 index 00000000000..54660ce787e --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.out @@ -0,0 +1,4 @@ +# cabal check +These warnings may cause trouble when distributing the package: +Warning: 'ghc-options: -O2' is rarely needed. Check that it is giving a real benefit and not just imposing longer compile times on your users. + diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.test.hs b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.test.hs new file mode 100644 index 00000000000..e9e0fe10b47 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +-- Output warning when an -O2 inside a cabal flag, but the flag is not +-- marked as `manual: True`. +main = cabalTest $ cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/pkg.cabal b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/pkg.cabal new file mode 100644 index 00000000000..415422cff12 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/pkg.cabal @@ -0,0 +1,17 @@ +cabal-version: 2.2 +name: pkg +version: 0 +category: example +maintainer: none@example.com +synopsis: synopsys +description: description +license: GPL-3.0-or-later + +flag force-O2 + default: False + +library + exposed-modules: Foo + default-language: Haskell2010 + if flag(force-O2) + ghc-options: -O2 diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.out new file mode 100644 index 00000000000..54660ce787e --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.out @@ -0,0 +1,4 @@ +# cabal check +These warnings may cause trouble when distributing the package: +Warning: 'ghc-options: -O2' is rarely needed. Check that it is giving a real benefit and not just imposing longer compile times on your users. + diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.test.hs b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.test.hs new file mode 100644 index 00000000000..8cfba826bd7 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.test.hs @@ -0,0 +1,4 @@ +import Test.Cabal.Prelude + +-- Output warning when an -O2 outside a cabal flag, along with one inside. +main = cabalTest $ cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/pkg.cabal b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/pkg.cabal new file mode 100644 index 00000000000..cec9eec5fe9 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/pkg.cabal @@ -0,0 +1,19 @@ +cabal-version: 2.2 +name: pkg +version: 0 +category: example +maintainer: none@example.com +synopsis: synopsys +description: description +license: GPL-3.0-or-later + +flag force-O2 + default: False + manual: True + +library + exposed-modules: Foo + default-language: Haskell2010 + ghc-options: -O2 + if flag(force-O2) + ghc-options: -O2 diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/cabal.out new file mode 100644 index 00000000000..37aa169b416 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/cabal.out @@ -0,0 +1,2 @@ +# cabal check +No errors or warnings could be found in the package. diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/cabal.test.hs b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/cabal.test.hs new file mode 100644 index 00000000000..a6da4f86777 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +-- Absolute paths can be used in `extra-lib-dirs`. +main = cabalTest $ + cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/pkg.cabal b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/pkg.cabal new file mode 100644 index 00000000000..087e00b080b --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/pkg.cabal @@ -0,0 +1,13 @@ +cabal-version: 3.0 +name: pkg +synopsis: synopsis +description: description +version: 0 +category: example +maintainer: none@example.com +license: GPL-3.0-or-later + +library + exposed-modules: Module + default-language: Haskell2010 + extra-lib-dirs: /home/ diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/DistPoint/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/DistPoint/cabal.out index 81f9ada5773..477e1108ab3 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/DistPoint/cabal.out +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/DistPoint/cabal.out @@ -1,4 +1,4 @@ # cabal check The following errors will cause portability problems on other environments: -Error: 'ghc-options' path 'dist/file' points inside the 'dist' directory. This is not reliable because the location of this directory is configurable by the user (or package manager). In addition the layout of the 'dist' directory is subject to change in future versions of Cabal. +Error: 'ghc-options' path 'dist/file' points inside the 'dist' directory. This is not reliable because the location of this directory is configurable by the user (or package manager). In addition, the layout of the 'dist' directory is subject to change in future versions of Cabal. Error: Hackage would reject this package. diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/RecursiveGlobInRoot/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/RecursiveGlobInRoot/cabal.out index e2506317dc1..e4930d6a4b5 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/RecursiveGlobInRoot/cabal.out +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/RecursiveGlobInRoot/cabal.out @@ -1,5 +1,5 @@ # cabal check These warnings may cause trouble when distributing the package: Warning: In the 'data-files': glob '**/*.dat' starts at project root directory, this might include `.git/`, ``dist-newstyle/``, or other large directories! -Warning: In the 'extra-source-files': glob '**/*.hs' starts at project root directory, this might include `.git/`, ``dist-newstyle/``, or other large directories! Warning: In the 'extra-doc-files': glob '**/*.md' starts at project root directory, this might include `.git/`, ``dist-newstyle/``, or other large directories! +Warning: In the 'extra-source-files': glob '**/*.hs' starts at project root directory, this might include `.git/`, ``dist-newstyle/``, or other large directories! diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/AutogenIncludes/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/AutogenIncludes/cabal.out index b4977e9d6c6..3ae07a9c509 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/AutogenIncludes/cabal.out +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/AutogenIncludes/cabal.out @@ -1,4 +1,4 @@ # cabal check The package will not build sanely due to these errors: -Error: An include in 'autogen-includes' is neither in 'includes' or 'install-includes'. +Error: An include in 'autogen-includes' is neither in 'includes' nor 'install-includes'. Error: Hackage would reject this package. diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoDupNames/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoDupNames/cabal.out index be0d14356f6..fd288ec5fdd 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoDupNames/cabal.out +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/NoDupNames/cabal.out @@ -1 +1,4 @@ # cabal check +The package will not build sanely due to these errors: +Error: Duplicate sections: dup. The name of every library, executable, test suite, and benchmark section in the package must be unique. +Error: Hackage would reject this package. diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/LICENSE b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/LICENSE new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.out new file mode 100644 index 00000000000..a5ef963c71f --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.out @@ -0,0 +1,4 @@ +# cabal check +The following errors will cause portability problems on other environments: +Error: 'ghc-options: -j[N]' can make sense for a particular user's setup, but it is not appropriate for a distributed package. Alternatively, if you want to use this, make it conditional based on a Cabal configuration flag (with 'manual: True' and 'default: False') and enable that flag during development. +Error: Hackage would reject this package. diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.test.hs b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.test.hs new file mode 100644 index 00000000000..48efe554e6b --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +-- `check` should not be confused by an user flag. +main = cabalTest $ + fails $ cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/pkg.cabal b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/pkg.cabal new file mode 100644 index 00000000000..b0f8bc85140 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/pkg.cabal @@ -0,0 +1,25 @@ +name: pkg +version: 0.0.0.1 +synopsis: The Servant +description: Various capabilities +category: prelude +maintainer: smokejumperit+rfc@gmail.com +license: MIT +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 + +flag production + description: Disables failing. + manual: True + default: False + +library + exposed-modules: + RFC.Servant.API + ghc-options: -j + if flag(production) + ghc-options: -feager-blackholing + else + cpp-options: -DDEVELOPMENT + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/Jn/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/Jn/cabal.out index 4024acad24e..b3217c803cf 100644 --- a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/Jn/cabal.out +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/Jn/cabal.out @@ -1,4 +1,4 @@ # cabal check The following errors will cause portability problems on other environments: -Error: 'ghc-shared-options: -j[N]' can make sense for specific user's setup, but it is not appropriate for a distributed package. Alternatively, if you want to use this, make it conditional based on a Cabal configuration flag (with 'manual: True' and 'default: False') and enable that flag during development. +Error: 'ghc-shared-options: -j[N]' can make sense for a particular user's setup, but it is not appropriate for a distributed package. Alternatively, if you want to use this, make it conditional based on a Cabal configuration flag (with 'manual: True' and 'default: False') and enable that flag during development. Error: Hackage would reject this package. diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/cabal.out new file mode 100644 index 00000000000..37aa169b416 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/cabal.out @@ -0,0 +1,2 @@ +# cabal check +No errors or warnings could be found in the package. diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/cabal.test.hs b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/cabal.test.hs new file mode 100644 index 00000000000..be0007ff8f3 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +-- Do not complain if WError is under a user, off-by-default flag. +main = cabalTest $ + cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/pkg.cabal b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/pkg.cabal new file mode 100644 index 00000000000..9a5e9b708d1 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/pkg.cabal @@ -0,0 +1,20 @@ +cabal-version: 3.0 +name: pkg +synopsis: synopsis +description: description +version: 0 +category: example +maintainer: none@example.com +license: GPL-3.0-or-later + +flag dev + description: Turn on development settings. + manual: True + default: False + +library + exposed-modules: Foo + default-language: Haskell2010 + if flag(dev) + ghc-options: -Werror + diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.out new file mode 100644 index 00000000000..37aa169b416 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.out @@ -0,0 +1,2 @@ +# cabal check +No errors or warnings could be found in the package. diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.test.hs b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.test.hs new file mode 100644 index 00000000000..1a6b28f94fc --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +-- Unbounded (top) base with internal dependency: no warn, no error. +main = cabalTest $ + cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/pkg.cabal b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/pkg.cabal new file mode 100644 index 00000000000..91943d4987a --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/pkg.cabal @@ -0,0 +1,19 @@ +cabal-version: 3.0 +name: pkg +synopsis: synopsis +description: description +version: 0 +category: example +maintainer: none@example.com +license: GPL-3.0-or-later + +library + exposed-modules: Foo + default-language: Haskell2010 + build-depends: base <= 3.10 + +executable test-exe + main-is: Main.hs + default-language: Haskell2010 + build-depends: base, pkg + diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.out new file mode 100644 index 00000000000..ff21f73f613 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.out @@ -0,0 +1,5 @@ +# cabal check +These warnings may cause trouble when distributing the package: +Warning: On executable 'prova', these packages miss upper bounds: +- acme-box +Please add them. There is more information at https://pvp.haskell.org/ diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.test.hs b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.test.hs new file mode 100644 index 00000000000..62207619ac5 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +-- Unbounded with internal dependency: do not warn. +main = cabalTest $ + cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/pkg.cabal b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/pkg.cabal new file mode 100644 index 00000000000..06c47e49740 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/pkg.cabal @@ -0,0 +1,22 @@ +cabal-version: 3.0 +name: pkg +version: 2 +maintainer: fffaaa +category: asdasd +synopsis: asdcasdcs +description: cdscsd acs dcs dss +license: GPL-3.0-or-later + +library + exposed-modules: Foo + build-depends: text < 5.0 + default-language: Haskell2010 + +executable prova + main-is: Prova.hs + build-depends: + pkg + , text + , acme-box + default-language: Haskell2010 + diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.out new file mode 100644 index 00000000000..e0821ac6ea5 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.out @@ -0,0 +1,5 @@ +# cabal check +These warnings may cause trouble when distributing the package: +Warning: On library 'int-lib', these packages miss upper bounds: +- text +Please add them. There is more information at https://pvp.haskell.org/ diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.test.hs b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.test.hs new file mode 100644 index 00000000000..597002165fb --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +-- Internal libraries missing upper bound are correctly reported. +main = cabalTest $ + cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/pkg.cabal b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/pkg.cabal new file mode 100644 index 00000000000..3d5b861f059 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/pkg.cabal @@ -0,0 +1,20 @@ +cabal-version: 3.0 +name: pkg +synopsis: synopsis +description: description +version: 0 +category: example +maintainer: none@example.com +license: GPL-3.0-or-later + +library + exposed-modules: Foo + build-depends: base <= 3.10, + int-lib + default-language: Haskell2010 + +library int-lib + exposed-modules: Bar + build-depends: text > 1 + default-language: Haskell2010 + diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.out new file mode 100644 index 00000000000..37aa169b416 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.out @@ -0,0 +1,2 @@ +# cabal check +No errors or warnings could be found in the package. diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.test.hs b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.test.hs new file mode 100644 index 00000000000..c0819c5841a --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.test.hs @@ -0,0 +1,6 @@ +import Test.Cabal.Prelude + +-- Straddle deps declarations (build-depends: base > 5, base < 6) +-- should not error. +main = cabalTest $ + cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/pkg.cabal b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/pkg.cabal new file mode 100644 index 00000000000..b21ffe61f12 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/pkg.cabal @@ -0,0 +1,15 @@ +cabal-version: 3.0 +name: pkg +synopsis: synopsis +description: description +version: 0 +category: example +maintainer: none@example.com +license: GPL-3.0-or-later + +library + exposed-modules: Foo + default-language: Haskell2010 + build-depends: base > 2, + base <= 3.10 + diff --git a/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/LICENSE b/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/LICENSE new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/cabal.out b/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/cabal.out new file mode 100644 index 00000000000..37aa169b416 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/cabal.out @@ -0,0 +1,2 @@ +# cabal check +No errors or warnings could be found in the package. diff --git a/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/cabal.test.hs b/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/cabal.test.hs new file mode 100644 index 00000000000..967a72a460c --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +-- Do not warn on non-existant directory if it is absolute. +main = cabalTest $ + cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/pkg.cabal b/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/pkg.cabal new file mode 100644 index 00000000000..d208bae8cd3 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/pkg.cabal @@ -0,0 +1,17 @@ +Name: pkg +Version: 0.1.0.0 +Synopsis: Low +description: lallalala +License: LGPL-3 +License-File: LICENSE +Maintainer: Maksymilian.Owsianny+AwesomiumRaw@gmail.com +Bug-Reports: https://github.com/MaxOw/awesomium-raw/issues +Category: Graphics, Web +Build-Type: Simple +Cabal-Version: >=1.8 + +Library + Exposed-Modules: Graphics.UI.Awesomium.Raw + Build-Depends: base >= 3 && < 5 + Extra-Lib-Dirs: /usr/lib/awesomium-1.6.5 + diff --git a/cabal-testsuite/PackageTests/Check/PackageFiles/VCSInfo/cabal.out b/cabal-testsuite/PackageTests/Check/PackageFiles/VCSInfo/cabal.out index 0b90abdd9d7..b709524c109 100644 --- a/cabal-testsuite/PackageTests/Check/PackageFiles/VCSInfo/cabal.out +++ b/cabal-testsuite/PackageTests/Check/PackageFiles/VCSInfo/cabal.out @@ -1,3 +1,3 @@ # cabal check These warnings will likely cause trouble when distributing the package: -Warning: When distributing packages it is encouraged to specify source control information in the .cabal file using one or more 'source-repository' sections. See the Cabal user guide for details. +Warning: When distributing packages, it is encouraged to specify source control information in the .cabal file using one or more 'source-repository' sections. See the Cabal user guide for details. diff --git a/changelog.d/pr-8427 b/changelog.d/pr-8427 new file mode 100644 index 00000000000..402765942d6 --- /dev/null +++ b/changelog.d/pr-8427 @@ -0,0 +1,19 @@ +synopsis: Reimplementing `cabal check` +packages: Cabal +prs: #8427 +issues: #7423 + +description: { + +- For `cabal-install` users: `cabal check` do not warn on -O2 or similar + options if under an off-by-default cabal flag. +- For `Cabal` the library users: `checkPackage` signature has been simplified, + you do not need to pass a specific configuration of the package, since + we do not flatten GenericPackageDescription no more. +- For `Cabal` the library users: `checkPackageFileNames` has been removed, + use `checkPackageFiles` instead. +- For `Cabal` the library users: `checkPackageFilesGPD` has been introduced, + a function similar to `checkPackageFiles` that works on + `GenericPackageDescription`. You do not need to use + `flattenPackageDescription` anymore. +} diff --git a/doc/cabal-commands.rst b/doc/cabal-commands.rst index 05f1666279d..5419186f73c 100644 --- a/doc/cabal-commands.rst +++ b/doc/cabal-commands.rst @@ -1181,6 +1181,142 @@ to Hackage requirements for uploaded packages: if no error is reported, Hackage should accept your package. If errors are present ``cabal check`` exits with ``1`` and Hackage will refuse the package. +A list of all warnings with their constructor: + +- ParseWarning: warnings inherited from parser. +- NoNameField: missing ``name`` field. +- NoVersionField: missing ``version`` field. +- NoTarget: missing target in ``.cabal``. +- UnnamedInternal: unnamed internal library. +- DuplicateSections: duplicate name in target. +- IllegalLibraryName: internal library with same name as package. +- NoModulesExposed: no module exposed in library. +- SignaturesCabal2: ``signatures`` used with ``cabal-version`` < 2.0 +- AutogenNotExposed: ``autogen-module`` neither in ``exposed-modules`` nor ``other-modules``. +- AutogenIncludesNotIncluded: ``autogen-include`` neither in ``include`` nor ``install-includes``. +- NoMainIs: missing ``main-is``. +- NoHsLhsMain: ``main-is`` is not ``.hs`` nor ``.lhs``. +- MainCCabal1_18: C-like source file in ``main-is`` with ``cabal-version`` < 1.18. +- AutogenNoOther: ``autogen-module`` not in ``other-modules``. +- AutogenIncludesNotIncludedExe: ``autogen-include`` not in ``includes``. +- TestsuiteTypeNotKnown: unknown test-suite type. +- TestsuiteNotSupported: unsupported test-suite type. +- BenchmarkTypeNotKnown: unknown benchmark type. +- BenchmarkNotSupported: unsupported benchmark type. +- NoHsLhsMainBench: ``main-is`` for benchmark is neither ``.hs`` nor ``.lhs``. +- InvalidNameWin: invalid package name on Windows. +- ZPrefix: package with ``z-`` prexif (reseved for Cabal. +- NoBuildType: missing ``build-type``. +- NoCustomSetup: ``custom-setup`` section without ``build-type: Custom`` +- UnknownCompilers: unknown compiler in ``tested-with``. +- UnknownLanguages: unknown languages. +- UnknownExtensions: unknown extensions. +- LanguagesAsExtension: languages listed as extensions. +- DeprecatedExtensions: deprecated extensions. +- MissingField: missing cabal field (one of ``category``, ``maintainer``, ``synopsis``, ``description``). +- SynopsisTooLong: ``synopsis`` longer than 80 characters. +- ShortDesc: ``description`` shorter than ``synopsis``. +- InvalidTestWith: invalid ``tested-with`` version range. +- ImpossibleInternalDep: impossible internal library version range dependency. +- ImpossibleInternalExe: impossible internal executable version range dependency. +- MissingInternalExe: missing internal executable. +- NONELicense: ``NONE`` in ``license`` field. +- NoLicense: no ``license`` field. +- AllRightsReservedLicense: all rights reserved license. +- LicenseMessParse: license not to be used with `cabal-version` < 1.4. +- UnrecognisedLicense: unknown license. +- UncommonBSD4: uncommon BSD (BSD4) license. +- UnknownLicenseVersion: unknown license version. +- NoLicenseFile: missing license file. +- UnrecognisedSourceRepo: unrecognised kind of source-repository. +- MissingType: missing ``type`` in ``source-repository``. +- MissingLocation: missing ``location`` in ``source-repository``. +- MissingModule: missing ``module`` in ``source-repository``. +- MissingTag: missing ``tag`` in ``source-repository``. +- SubdirRelPath: ``subdir`` in ``source-repository`` must be relative. +- SubdirGoodRelPath: malformed ``subdir`` in ``source-repository``. +- OptFasm: unnecessary ``-fasm``. +- OptViaC: unnecessary ``-fvia-C``. +- OptHpc: unnecessary ``-fhpc``. +- OptProf: unnecessary ``-prof``. +- OptO: unnecessary ``-o``. +- OptHide: unnecessary ``-hide-package``. +- OptMake: unnecessary ``--make``. +- OptONot: unnecessary disable optimisation flag. +- OptOOne: unnecessary optimisation flag (``-O1``). +- OptOTwo: unnecessary optimisation flag (``-O2``). +- OptSplitSections: unnecessary ``-split-section``. +- OptSplitObjs: unnecessary ``-split-objs``. +- OptWls: unnecessary ``-optl-Wl,-s``. +- OptExts: use ``extension`` field instead of ``-fglasgow-exts``. +- OptRts: unnecessary ``-rtsopts``. +- OptWithRts: unnecessary ``-with-rtsopts``. +- COptONumber: unnecessary ``-O[n]`` in C code. +- COptCPP: unportable ``-cpp-options`` flag. +- OptAlternatives: C-like options in wrong cabal field. +- RelativeOutside: relative path outside of source tree. +- AbsolutePath: absolute path where not allowed. +- BadRelativePath: malformed relative path. +- DistPoint: unreliable path pointing inside ``dist``. +- GlobSyntaxError: glob syntax error. +- RecursiveGlobInRoot: recursive glob including source control folders. +- InvalidOnWin: invalid path on Windows. +- FilePathTooLong: path too long. +- FilePathNameTooLong: path *name* too long (POSIX). +- FilePathSplitTooLong: path non portable (POSIX, split requirements). +- FilePathEmpty: empty path. +- CVTestSuite: ``test-suite`` used with ``cabal-version`` < 1.10. +- CVDefaultLanguage: ``default-language`` used with ``cabal-version`` < 1.10. +- CVDefaultLanguageComponent: missing ``default-language``. +- CVExtraDocFiles: `extra-doc-files` used with ``cabal-version`` < 1.18. +- CVMultiLib: multiple ``library`` sections with ``cabal-version`` < 2.0. +- CVReexported: ``reexported-modules`` with ``cabal-version`` < 1.22. +- CVMixins: ``mixins`` with ``cabal-version`` < 2.0. +- CVExtraFrameworkDirs: ``extra-framework-dirs`` with ``cabal-version`` < 1.24. +- CVDefaultExtensions: ``default-extensions`` with ``cabal-version`` < 1.10. +- CVExtensionsDeprecated: deprecated ``extensions`` field used with ``cabal-version`` ≥ 1.10 +- CVSources: ``asm-sources``, ``cmm-sources``, ``extra-bundled-libraries`` or ``extra-library-flavours`` used with ``cabal-version`` < 3.0. +- CVExtraDynamic: ``extra-dynamic-library-flavours`` used with cabal-version < 3.0. +- CVVirtualModules: ``virtual-modules`` used with cabal-version < 2.2. +- CVSourceRepository: ``source-repository`` used with ``cabal-version`` 1.6. +- CVExtensions: incompatible language extension with ``cabal-version``. +- CVCustomSetup: missing ``setup-depends`` field in ``custom-setup`` with ``cabal-version`` ≥ 1.24. +- CVExpliticDepsCustomSetup: missing dependencies in ``custom-setup`` with ``cabal-version`` ≥ 1.24. +- CVAutogenPaths: missing autogen ``Paths_*`` modules in ``autogen-modules`` (``cabal-version`` ≥ 2.0). +- CVAutogenPackageInfo: missing autogen ``PackageInfo_*`` modules in ``autogen-modules`` *and* ``exposed-modules``/``other-modules`` (``cabal-version`` ≥ 2.0). +- GlobNoMatch: glob pattern not matching any file. +- GlobExactMatch: glob pattern not matching any file becuase of lack of extension matching (`cabal-version` < 2.4). +- GlobNoDir: glob pattern trying to match a missing directory. +- UnknownOS: unknown operating system name in condition. +- UnknownArch: unknown architecture in condition. +- UnknownCompiler: unknown compiler in condition. +- BaseNoUpperBounds: missing upper bounds for important dependencies (``base``, and for ``custom-setup`` ``Cabal`` too). +- MissingUpperBounds: missing upper bound in dependency (excluding test-suites and benchmarks). +- SuspiciousFlagName: troublesome flag name (e.g. starting with a dash). +- DeclaredUsedFlags: unused user flags. +- NonASCIICustomField: non-ASCII characters in custom field. +- RebindableClashPaths: ``Rebindable Syntax`` with ``OverloadedStrings``/``OverloadedStrings`` plus autogenerated ``Paths_*`` modules with ``cabal-version`` < 2.2. +- RebindableClashPackageInfo: ``Rebindable Syntax`` with ``OverloadedStrings``/``OverloadedStrings`` plus autogenerated ``PackageInfo_*`` modules with ``cabal-version`` < 2.2. +- WErrorUnneeded: ``-WError`` not under a user flag. +- JUnneeded: suspicious ``-j[n]`` usage. +- FDeferTypeErrorsUnneeded: suspicious ``-fdefer-type-errors``. +- DynamicUnneeded: suspicious ``-d*`` debug flag for distributed package. +- ProfilingUnneeded: suspicious ``-fprof-*`` flag. +- UpperBoundSetup: missing upper bounds in ``setup-depends``. +- DuplicateModule: duplicate modules in target. +- PotentialDupModule: potential duplicate module in target (subject to conditionals). +- BOMStart: unicode byte order mark (BOM) character at start of file. +- NotPackageName: filename not matching ``name``. +- NoDesc: no ``.cabal`` file found in folder. +- MultiDesc: multiple ``.cabal`` files found in folder. +- UnknownFile: path refers to a file which does not exist. +- MissingSetupFile: missing ``Setup.hs`` or ``Setup.lsh``. +- MissingConfigureScript: missing ``configure`` script with ``build-type: Configure``. +- UnknownDirectory: paths refer to a directory which does not exist. +- MissingSourceControl: missing ``source-repository`` section. +- MissingExpectedDocFiles: missing expected documentation files (changelog). +- WrongFieldForExpectedDocFiles: documentation files listed in ``extra-source-files`` instead of ``extra-doc-files``. + cabal sdist ^^^^^^^^^^^