From 1d2765a2347c908a7886ac498577d7102f4d8546 Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Thu, 22 Sep 2022 18:48:31 +0200 Subject: [PATCH 01/18] Fix Semigroup target instance When two target names are the same, `mappend`ing them should not error but just pick the first name. --- .../src/Distribution/Types/Benchmark.hs | 14 +------------ .../src/Distribution/Types/Executable.hs | 14 +------------ .../src/Distribution/Types/ForeignLib.hs | 14 +------------ .../src/Distribution/Types/TestSuite.hs | 14 +------------ .../Distribution/Types/UnqualComponentName.hs | 21 ++++++++++++++++++- 5 files changed, 24 insertions(+), 53 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Types/Benchmark.hs b/Cabal-syntax/src/Distribution/Types/Benchmark.hs index be0911432ec..e3a1b7e1bfc 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 = combineName 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..235905fc6ef 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 = combineName 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..b9918a16b77 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 = combineName 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..88e90aeeb78 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 = combineName 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..e33477e7adc 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 + , combineName ) 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,21 @@ packageNameToUnqualComponentName = UnqualComponentName . unPackageNameST -- @since 2.0.0.2 unqualComponentNameToPackageName :: UnqualComponentName -> PackageName unqualComponentNameToPackageName = mkPackageNameST . unUnqualComponentNameST + +-- | Combine names in targets (partial function). Useful in 'Semigroup' +-- and similar instances. +combineName :: a -> a -> (a -> UnqualComponentName) -> String -> + UnqualComponentName +combineName 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 + From 152bed8d63741b8dd5d853816024c3031f4c80bf Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Fri, 2 Sep 2022 11:04:49 +0200 Subject: [PATCH 02/18] Add `desugarBuildToolSimple` --- .../Distribution/Simple/BuildToolDepends.hs | 45 ++++++++++--------- 1 file changed, 24 insertions(+), 21 deletions(-) diff --git a/Cabal/src/Distribution/Simple/BuildToolDepends.hs b/Cabal/src/Distribution/Simple/BuildToolDepends.hs index 486cd2049d9..4c642f49e89 100644 --- a/Cabal/src/Distribution/Simple/BuildToolDepends.hs +++ b/Cabal/src/Distribution/Simple/BuildToolDepends.hs @@ -13,6 +13,26 @@ import qualified Data.Map as Map import Distribution.Package import Distribution.PackageDescription +-- | 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 led = + if foundLocal + then Just $ ExeDependency pname toolName reqVer + else Map.lookup name whiteMap + where + LegacyExeDependency name reqVer = led + toolName = mkUnqualComponentName name + foundLocal = toolName `elem` exeNames + 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) + -- | Desugar a "build-tools" entry into proper a executable dependency if -- possible. -- @@ -30,27 +50,10 @@ desugarBuildTool :: PackageDescription -> 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) +desugarBuildTool pkg led = 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. From eef2be1dcdfbdf18fb1e899bccd57d3bcb7794c0 Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Fri, 2 Sep 2022 09:54:23 +0200 Subject: [PATCH 03/18] Reimplement cabal check --- Cabal-tests/tests/CheckTests.hs | 2 +- Cabal-tests/tests/HackageTests.hs | 2 +- .../regressions/all-upper-bound.check | 2 +- .../regressions/decreasing-indentation.cabal | 10 +- Cabal/Cabal.cabal | 1 + .../Distribution/PackageDescription/Check.hs | 4481 +++++++---------- .../PackageDescription/Check/Prim.hs | 1175 +++++ Cabal/src/Distribution/Simple/Configure.hs | 2 +- .../src/Distribution/Client/Check.hs | 2 +- .../Distribution/Solver/Modular/DSL.hs | 2 +- .../Paths/RecursiveGlobInRoot/cabal.out | 2 +- .../Sanity/NoDupNames/cabal.out | 3 + 12 files changed, 2885 insertions(+), 2799 deletions(-) create mode 100644 Cabal/src/Distribution/PackageDescription/Check/Prim.hs 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..336dfd3942f 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: + - somelib - alphalib - betalib - deltalib - - somelib Please add them, using `cabal gen-bounds` for suggestions. For more information see: https://pvp.haskell.org/ 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/Cabal.cabal b/Cabal/Cabal.cabal index da7eeda354c..afc2c6764a3 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -84,6 +84,7 @@ library Distribution.Compat.Time Distribution.Make Distribution.PackageDescription.Check + Distribution.PackageDescription.Check.Prim Distribution.ReadE Distribution.Simple Distribution.Simple.Bench diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index 2c9806a1ae5..00b5d94a82f 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -1,10 +1,10 @@ -{-# 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 @@ -36,14 +36,12 @@ module Distribution.PackageDescription.Check , checkPackageFiles , 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 @@ -51,16 +49,14 @@ 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.Prim +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 @@ -68,9 +64,7 @@ import Distribution.Verbosity import Distribution.Version import Language.Haskell.Extension import System.FilePath - ( makeRelative - , normalise - , splitDirectories + ( splitDirectories , splitExtension , splitPath , takeExtension @@ -79,10 +73,8 @@ import System.FilePath , () ) -import qualified Control.Monad as CM 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 @@ -94,945 +86,48 @@ 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 ((&&&)) --- ------------------------------------------------------------ +-- ☞ N.B. +-- +-- Part of the tools/scaffold used to perform check is found in +-- Distribution.PackageDescription.Check.Prim. Summary of that module (for +-- how we use it here): +-- 1. we work inside a 'Check 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. --- * 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. --- --- 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 - +-- * Checking interface -- ------------------------------------------------------------ --- * Standard checks - --- ------------------------------------------------------------ +-- | '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. -- @@ -1040,1604 +135,1358 @@ checkSpecVersion pkg specver cond pc -- for checks that require looking at files within the package. For those -- see 'checkPackageFiles'. -- --- 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 - where - pkg = fromMaybe (flattenPackageDescription gpkg) mpkg +checkPackage :: GenericPackageDescription -> [PackageCheck] +checkPackage gpd = runIdentity $ checkPackagePrim True Nothing Nothing gpd --- TODO: make this variant go away --- we should always know the GenericPackageDescription +-- | 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 pkg = - checkSanity pkg - ++ checkFields pkg - ++ checkLicense pkg - ++ checkSourceRepos pkg - ++ checkAllGhcOptions pkg - ++ checkCCOptions pkg - ++ checkCxxOptions pkg - ++ checkCPPOptions pkg - ++ checkPaths pkg - ++ checkCabalVersion pkg +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. +-- +-- 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. +-- +checkPackageFiles :: Verbosity -> -- Glob warn message verbosity. + PackageDescription -> + FilePath -> -- Package root. + IO [PackageCheck] +checkPackageFiles verbosity gpd root = + checkPackagePrim False (Just checkFilesIO) (Just checkPreIO) + (pd2gpd gpd) + where + checkFilesIO = CheckPackageContentOps { + doesFileExist = System.doesFileExist . relative, + doesDirectoryExist = System.doesDirectoryExist . relative, + getDirectoryContents = System.Directory.getDirectoryContents . relative, + getFileContents = BS.readFile . relative + } + + checkPreIO = CheckPreDistributionOps { + runDirFileGlobM = \fp g -> runDirFileGlob verbosity (root fp) g, + getDirectoryContentsM = System.Directory.getDirectoryContents . relative + } + + relative path = root path --- * Basic sanity checks +-- ------------------------------------------------------------ +-- * 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) + -- ... 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 + case condLibrary_ of + Just cl -> checkCondTarget + genPackageFlags_ + (checkLibrary False) + (const id) (mempty, cl) + Nothing -> return () + mapM_ (checkCondTarget genPackageFlags_ + (checkLibrary False) + (\u l -> l {libName = maybeToLibraryName (Just u)})) + condSubLibraries_ + mapM_ (checkCondTarget genPackageFlags_ + checkForeignLib + (const id)) + condForeignLibs_ + mapM_ (checkCondTarget genPackageFlags_ + (checkExecutable (package packageDescription_)) + (const id)) + condExecutables_ + mapM_ (checkCondTarget genPackageFlags_ + checkTestSuite + (\u l -> l {testName = u})) + condTestSuites_ + mapM_ (checkCondTarget genPackageFlags_ + checkBenchmark + (\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 ] - ) - $ 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 (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) - ) - $ PackageBuildImpossible NoHsLhsMain - , checkSpecVersion - pkg - CabalSpecV1_18 - ( fileExtensionSupportedLanguage (modulePath exe) - && takeExtension (modulePath exe) `notElem` [".hs", ".lhs"] - ) - $ 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 --- ------------------------------------------------------------ +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))) + +checkSetupBuildInfo :: Monad m => Maybe SetupBuildInfo -> CheckM m () +checkSetupBuildInfo Nothing = return () +checkSetupBuildInfo (Just (SetupBuildInfo ds _)) = do + (is, rs) <- partitionDeps ["base", "Cabal"] ds + let ick = PackageDistInexcusable . UpperBoundSetup + rck = PackageDistSuspiciousWarn . MissingUpperBounds + mapM_ (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] + + unknownLicenseVersion (GPL (Just v)) + | v `notElem` knownVersions = Just knownVersions + where knownVersions = [ v' | GPL (Just v') <- knownLicenses ] + unknownLicenseVersion (LGPL (Just v)) + | v `notElem` knownVersions = Just knownVersions + where knownVersions = [ v' | LGPL (Just v') <- knownLicenses ] + unknownLicenseVersion (AGPL (Just v)) + | v `notElem` knownVersions = Just knownVersions + where knownVersions = [ v' | AGPL (Just v') <- knownLicenses ] + unknownLicenseVersion (Apache (Just v)) + | v `notElem` knownVersions = Just knownVersions + where knownVersions = [ v' | Apache (Just v') <- knownLicenses ] + unknownLicenseVersion _ = Nothing + +checkSourceRepos :: Monad m => [SourceRepo] -> CheckM m () +checkSourceRepos rs = do + mapM_ repoCheck rs + checkMissingVcsInfo rs + where + -- 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)) + (PackageDistSuspicious MissingSourceControl) + where + 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"] --- * Additional pure checks +-- ------------------------------------------------------------ +-- * Conditional trees -- ------------------------------------------------------------ -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) - ) - $ 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 - ] - 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 - ] - - depMissingInternalExecutable = - [ dep - | dep@(ExeDependency _ eName _) <- internalExeDeps - , not $ eName `elem` internalExecutables - ] - -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 - knownVersions = [v' | GPL (Just v') <- knownLicenses] - unknownLicenseVersion (LGPL (Just v)) - | v `notElem` knownVersions = Just knownVersions - where - knownVersions = [v' | LGPL (Just v') <- knownLicenses] - unknownLicenseVersion (AGPL (Just v)) - | v `notElem` knownVersions = Just knownVersions - where - knownVersions = [v' | AGPL (Just v') <- knownLicenses] - unknownLicenseVersion (Apache (Just v)) - | v `notElem` knownVersions = Just knownVersions - where - 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) - where - (badFlags, _) = unzip flags +-- 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.). -data PathKind - = PathKindFile - | PathKindDirectory - | PathKindGlob - deriving (Eq) +-- | @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 -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) - ) - $ PackageDistInexcusable CVAutogenPackageInfo - ] - 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) +-- | 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) + -- Using simplifyCondition is convenient and correct, + -- if checks become more complex we can always walk + -- 'Condition'. + in 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 () -- ------------------------------------------------------------ - --- * Checks on the GenericPackageDescription - +-- * Targets -- ------------------------------------------------------------ --- | 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) - ] +checkLibrary :: Monad m => + Bool -> -- Is this a sublibrary? + Library -> + CheckM m () +checkLibrary isSub 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 BITLib (explicitLibModules lib) 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 BITLib [] foreignLibBuildInfo_ + +checkExecutable :: Monad m => PackageId -> Executable -> CheckM m () +checkExecutable pid exe@(Executable + exeName_ modulePath_ _exeScope_ buildInfo_) = do + -- § Exe specific checks + checkP (null modulePath_) + (PackageBuildImpossible (NoMainIs exeName_)) + -- This check does not apply to scripts. + 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 CETExecutable exeName_) + checkP (not $ all (flip elem (view L.includes exe)) + (view L.autogenIncludes exe)) + (PackageBuildImpossible AutogenIncludesNotIncludedExe) + + -- § Build info checks. + checkBuildInfo BITOther [] buildInfo_ + +checkTestSuite :: Monad m => TestSuite -> CheckM m () +checkTestSuite ts@(TestSuite + testName_ testInterface_ testBuildInfo_ + _testCodeGenerators_) = do + -- § 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 CETTest $ testName_)) + 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 BITTestBench [] testBuildInfo_ 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 - ] - -- 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 + mainIsWrongExt = + case testInterface_ of + TestSuiteExeV10 _ f -> not (fileExtensionSupportedLanguage f) _ -> 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 - ] --- ------------------------------------------------------------ + mainIsNotHsExt = + case testInterface_ of + TestSuiteExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"] + _ -> False --- * Checks involving files in the package +checkBenchmark :: Monad m => Benchmark -> CheckM m () +checkBenchmark bm@(Benchmark + benchmarkName_ benchmarkInterface_ + benchmarkBuildInfo_) = do + -- § 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 CETBenchmark benchmarkName_) + + checkP (not $ all (flip elem (view L.includes bm)) + (view L.autogenIncludes bm)) + (PackageBuildImpossible AutogenIncludesNotIncludedExe) + + -- § BuildInfo checks. + checkBuildInfo BITTestBench [] benchmarkBuildInfo_ + where + -- Cannot abstract with similar function in checkTestSuite, + -- they are different. + mainIsWrongExt = + case benchmarkInterface_ of + BenchmarkExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"] + _ -> False --- ------------------------------------------------------------ - --- | 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) - where - checkFilesIO = - CheckPackageContentOps - { doesFileExist = System.doesFileExist . relative - , doesDirectoryExist = System.doesDirectoryExist . relative - , getDirectoryContents = System.Directory.getDirectoryContents . relative - , getFileContents = BS.readFile . relative - } - relative path = root path --- | 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 - } +-- ------------------------------------------------------------ +-- * Build info +-- ------------------------------------------------------------ --- | 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. +-- Target type (library, test/bech, other). +data BITarget = BITLib | BITTestBench | BITOther + deriving (Eq, Show) + +-- 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 => + BITarget -> -- Target type. + [ModuleName] -> -- Additional module names which cannot be + -- extracted from BuildInfo (mainly: exposed + -- library modules). + BuildInfo -> + CheckM m () +checkBuildInfo t ams 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 t 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 ["base"] + (mergeDependencies $ targetBuildDepends bi) + let ick = const (PackageDistInexcusable BaseNoUpperBounds) + rck = PackageDistSuspiciousWarn . MissingUpperBounds + mapM_ (checkPVP ick) ids + 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") + (map 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_ checkDep (targetBuildDepends bi) --xxx checdep no va qui + 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) + + checkDep :: Monad m => Dependency -> CheckM m () + checkDep 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 (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 && -- internal + name `notElem`exns) -- 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) + (map 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 -- + +-- Convenience function to partition important dependencies by name. To +-- be used together with checkPVP. +partitionDeps :: Monad m => + [String] -> -- | List of package names ("base", "Cabal"…) + [Dependency] -> + CheckM m ([Dependency], [Dependency]) +partitionDeps ns ds = do + pId <- asksCM (pnPackageId . ccNames) + let idName = unPackageName . pkgName $ pId + -- Do not return dependencies which are package + -- main library. + ds' = filter ((/= idName) . depName) ds + + -- February 2022: this is a tricky part of the function. If the + -- two lists are different in length (hence, we did find a dep- + -- endency to the package itself), move all dependencies in the + -- non-critical bucket. + -- With this pragmatic choice we kill two birds with one stone: + -- - we still ouptut a warning for naked `base` dependencies in + -- the target (usually a test, an example exe, etc); + -- - but we don’t make Hackage refuse the package, which mimics + -- ante-refactoring behaviour (a soup of all dependencies in + -- the whole package merged together). + -- Once the community is positive about upper bounds best-prac- + -- tices this can be removed. + if ds /= ds' + then return ([], ds') + else return (partition (flip elem ns . depName) ds') + where + depName d = unPackageName . depPkgName $ d + +-- Sometimes we read (or end up with) “straddle” deps declarations +-- like this: -- --- 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 - :: 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" +-- 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 dName = unPackageName . depPkgName $ d + (sames, diffs) = partition ((== dName) . depName) l + merged = Dependency (depPkgName d) + (foldl intersectVersionRanges anyVersion $ + map depVerRange sames) + (depLibraries d) + in merged : mergeDependencies diffs + where + depName wd = unPackageName . depPkgName $ wd + +-- PVP dependency check (single dependency). +checkPVP :: Monad m => + (String -> PackageCheck) -> -- Warn message dependend on name + -- (e.g. "base", "Cabal"). + Dependency -> + CheckM m () +checkPVP ckf (Dependency pname ver _) = do + checkP ((not . hasUpperBound) ver) + (ckf . unPackageName $ pname) + +-- 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] -> + CheckM m () +checkPVPs cf ds = do + let ds' = filter withoutUpper ds + nds = map (unPackageName . depPkgName) ds' + unless (null nds) + (tellP $ cf nds) + where + withoutUpper :: Dependency -> Bool + withoutUpper (Dependency _ ver _) = not . hasUpperBound $ ver --- | 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"] +-- ------------------------------------------------------------ +-- * Options -- ------------------------------------------------------------ --- * Checks involving files in the package +-- 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 ["-fvia-C"] + (PackageDistSuspicious $ OptViaC title) + checkFlags ["-fhpc"] + (PackageDistInexcusable $ OptHpc title) + checkFlags ["-prof"] + (PackageBuildWarning $ OptProf title) + 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 -- ------------------------------------------------------------ +-- * Paths and fields +-- ------------------------------------------------------------ --- | 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) +-- Type of path. +data PathKind + = PathKindFile + | PathKindDirectory + | PathKindGlob + deriving (Eq) + +-- 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 + -- 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 + 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. -- @@ -2646,260 +1495,316 @@ checkWindowsPaths paths = -- 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 :: Monad m => FilePath -> CheckM m () checkTarPath path - | length path > 255 = Just longPath + | length path > 255 = tellP 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 + 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 + 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 _ [] = 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) + pack' maxLen n (c:cs) | n' <= maxLen = pack' maxLen n' cs - where - n' = n + length c - pack' _ _ cs = cs + where n' = n + length c + pack' _ _ cs = cs longPath = PackageDistInexcusable (FilePathTooLong path) longName = PackageDistInexcusable (FilePathNameTooLong path) noSplit = PackageDistInexcusable (FilePathSplitTooLong path) emptyName = PackageDistInexcusable FilePathEmpty --- -------------------------------------------------------------- +checkCustomField :: Monad m => (String, String) -> CheckM m () +checkCustomField (n, _) = + checkP (any (not . isAscii) n) + (PackageDistInexcusable $ NonASCIICustomField [n]) + +-- `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) + +-- 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 + + return (mcs ++ pcs)) + where + -- From Distribution.Simple.Glob. + globMatches :: [GlobResult a] -> [a] + globMatches input = [a | GlobMatch a <- input] + + 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] + +-- Predicate for desirable documentation file on Hackage server. +isDesirableExtraDocFile :: FilePath -> Bool +isDesirableExtraDocFile path = basename `elem` desirableChangeLog && + ext `elem` desirableChangeLogExtensions + where + (basename, ext) = splitExtension (map toLower path) --- * Checks for missing content and other pre-distribution checks + -- 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"] --- -------------------------------------------------------------- --- | 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. +-- ------------------------------------------------------------ +-- * Package and distribution checks +-- ------------------------------------------------------------ + +-- | 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" ] + 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]) + -- Multiple .cabal files. + where + 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 + + bomUtf8 :: BS.ByteString + bomUtf8 = BS.pack [0xef,0xbb,0xbf] -- U+FEFF encoded as UTF8 + + 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 => 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) + +-- 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 - --- | 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') - ] - 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) +-- But, because Hackage doesn't yet run these tests, that will be a lie! + +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 mathching (<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 + 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. + 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 (GlobWarnMultiDot file) = + Just $ PackageDistSuspiciousWarn (GlobExactMatch title fp file) + getWarning (GlobMissingDirectory dir) = + Just $ PackageDistSuspiciousWarn (GlobNoDir title fp dir) - -- 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) - - -- 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 - -- 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) +-- ------------------------------------------------------------ +-- * Other exports and non-traverse checks +-- ------------------------------------------------------------ + +-- | 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) + +-- 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) @@ -2912,6 +1817,7 @@ checkDuplicateModules pkg = 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') @@ -2938,35 +1844,19 @@ checkDuplicateModules pkg = ] else [] + -- ------------------------------------------------------------ -- * Utils -- ------------------------------------------------------------ -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 ", " +-- | .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 +-- Remove duplicates from list. dups :: Ord a => [a] -> [a] dups xs = [x | (x : _ : _) <- group (sort xs)] @@ -3203,32 +2093,49 @@ isGoodRelativeDirectoryPath = state0 -- | otherwise -> 4 -- @ --- --- 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." +-- | 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) } + + -- 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 } + diff --git a/Cabal/src/Distribution/PackageDescription/Check/Prim.hs b/Cabal/src/Distribution/PackageDescription/Check/Prim.hs new file mode 100644 index 00000000000..2f9c3a1a243 --- /dev/null +++ b/Cabal/src/Distribution/PackageDescription/Check/Prim.hs @@ -0,0 +1,1175 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} + +----------------------------------------------------------------------------- +-- | +-- 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.Prim + ( -- * 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.CabalSpecVersion (CabalSpecVersion, showCabalSpecVersion) +import Distribution.License (License, knownLicenses) +import Distribution.ModuleName (ModuleName) +import Distribution.Package (packageName) +import Distribution.Parsec.Warning (PWarning, showPWarning) +import Distribution.Pretty (prettyShow) +import Distribution.Simple.BuildToolDepends (desugarBuildToolSimple) +import Distribution.Simple.Glob (Glob, GlobResult) +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.GenericPackageDescription +import Distribution.Types.LegacyExeDependency (LegacyExeDependency) +import Distribution.Types.PackageId (PackageIdentifier) +import Distribution.Types.PackageDescription (package, specVersion) +import Distribution.Types.PackageName (PackageName) +import Distribution.Types.LibraryName (LibraryName, showLibraryName) +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 Control.Monad.Reader as Reader +import qualified Control.Monad.Writer as Writer +import qualified Control.Monad.Trans.Class as Trans +import qualified Data.ByteString.Lazy as BS +import qualified Data.List as List +import qualified Data.Set as Set + +import Control.Monad + +-- ------------------------------------------------------------ +-- * Check 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) + + +-- ------------------------------------------------------------ +-- * 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. +-- +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 UnqualComponentName + | 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 + | 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 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 [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 | 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" + +-- | 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' or 'other-modules'." +ppExplanation AutogenIncludesNotIncluded = + "An include in 'autogen-includes' is neither in 'includes' or " + ++ "'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 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 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 (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 " ++ + 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 names) = + let separator = "\n - " + in + "These packages miss upper bounds:" ++ separator + ++ (List.intercalate separator names) ++ "\n" + ++ "Please add them, using `cabal gen-bounds` for suggestions." + ++ " For more information see: " + ++ " https://pvp.haskell.org/" +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: " + ++ 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/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..076bc59ee6e 100644 --- a/cabal-install/src/Distribution/Client/Check.hs +++ b/cabal-install/src/Distribution/Client/Check.hs @@ -81,7 +81,7 @@ check verbosity = do -- 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' + 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/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/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. From b24c6013a25037192d42777e053f0cc80e12e130 Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Fri, 2 Sep 2022 09:52:27 +0200 Subject: [PATCH 04/18] Reorder test output --- .../ParserTests/regressions/bad-glob-syntax.check | 2 +- .../regressions/denormalised-paths.check | 15 +++++++++------ .../tests/ParserTests/regressions/issue-774.check | 4 ++-- .../regressions/pre-2.4-globstar.check | 2 +- 4 files changed, 13 insertions(+), 10 deletions(-) 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/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/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/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. From 1a2f18425475e6c2ddb20bfb9a028c88b395eb4d Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Fri, 2 Sep 2022 10:00:01 +0200 Subject: [PATCH 05/18] Fix autogen modules tests .cabal files --- .../PackageTests/AutogenModules/Package/my.cabal | 8 ++++---- .../AutogenModules/SrcDist/AutogenModules.cabal | 8 ++++---- 2 files changed, 8 insertions(+), 8 deletions(-) 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 From 083a642c517a546a165b3c99d3b33799cf70e328 Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Fri, 2 Sep 2022 09:46:10 +0200 Subject: [PATCH 06/18] Add a number of tests MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Add test for #7423 i.e. Do not warn on -O2 if under off-by-default package configuration flag conditional. * Add a regression for: * Add another -WErrr test This is to make sure we do *not* report it if it is under a user, off-by-default flag. * Add test for non manual user flags. * Add “absolute path in extra-lib-dirs” test * Add if/else test * Add “dircheck on abspath” check * Add Package version internal test * Add PackageVersionsStraddle test --- .../GHCOptions/NoWarnFlag/cabal.out | 2 ++ .../GHCOptions/NoWarnFlag/cabal.test.hs | 4 +++ .../GHCOptions/NoWarnFlag/pkg.cabal | 18 +++++++++++++ .../GHCOptions/NoWarnFlagManual/cabal.out | 4 +++ .../GHCOptions/NoWarnFlagManual/cabal.test.hs | 5 ++++ .../GHCOptions/NoWarnFlagManual/pkg.cabal | 17 +++++++++++++ .../GHCOptions/NoWarnFlagOut/cabal.out | 4 +++ .../GHCOptions/NoWarnFlagOut/cabal.test.hs | 4 +++ .../GHCOptions/NoWarnFlagOut/pkg.cabal | 19 ++++++++++++++ .../Paths/AbsolutePathExtraLibDirs/cabal.out | 2 ++ .../AbsolutePathExtraLibDirs/cabal.test.hs | 5 ++++ .../Paths/AbsolutePathExtraLibDirs/pkg.cabal | 13 ++++++++++ .../DevOnlyFlags/ElseCheck/LICENSE | 0 .../DevOnlyFlags/ElseCheck/cabal.out | 8 ++++++ .../DevOnlyFlags/ElseCheck/cabal.test.hs | 5 ++++ .../DevOnlyFlags/ElseCheck/pkg.cabal | 25 +++++++++++++++++++ .../DevOnlyFlags/WErrorGuarded/cabal.out | 2 ++ .../DevOnlyFlags/WErrorGuarded/cabal.test.hs | 5 ++++ .../DevOnlyFlags/WErrorGuarded/pkg.cabal | 20 +++++++++++++++ .../PackageVersionsInternal/cabal.out | 6 +++++ .../PackageVersionsInternal/cabal.test.hs | 5 ++++ .../PackageVersionsInternal/pkg.cabal | 19 ++++++++++++++ .../PackageVersionsStraddle/cabal.out | 2 ++ .../PackageVersionsStraddle/cabal.test.hs | 6 +++++ .../PackageVersionsStraddle/pkg.cabal | 15 +++++++++++ .../Check/PackageFiles/DirExistAbs/LICENSE | 0 .../Check/PackageFiles/DirExistAbs/cabal.out | 2 ++ .../PackageFiles/DirExistAbs/cabal.test.hs | 5 ++++ .../Check/PackageFiles/DirExistAbs/pkg.cabal | 17 +++++++++++++ 29 files changed, 239 insertions(+) create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlag/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/AbsolutePathExtraLibDirs/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/LICENSE create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/WErrorGuarded/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/LICENSE create mode 100644 cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/PackageFiles/DirExistAbs/pkg.cabal 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..b26b8576047 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.out @@ -0,0 +1,4 @@ +# cabal check +Warning: 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..b26b8576047 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.out @@ -0,0 +1,4 @@ +# cabal check +Warning: 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/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..6ab7142b37c --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.out @@ -0,0 +1,8 @@ +# cabal check +Warning: The following errors will cause portability problems on other +environments: +Warning: '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. +Warning: 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/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..4502a2f87b5 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.out @@ -0,0 +1,6 @@ +# cabal check +Warning: These warnings may cause trouble when distributing the package: +Warning: These packages miss upper bounds: +- base +Please add them, using `cabal gen-bounds` for suggestions. For more +information see: https://pvp.haskell.org/ 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..82d60c548a1 --- /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: warn but do not 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/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 + From 7566f7d7b1377bf71a7171868e65f64f8add5df8 Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Fri, 17 Feb 2023 07:53:07 +0100 Subject: [PATCH 07/18] Add changelog for #8427 --- changelog.d/pr-8427 | 15 +++++++++++++++ 1 file changed, 15 insertions(+) create mode 100644 changelog.d/pr-8427 diff --git a/changelog.d/pr-8427 b/changelog.d/pr-8427 new file mode 100644 index 00000000000..af5bf0e6c1e --- /dev/null +++ b/changelog.d/pr-8427 @@ -0,0 +1,15 @@ +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. +} From 09a4d82d7747e8f65246e266d14ab6d586a55941 Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Sun, 26 Feb 2023 01:51:27 +0100 Subject: [PATCH 08/18] Integrate various reviews MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Integrate Artem’s review (review) Clarify `combineNames` documentation By explaining the way it operates (working if the two names are equal or one is empty) and renaming the function from `combineName` to `combineNames`. (review) Use guards instead of if/then/else (review) Match inside argument list (review) Replace “white” with “allow” (review) Fix typo in comment (review) Fix typo in Check module documentation (review) Harmonise indentation for `data` decls First field goes in a new line than the data constructor, so we have more space. (review) Rename `Prim` module to `Types` (review) Add checkPackageFilesGPD `checkPackageFiles` — which works on PD — was used to perform IO. We introduce a function that does the same thing but works on GPD (which is more principled). `checkPackageFiles` cannot just be removed, since it is part of the interface of Distribution.PackageDescription.Check. Deprecation can be planned once “new check” is up and running. * Integrate Andreas’ review (review) Add named section to missing upper bound check “miss upper bound” checks will now list target type and name (“On executable 'myexe', these packages miss upper bounds”) for easier fixing by the user. (review) remove `cabal gen-bounds` suggestion Reasonable as `cabal gen-bounds` is stricter than `cabal check`, see https://github.com/haskell/cabal/pull/8427#issuecomment-1446712486 Once `gen-bounds` behaves in line with `check` we can readd the suggestion. (review) Do not warn on shared bounds When a target which depends on an internal library shares some dependencies with the latter, do not warn on upper bounds. An example is clearer library build-depends: text < 5 ⁝ build-depends: myPackage, ← no warning, internal text, ← no warning, shared bound monadacme ← warning! * Integrate Artem’s review /II (review) Split Check.hs Check.hs has been split in multiple file, each une sub 1000 lines: Check 857 lines Check.Common 147 lines Check.Conditional 204 lines Check.Monad 352 lines Check.Paths 387 lines Check.Target 765 lines Check.Warning 865 lines Migration guide: - Check GPD/PD checks plus work-tree checks. - Check.Common common types and functions that are *not* part of monadic checking setup. - Check.Conditional checks on CondTree and related matter (variables, duplicate modules). - Check.Monad Backbone of the checks, monadic inter- face and related functions. - Check.Paths Checks on files, directories, globs. - Check.Target Checks on realised targets (libraries, executables, benchmarks, testsuites). - Check.Warning Datatypes and strings for warnings and severities. (review) remove useless section header (review) Fix typo (review) Add warnings documentation (list) For each warning, we document constructor/brief description in the manual. This might not be much useful as not but it will come handy when introducing `--ignore=WARN` and similar flags. * (review Andreas) Clarify CheckExplanation comment Whoever modifies `CheckExplanation` data constructors needs to be aware that the documentation in doc/cabal-commands.rst has to be updated too. --- .../src/Distribution/Types/Benchmark.hs | 2 +- .../src/Distribution/Types/Executable.hs | 2 +- .../src/Distribution/Types/ForeignLib.hs | 2 +- .../src/Distribution/Types/TestSuite.hs | 2 +- .../Distribution/Types/UnqualComponentName.hs | 11 +- .../regressions/all-upper-bound.check | 4 +- Cabal/Cabal.cabal | 7 +- .../Distribution/PackageDescription/Check.hs | 1596 ++--------------- .../PackageDescription/Check/Common.hs | 145 ++ .../PackageDescription/Check/Conditional.hs | 204 +++ .../PackageDescription/Check/Monad.hs | 350 ++++ .../PackageDescription/Check/Paths.hs | 387 ++++ .../PackageDescription/Check/Target.hs | 765 ++++++++ .../Check/{Prim.hs => Warning.hs} | 378 +--- .../Distribution/Simple/BuildToolDepends.hs | 14 +- .../src/Distribution/Client/Check.hs | 17 +- .../ImpossibleVersionRangeLib/cabal.out | 2 +- .../ImpossibleVersionRangeLib/pkg.cabal | 2 +- .../GHCOptions/NoWarnFlagManual/cabal.out | 2 +- .../GHCOptions/NoWarnFlagOut/cabal.out | 2 +- .../DevOnlyFlags/ElseCheck/cabal.out | 10 +- .../PackageVersionsInternal/cabal.out | 6 +- .../PackageVersionsInternal/cabal.test.hs | 2 +- .../PackageVersionsInternalSimple/cabal.out | 5 + .../cabal.test.hs | 5 + .../PackageVersionsInternalSimple/pkg.cabal | 22 + .../PackageVersionsLibInt/cabal.out | 5 + .../PackageVersionsLibInt/cabal.test.hs | 5 + .../PackageVersionsLibInt/pkg.cabal | 20 + changelog.d/pr-8427 | 4 + doc/cabal-commands.rst | 136 ++ 31 files changed, 2283 insertions(+), 1831 deletions(-) create mode 100644 Cabal/src/Distribution/PackageDescription/Check/Common.hs create mode 100644 Cabal/src/Distribution/PackageDescription/Check/Conditional.hs create mode 100644 Cabal/src/Distribution/PackageDescription/Check/Monad.hs create mode 100644 Cabal/src/Distribution/PackageDescription/Check/Paths.hs create mode 100644 Cabal/src/Distribution/PackageDescription/Check/Target.hs rename Cabal/src/Distribution/PackageDescription/Check/{Prim.hs => Warning.hs} (73%) create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.out create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/pkg.cabal diff --git a/Cabal-syntax/src/Distribution/Types/Benchmark.hs b/Cabal-syntax/src/Distribution/Types/Benchmark.hs index e3a1b7e1bfc..13e5fe104e5 100644 --- a/Cabal-syntax/src/Distribution/Types/Benchmark.hs +++ b/Cabal-syntax/src/Distribution/Types/Benchmark.hs @@ -48,7 +48,7 @@ instance Monoid Benchmark where instance Semigroup Benchmark where a <> b = Benchmark - { benchmarkName = combineName a b benchmarkName "benchmark" + { benchmarkName = combineNames a b benchmarkName "benchmark" , benchmarkInterface = combine benchmarkInterface , benchmarkBuildInfo = combine benchmarkBuildInfo } diff --git a/Cabal-syntax/src/Distribution/Types/Executable.hs b/Cabal-syntax/src/Distribution/Types/Executable.hs index 235905fc6ef..5362d7122b0 100644 --- a/Cabal-syntax/src/Distribution/Types/Executable.hs +++ b/Cabal-syntax/src/Distribution/Types/Executable.hs @@ -40,7 +40,7 @@ instance Monoid Executable where instance Semigroup Executable where a <> b = Executable - { exeName = combineName a b exeName "executable" + { exeName = combineNames a b exeName "executable" , modulePath = combine modulePath , exeScope = combine exeScope , buildInfo = combine buildInfo diff --git a/Cabal-syntax/src/Distribution/Types/ForeignLib.hs b/Cabal-syntax/src/Distribution/Types/ForeignLib.hs index b9918a16b77..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 = combineName a b foreignLibName "foreign library" + { foreignLibName = combineNames a b foreignLibName "foreign library" , foreignLibType = combine foreignLibType , foreignLibOptions = combine foreignLibOptions , foreignLibBuildInfo = combine foreignLibBuildInfo diff --git a/Cabal-syntax/src/Distribution/Types/TestSuite.hs b/Cabal-syntax/src/Distribution/Types/TestSuite.hs index 88e90aeeb78..6b3107cae71 100644 --- a/Cabal-syntax/src/Distribution/Types/TestSuite.hs +++ b/Cabal-syntax/src/Distribution/Types/TestSuite.hs @@ -51,7 +51,7 @@ instance Monoid TestSuite where instance Semigroup TestSuite where a <> b = TestSuite - { testName = combineName a b testName "test" + { testName = combineNames a b testName "test" , testInterface = combine testInterface , testBuildInfo = combine testBuildInfo , testCodeGenerators = combine testCodeGenerators diff --git a/Cabal-syntax/src/Distribution/Types/UnqualComponentName.hs b/Cabal-syntax/src/Distribution/Types/UnqualComponentName.hs index e33477e7adc..6ea21e7b368 100644 --- a/Cabal-syntax/src/Distribution/Types/UnqualComponentName.hs +++ b/Cabal-syntax/src/Distribution/Types/UnqualComponentName.hs @@ -9,7 +9,7 @@ module Distribution.Types.UnqualComponentName , mkUnqualComponentName , packageNameToUnqualComponentName , unqualComponentNameToPackageName - , combineName + , combineNames ) where import Distribution.Compat.Prelude @@ -107,11 +107,12 @@ packageNameToUnqualComponentName = UnqualComponentName . unPackageNameST unqualComponentNameToPackageName :: UnqualComponentName -> PackageName unqualComponentNameToPackageName = mkPackageNameST . unUnqualComponentNameST --- | Combine names in targets (partial function). Useful in 'Semigroup' --- and similar instances. -combineName :: a -> a -> (a -> UnqualComponentName) -> String -> +-- | 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 -combineName a b tacc tt +combineNames a b tacc tt -- One empty or the same. | P.null unb || una == unb = na diff --git a/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.check b/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.check index 336dfd3942f..7e2cfb4a499 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 -Please add them, using `cabal gen-bounds` for suggestions. For more information see: https://pvp.haskell.org/ +Please add them. More informations at https://pvp.haskell.org/ diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index afc2c6764a3..a067b94aeb1 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -84,7 +84,12 @@ library Distribution.Compat.Time Distribution.Make Distribution.PackageDescription.Check - Distribution.PackageDescription.Check.Prim + 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.ReadE Distribution.Simple Distribution.Simple.Bench diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index 00b5d94a82f..4a0db1d8d7b 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -34,6 +34,7 @@ module Distribution.PackageDescription.Check -- ** Checking package contents , checkPackageFiles + , checkPackageFilesGPD , checkPackageContent , CheckPackageContentOps (..) ) where @@ -46,37 +47,26 @@ 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.Check.Prim +import Distribution.PackageDescription.Check.Conditional +import Distribution.PackageDescription.Check.Common +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.CCompiler import Distribution.Simple.Glob import Distribution.Simple.Utils hiding (findPackageDesc, notice) -import Distribution.System -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 - ( splitDirectories - , splitExtension - , splitPath - , takeExtension - , takeFileName - , (<.>) - , () - ) - -import qualified Data.ByteString.Lazy as BS -import qualified Data.Map as Map -import qualified Distribution.SPDX as SPDX -import qualified System.Directory as System +import Distribution.Utils.Path +import System.FilePath (splitExtension, takeFileName, (<.>), ()) + +import qualified Data.ByteString.Lazy as BS +import qualified Distribution.SPDX as SPDX +import qualified System.Directory as System import qualified System.Directory (getDirectoryContents) import qualified System.FilePath.Windows as FilePath.Windows (isValid) @@ -84,7 +74,6 @@ 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 Control.Monad @@ -95,9 +84,9 @@ import Control.Monad -- ☞ N.B. -- -- Part of the tools/scaffold used to perform check is found in --- Distribution.PackageDescription.Check.Prim. Summary of that module (for +-- Distribution.PackageDescription.Check.Types. Summary of that module (for -- how we use it here): --- 1. we work inside a 'Check m a' monad (where `m` is an abstraction to +-- 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); @@ -160,14 +149,13 @@ 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. --- -checkPackageFiles :: Verbosity -> -- Glob warn message verbosity. - PackageDescription -> - FilePath -> -- Package root. - IO [PackageCheck] -checkPackageFiles verbosity gpd root = - checkPackagePrim False (Just checkFilesIO) (Just checkPreIO) - (pd2gpd gpd) +checkPackageFilesGPD :: + Verbosity -> -- Glob warn message verbosity. + GenericPackageDescription -> + FilePath -> -- Package root. + IO [PackageCheck] +checkPackageFilesGPD verbosity gpd root = + checkPackagePrim False (Just checkFilesIO) (Just checkPreIO) gpd where checkFilesIO = CheckPackageContentOps { doesFileExist = System.doesFileExist . relative, @@ -183,6 +171,17 @@ checkPackageFiles verbosity gpd root = relative path = root path +-- | 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 @@ -244,14 +243,22 @@ checkGenericPackageDescription (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) + (checkLibrary False ads) (const id) (mempty, cl) Nothing -> return () mapM_ (checkCondTarget genPackageFlags_ - (checkLibrary False) + (checkLibrary False ads) (\u l -> l {libName = maybeToLibraryName (Just u)})) condSubLibraries_ mapM_ (checkCondTarget genPackageFlags_ @@ -259,15 +266,15 @@ checkGenericPackageDescription (const id)) condForeignLibs_ mapM_ (checkCondTarget genPackageFlags_ - (checkExecutable (package packageDescription_)) + (checkExecutable (package packageDescription_) ads) (const id)) condExecutables_ mapM_ (checkCondTarget genPackageFlags_ - checkTestSuite + (checkTestSuite ads) (\u l -> l {testName = u})) condTestSuites_ mapM_ (checkCondTarget genPackageFlags_ - checkBenchmark + (checkBenchmark ads) (\u l -> l {benchmarkName = u})) condBenchmarks_ @@ -422,10 +429,12 @@ checkPackageDescription checkSetupBuildInfo :: Monad m => Maybe SetupBuildInfo -> CheckM m () checkSetupBuildInfo Nothing = return () checkSetupBuildInfo (Just (SetupBuildInfo ds _)) = do - (is, rs) <- partitionDeps ["base", "Cabal"] ds + let uqs = map mkUnqualComponentName ["base", "Cabal"] + (is, rs) <- partitionDeps [] uqs ds let ick = PackageDistInexcusable . UpperBoundSetup - rck = PackageDistSuspiciousWarn . MissingUpperBounds - mapM_ (checkPVP ick) is + rck = PackageDistSuspiciousWarn . + MissingUpperBounds CETSetup + checkPVP ick is checkPVPs rck rs checkPackageId :: Monad m => PackageIdentifier -> CheckM m () @@ -534,1116 +543,6 @@ checkMissingVcsInfo rs = repoTypeDirname Monotone = ["_MTN"] repoTypeDirname Pijul = [".pijul"] - --- ------------------------------------------------------------ --- * Conditional trees --- ------------------------------------------------------------ - --- 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) - -- Using simplifyCondition is convenient and correct, - -- if checks become more complex we can always walk - -- 'Condition'. - in 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 () - --- ------------------------------------------------------------ --- * Targets --- ------------------------------------------------------------ - -checkLibrary :: Monad m => - Bool -> -- Is this a sublibrary? - Library -> - CheckM m () -checkLibrary isSub 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 BITLib (explicitLibModules lib) 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 BITLib [] foreignLibBuildInfo_ - -checkExecutable :: Monad m => PackageId -> Executable -> CheckM m () -checkExecutable pid exe@(Executable - exeName_ modulePath_ _exeScope_ buildInfo_) = do - -- § Exe specific checks - checkP (null modulePath_) - (PackageBuildImpossible (NoMainIs exeName_)) - -- This check does not apply to scripts. - 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 CETExecutable exeName_) - checkP (not $ all (flip elem (view L.includes exe)) - (view L.autogenIncludes exe)) - (PackageBuildImpossible AutogenIncludesNotIncludedExe) - - -- § Build info checks. - checkBuildInfo BITOther [] buildInfo_ - -checkTestSuite :: Monad m => TestSuite -> CheckM m () -checkTestSuite ts@(TestSuite - testName_ testInterface_ testBuildInfo_ - _testCodeGenerators_) = do - -- § 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 CETTest $ testName_)) - 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 BITTestBench [] 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 => Benchmark -> CheckM m () -checkBenchmark bm@(Benchmark - benchmarkName_ benchmarkInterface_ - benchmarkBuildInfo_) = do - -- § 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 CETBenchmark benchmarkName_) - - checkP (not $ all (flip elem (view L.includes bm)) - (view L.autogenIncludes bm)) - (PackageBuildImpossible AutogenIncludesNotIncludedExe) - - -- § BuildInfo checks. - checkBuildInfo BITTestBench [] 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 --- ------------------------------------------------------------ - --- Target type (library, test/bech, other). -data BITarget = BITLib | BITTestBench | BITOther - deriving (Eq, Show) - --- 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 => - BITarget -> -- Target type. - [ModuleName] -> -- Additional module names which cannot be - -- extracted from BuildInfo (mainly: exposed - -- library modules). - BuildInfo -> - CheckM m () -checkBuildInfo t ams 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 t 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 ["base"] - (mergeDependencies $ targetBuildDepends bi) - let ick = const (PackageDistInexcusable BaseNoUpperBounds) - rck = PackageDistSuspiciousWarn . MissingUpperBounds - mapM_ (checkPVP ick) ids - 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") - (map 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_ checkDep (targetBuildDepends bi) --xxx checdep no va qui - 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) - - checkDep :: Monad m => Dependency -> CheckM m () - checkDep 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 (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 && -- internal - name `notElem`exns) -- 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) - (map 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 -- - --- Convenience function to partition important dependencies by name. To --- be used together with checkPVP. -partitionDeps :: Monad m => - [String] -> -- | List of package names ("base", "Cabal"…) - [Dependency] -> - CheckM m ([Dependency], [Dependency]) -partitionDeps ns ds = do - pId <- asksCM (pnPackageId . ccNames) - let idName = unPackageName . pkgName $ pId - -- Do not return dependencies which are package - -- main library. - ds' = filter ((/= idName) . depName) ds - - -- February 2022: this is a tricky part of the function. If the - -- two lists are different in length (hence, we did find a dep- - -- endency to the package itself), move all dependencies in the - -- non-critical bucket. - -- With this pragmatic choice we kill two birds with one stone: - -- - we still ouptut a warning for naked `base` dependencies in - -- the target (usually a test, an example exe, etc); - -- - but we don’t make Hackage refuse the package, which mimics - -- ante-refactoring behaviour (a soup of all dependencies in - -- the whole package merged together). - -- Once the community is positive about upper bounds best-prac- - -- tices this can be removed. - if ds /= ds' - then return ([], ds') - else return (partition (flip elem ns . depName) ds') - where - depName d = unPackageName . depPkgName $ d - --- 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 dName = unPackageName . depPkgName $ d - (sames, diffs) = partition ((== dName) . depName) l - merged = Dependency (depPkgName d) - (foldl intersectVersionRanges anyVersion $ - map depVerRange sames) - (depLibraries d) - in merged : mergeDependencies diffs - where - depName wd = unPackageName . depPkgName $ wd - --- PVP dependency check (single dependency). -checkPVP :: Monad m => - (String -> PackageCheck) -> -- Warn message dependend on name - -- (e.g. "base", "Cabal"). - Dependency -> - CheckM m () -checkPVP ckf (Dependency pname ver _) = do - checkP ((not . hasUpperBound) ver) - (ckf . unPackageName $ pname) - --- 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] -> - CheckM m () -checkPVPs cf ds = do - let ds' = filter withoutUpper ds - nds = map (unPackageName . depPkgName) ds' - unless (null nds) - (tellP $ cf nds) - where - withoutUpper :: Dependency -> Bool - withoutUpper (Dependency _ ver _) = not . hasUpperBound $ ver - - --- ------------------------------------------------------------ --- * Options --- ------------------------------------------------------------ - --- 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 ["-fvia-C"] - (PackageDistSuspicious $ OptViaC title) - checkFlags ["-fhpc"] - (PackageDistInexcusable $ OptHpc title) - checkFlags ["-prof"] - (PackageBuildWarning $ OptProf title) - 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 - --- ------------------------------------------------------------ --- * Paths and fields --- ------------------------------------------------------------ - --- Type of path. -data PathKind - = PathKindFile - | PathKindDirectory - | PathKindGlob - deriving (Eq) - --- 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 - -checkCustomField :: Monad m => (String, String) -> CheckM m () -checkCustomField (n, _) = - checkP (any (not . isAscii) n) - (PackageDistInexcusable $ NonASCIICustomField [n]) - --- `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) - --- 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 - - return (mcs ++ pcs)) - where - -- From Distribution.Simple.Glob. - globMatches :: [GlobResult a] -> [a] - globMatches input = [a | GlobMatch a <- input] - - 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] - --- Predicate for desirable documentation file on Hackage server. -isDesirableExtraDocFile :: FilePath -> Bool -isDesirableExtraDocFile path = basename `elem` desirableChangeLog && - ext `elem` desirableChangeLogExtensions - 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"] - - -- ------------------------------------------------------------ -- * Package and distribution checks -- ------------------------------------------------------------ @@ -1789,7 +688,7 @@ checkGlobResult title fp rs = dirCheck ++ catMaybes (map getWarning rs) -- ------------------------------------------------------------ --- * Other exports and non-traverse checks +-- * Other exports -- ------------------------------------------------------------ -- | Wraps `ParseWarning` into `PackageCheck`. @@ -1801,297 +700,24 @@ wrapParseWarning fp pw = PackageDistSuspicious (ParseWarning fp pw) -- than PackageDistSuspicious for every parse warning. -- (see: Cabal-syntax/src/Distribution/Parsec/Warning.hs) --- 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 [] - - -- ------------------------------------------------------------ - --- * Utils - +-- * Ancillaries -- ------------------------------------------------------------ --- | .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 - --- Remove duplicates from list. -dups :: Ord a => [a] -> [a] -dups xs = [x | (x : _ : _) <- group (sort xs)] - -fileExtensionSupportedLanguage :: FilePath -> Bool -fileExtensionSupportedLanguage path = - isHaskell || isC - where - extension = takeExtension path - isHaskell = extension `elem` [".hs", ".lhs"] - isC = isJust (filenameCDialect extension) - --- | 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 --- @ +-- 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 + -- Merging is fine here, remember the specific + -- library dependencies will be checked branch + -- by branch. + in (n, snd a) -- | August 2022: this function is an oddity due to the historical -- GenericPackageDescription/PackageDescription split (check @@ -2139,3 +765,93 @@ pd2gpd pd = gpd 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 + + return (mcs ++ pcs)) + where + -- From Distribution.Simple.Glob. + globMatches :: [GlobResult a] -> [a] + globMatches input = [a | GlobMatch a <- input] + + 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] + +-- Predicate for desirable documentation file on Hackage server. +isDesirableExtraDocFile :: FilePath -> Bool +isDesirableExtraDocFile path = basename `elem` desirableChangeLog && + ext `elem` desirableChangeLogExtensions + 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"] + +-- 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..d0f1da83911 --- /dev/null +++ b/Cabal/src/Distribution/PackageDescription/Check/Common.hs @@ -0,0 +1,145 @@ +----------------------------------------------------------------------------- +-- | +-- 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..a18cf9eaab3 --- /dev/null +++ b/Cabal/src/Distribution/PackageDescription/Check/Conditional.hs @@ -0,0 +1,204 @@ +{-# 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 targes (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) + -- Using simplifyCondition is convenient and correct, + -- if checks become more complex we can always walk + -- 'Condition'. + in 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..d6127d10dbd --- /dev/null +++ b/Cabal/src/Distribution/PackageDescription/Check/Monad.hs @@ -0,0 +1,350 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +----------------------------------------------------------------------------- +-- | +-- 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.PackageId (PackageIdentifier) +import Distribution.Types.PackageDescription (package, specVersion) +import Distribution.Types.UnqualComponentName + +import qualified Control.Monad.Reader as Reader +import qualified Control.Monad.Writer as Writer +import qualified Control.Monad.Trans.Class as Trans +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..cd2dfb65d42 --- /dev/null +++ b/Cabal/src/Distribution/PackageDescription/Check/Paths.hs @@ -0,0 +1,387 @@ +----------------------------------------------------------------------------- +-- | +-- 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.Monad +import Distribution.PackageDescription.Check.Common +import Distribution.Simple.CCompiler +import Distribution.Simple.Glob +import Distribution.Simple.Utils hiding (findPackageDesc, notice) +import System.FilePath (takeExtension, splitDirectories, splitPath) + +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..aefe9d4b936 --- /dev/null +++ b/Cabal/src/Distribution/PackageDescription/Check/Target.hs @@ -0,0 +1,765 @@ +----------------------------------------------------------------------------- +-- | +-- 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 Language.Haskell.Extension +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 (autogenPathsModuleName, + autogenPackageInfoModuleName) +import Distribution.Simple.Utils hiding (findPackageDesc, notice) +import Distribution.Version +import Distribution.Types.PackageName.Magic +import Distribution.Utils.Path +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 => + PackageId -> + [AssocDep] -> -- “Inherited” dependencies for PVP checks. + Executable -> + CheckM m () +checkExecutable pid 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. + 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 + 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") + (map 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_ checkDep (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) + + checkDep :: Monad m => Dependency -> CheckM m () + checkDep 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 (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 && -- internal + name `notElem`exns) -- 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) + (map 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 + +-- ------------------------------------------------------------ +-- * 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 ["-fvia-C"] + (PackageDistSuspicious $ OptViaC title) + checkFlags ["-fhpc"] + (PackageDistInexcusable $ OptHpc title) + checkFlags ["-prof"] + (PackageBuildWarning $ OptProf title) + 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/Prim.hs b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs similarity index 73% rename from Cabal/src/Distribution/PackageDescription/Check/Prim.hs rename to Cabal/src/Distribution/PackageDescription/Check/Warning.hs index 2f9c3a1a243..ec2f175799c 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Prim.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs @@ -4,66 +4,43 @@ ----------------------------------------------------------------------------- -- | --- Module : Distribution.PackageDescription.Check.Monad +-- Module : Distribution.PackageDescription.Check.Warning -- 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. +-- Warning types, messages, severity and associated functions. -module Distribution.PackageDescription.Check.Prim +module Distribution.PackageDescription.Check.Warning ( -- * 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 - + extractCheckExplantion ) where +import Distribution.Compat.Prelude +import Prelude () + import Distribution.CabalSpecVersion (CabalSpecVersion, showCabalSpecVersion) import Distribution.License (License, knownLicenses) import Distribution.ModuleName (ModuleName) -import Distribution.Package (packageName) import Distribution.Parsec.Warning (PWarning, showPWarning) import Distribution.Pretty (prettyShow) -import Distribution.Simple.BuildToolDepends (desugarBuildToolSimple) -import Distribution.Simple.Glob (Glob, GlobResult) import Distribution.Types.BenchmarkType (BenchmarkType, knownBenchmarkTypes) -import Distribution.Types.Dependency (Dependency) +import Distribution.Types.Dependency (Dependency(..)) import Distribution.Types.ExeDependency (ExeDependency) import Distribution.Types.Flag (FlagName, unFlagName) -import Distribution.Types.GenericPackageDescription -import Distribution.Types.LegacyExeDependency (LegacyExeDependency) -import Distribution.Types.PackageId (PackageIdentifier) -import Distribution.Types.PackageDescription (package, specVersion) import Distribution.Types.PackageName (PackageName) -import Distribution.Types.LibraryName (LibraryName, showLibraryName) +import Distribution.Types.LibraryName (LibraryName(..), showLibraryName) import Distribution.Types.TestType (TestType, knownTestTypes) import Distribution.Types.UnqualComponentName import Distribution.Types.Version (Version) @@ -71,297 +48,9 @@ import Distribution.Utils.Path (LicenseFile, PackageDir, SymbolicPath, getSymbolicPath) import Language.Haskell.Extension (Extension) -import qualified Control.Monad.Reader as Reader -import qualified Control.Monad.Writer as Writer -import qualified Control.Monad.Trans.Class as Trans -import qualified Data.ByteString.Lazy as BS import qualified Data.List as List import qualified Data.Set as Set -import Control.Monad - --- ------------------------------------------------------------ --- * Check 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) - -- ------------------------------------------------------------ -- * Check types and explanations @@ -424,6 +113,9 @@ isHackageDistError = \case -- | 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 @@ -439,7 +131,7 @@ data CheckExplanation = | NoMainIs UnqualComponentName | NoHsLhsMain | MainCCabal1_18 - | AutogenNoOther CEType UnqualComponentName + | AutogenNoOther CEType | AutogenIncludesNotIncludedExe | TestsuiteTypeNotKnown TestType | TestsuiteNotSupported TestType @@ -533,7 +225,7 @@ data CheckExplanation = | UnknownArch [String] | UnknownCompiler [String] | BaseNoUpperBounds - | MissingUpperBounds [String] + | MissingUpperBounds CEType [String] | SuspiciousFlagName [String] | DeclaredUsedFlags (Set.Set FlagName) (Set.Set FlagName) | NonASCIICustomField [String] @@ -579,16 +271,28 @@ extractCheckExplantion (PackageDistInexcusable e) = e -- | Which stanza does `CheckExplanation` refer to? -- -data CEType = CETLibrary | CETExecutable | CETTest | CETBenchmark +data CEType = + CETLibrary LibraryName + | CETForeignLibrary UnqualComponentName + | CETExecutable UnqualComponentName + | CETTest UnqualComponentName + | CETBenchmark UnqualComponentName + | CETSetup deriving (Eq, Ord, Show) -- | Pretty printing `CEType`. -- -ppCE :: CEType -> String -ppCE CETLibrary = "library" -ppCE CETExecutable = "executable" -ppCE CETTest = "test suite" -ppCE CETBenchmark = "benchmark" +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? -- @@ -660,8 +364,8 @@ 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'" +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'." @@ -1043,14 +747,12 @@ ppExplanation BaseNoUpperBounds = ++ "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 names) = - let separator = "\n - " - in - "These packages miss upper bounds:" ++ separator - ++ (List.intercalate separator names) ++ "\n" - ++ "Please add them, using `cabal gen-bounds` for suggestions." - ++ " For more information see: " - ++ " https://pvp.haskell.org/" +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. More informations at https://pvp.haskell.org/" ppExplanation (SuspiciousFlagName invalidFlagNames) = "Suspicious flag names: " ++ unwords invalidFlagNames ++ ". " ++ "To avoid ambiguity in command line interfaces, flag shouldn't " diff --git a/Cabal/src/Distribution/Simple/BuildToolDepends.hs b/Cabal/src/Distribution/Simple/BuildToolDepends.hs index 4c642f49e89..25bbf960ed6 100644 --- a/Cabal/src/Distribution/Simple/BuildToolDepends.hs +++ b/Cabal/src/Distribution/Simple/BuildToolDepends.hs @@ -19,21 +19,19 @@ desugarBuildToolSimple :: PackageName -> [UnqualComponentName] -> LegacyExeDependency -> Maybe ExeDependency -desugarBuildToolSimple pname exeNames led = - if foundLocal - then Just $ ExeDependency pname toolName reqVer - else Map.lookup name whiteMap +desugarBuildToolSimple pname exeNames (LegacyExeDependency name reqVer) + | foundLocal = Just $ ExeDependency pname toolName reqVer + | otherwise = Map.lookup name allowMap where - LegacyExeDependency name reqVer = led toolName = mkUnqualComponentName name foundLocal = toolName `elem` exeNames - whitelist = [ "hscolour", "haddock", "happy", "alex", "hsc2hs", "c2hs" + allowlist = [ "hscolour", "haddock", "happy", "alex", "hsc2hs", "c2hs" , "cpphs", "greencard", "hspec-discover" ] - whiteMap = Map.fromList $ flip map whitelist $ \n -> + allowMap = Map.fromList $ flip map allowlist $ \n -> (n, ExeDependency (mkPackageName n) (mkUnqualComponentName n) reqVer) --- | Desugar a "build-tools" entry into proper a executable dependency if +-- | Desugar a "build-tools" entry into a proper executable dependency if -- possible. -- -- An entry can be so desugared in two cases: diff --git a/cabal-install/src/Distribution/Client/Check.hs b/cabal-install/src/Distribution/Client/Check.hs index 076bc59ee6e..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,21 +65,7 @@ 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 "." + ioChecks <- checkPackageFilesGPD verbosity ppd "." let packageChecks = ioChecks ++ checkPackage ppd ++ ws' CM.mapM_ (outputGroupCheck verbosity) (groupChecks packageChecks) 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/NoWarnFlagManual/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.out index b26b8576047..54660ce787e 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.out +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagManual/cabal.out @@ -1,4 +1,4 @@ # cabal check -Warning: These warnings may cause trouble when distributing the package: +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.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.out index b26b8576047..54660ce787e 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.out +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/GHCOptions/NoWarnFlagOut/cabal.out @@ -1,4 +1,4 @@ # cabal check -Warning: These warnings may cause trouble when distributing the package: +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/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.out index 6ab7142b37c..405f3087efb 100644 --- a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.out +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.out @@ -1,8 +1,4 @@ # cabal check -Warning: The following errors will cause portability problems on other -environments: -Warning: '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. -Warning: Hackage would reject this package. +The following errors will cause portability problems on other environments: +Error: '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. +Error: Hackage would reject this package. diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.out index 4502a2f87b5..37aa169b416 100644 --- a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.out +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.out @@ -1,6 +1,2 @@ # cabal check -Warning: These warnings may cause trouble when distributing the package: -Warning: These packages miss upper bounds: -- base -Please add them, using `cabal gen-bounds` for suggestions. For more -information see: https://pvp.haskell.org/ +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 index 82d60c548a1..1a6b28f94fc 100644 --- a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.test.hs +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.test.hs @@ -1,5 +1,5 @@ import Test.Cabal.Prelude --- Unbounded (top) base with internal dependency: warn but do not error. +-- Unbounded (top) base with internal dependency: no warn, no error. main = cabalTest $ cabal "check" [] 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..f62b27ad803 --- /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. More informations 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..cb35fe0b644 --- /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. More informations 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/changelog.d/pr-8427 b/changelog.d/pr-8427 index af5bf0e6c1e..402765942d6 100644 --- a/changelog.d/pr-8427 +++ b/changelog.d/pr-8427 @@ -12,4 +12,8 @@ description: { 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 88803232bf6..c11461ef82c 100644 --- a/doc/cabal-commands.rst +++ b/doc/cabal-commands.rst @@ -1148,6 +1148,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. +- 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 ^^^^^^^^^^^ From a0ac130bf5f4f6ec02efb5bb5ed1bbeb04cb254e Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Sat, 11 Mar 2023 15:18:46 +0100 Subject: [PATCH 09/18] Move internal Check modules to `other-modules` No need to expose Distribution.PackageDescription.Check.* to the world. API for checking, for cabal-install and other tools, should be in Distribution.PackageDescription.Check. --- Cabal/Cabal.cabal | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index a067b94aeb1..c5dd237a5f8 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -84,12 +84,6 @@ library Distribution.Compat.Time Distribution.Make Distribution.PackageDescription.Check - 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.ReadE Distribution.Simple Distribution.Simple.Bench @@ -328,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 From bd5bbadc4800a93faeee05d389dc92a7bdbf8ad2 Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Mon, 29 May 2023 17:33:07 +0200 Subject: [PATCH 10/18] Make fourmolu happy MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Cabal codebase has now a formatter/style standard (see #8950). “Ravioli ravioli, give me the formuoli” --- .../Distribution/Types/UnqualComponentName.hs | 39 +- .../Distribution/PackageDescription/Check.hs | 1370 ++++++++------ .../PackageDescription/Check/Common.hs | 170 +- .../PackageDescription/Check/Conditional.hs | 299 ++-- .../PackageDescription/Check/Monad.hs | 460 ++--- .../PackageDescription/Check/Paths.hs | 345 ++-- .../PackageDescription/Check/Target.hs | 1593 ++++++++++------- .../PackageDescription/Check/Warning.hs | 1396 ++++++++------- .../Distribution/Simple/BuildToolDepends.hs | 38 +- 9 files changed, 3209 insertions(+), 2501 deletions(-) diff --git a/Cabal-syntax/src/Distribution/Types/UnqualComponentName.hs b/Cabal-syntax/src/Distribution/Types/UnqualComponentName.hs index 6ea21e7b368..93feff2fbbe 100644 --- a/Cabal-syntax/src/Distribution/Types/UnqualComponentName.hs +++ b/Cabal-syntax/src/Distribution/Types/UnqualComponentName.hs @@ -110,18 +110,29 @@ 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 + -> 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 - + -- 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/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index 4a0db1d8d7b..e31969ca891 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -1,7 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------ - -- | -- Module : Distribution.PackageDescription.Check -- Copyright : Lennart Kolmodin 2008, Francesco Ariis 2022 @@ -49,8 +47,8 @@ import Distribution.Compiler import Distribution.License import Distribution.Package import Distribution.PackageDescription -import Distribution.PackageDescription.Check.Conditional 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 @@ -59,14 +57,14 @@ import Distribution.Pretty (prettyShow) import Distribution.Simple.Glob import Distribution.Simple.Utils hiding (findPackageDesc, notice) import Distribution.Utils.Generic (isAscii) +import Distribution.Utils.Path import Distribution.Verbosity import Distribution.Version -import Distribution.Utils.Path import System.FilePath (splitExtension, takeFileName, (<.>), ()) -import qualified Data.ByteString.Lazy as BS -import qualified Distribution.SPDX as SPDX -import qualified System.Directory as System +import qualified Data.ByteString.Lazy as BS +import qualified Distribution.SPDX as SPDX +import qualified System.Directory as System import qualified System.Directory (getDirectoryContents) import qualified System.FilePath.Windows as FilePath.Windows (isValid) @@ -93,9 +91,8 @@ import Control.Monad -- 3. 'PackageCheck' and 'CheckExplanation' are types for warning severity -- and description. - -- ------------------------------------------------------------ --- * Checking interface +-- Checking interface -- ------------------------------------------------------------ -- | 'checkPackagePrim' is the most general way to invoke package checks. @@ -106,24 +103,24 @@ import Control.Monad -- 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 + :: 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 + 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 @@ -139,35 +136,37 @@ checkConfiguredPackage pd = checkPackage (pd2gpd pd) -- -- 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 + :: 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 -- Glob warn message verbosity. + -> GenericPackageDescription + -> FilePath -- Package root. + -> IO [PackageCheck] checkPackageFilesGPD verbosity gpd root = - checkPackagePrim False (Just checkFilesIO) (Just checkPreIO) gpd + checkPackagePrim False (Just checkFilesIO) (Just checkPreIO) gpd where - checkFilesIO = CheckPackageContentOps { - doesFileExist = System.doesFileExist . relative, - doesDirectoryExist = System.doesDirectoryExist . relative, - getDirectoryContents = System.Directory.getDirectoryContents . relative, - getFileContents = BS.readFile . relative - } - - checkPreIO = CheckPreDistributionOps { - runDirFileGlobM = \fp g -> runDirFileGlob verbosity (root fp) g, - getDirectoryContentsM = System.Directory.getDirectoryContents . relative - } + checkFilesIO = + CheckPackageContentOps + { doesFileExist = System.doesFileExist . relative + , doesDirectoryExist = System.doesDirectoryExist . relative + , getDirectoryContents = System.Directory.getDirectoryContents . relative + , getFileContents = BS.readFile . relative + } + + checkPreIO = + CheckPreDistributionOps + { runDirFileGlobM = \fp g -> runDirFileGlob verbosity (root fp) g + , getDirectoryContentsM = System.Directory.getDirectoryContents . relative + } relative path = root path @@ -175,16 +174,16 @@ checkPackageFilesGPD verbosity gpd root = -- -- 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 -- Glob warn message verbosity. + -> PackageDescription + -> FilePath -- Package root. + -> IO [PackageCheck] checkPackageFiles verbosity pd oot = - checkPackageFilesGPD verbosity (pd2gpd pd) oot + checkPackageFilesGPD verbosity (pd2gpd pd) oot -- ------------------------------------------------------------ --- * Package description +-- Package description -- ------------------------------------------------------------ -- Here lies the meat of the module. Starting from 'GenericPackageDescription', @@ -204,347 +203,507 @@ checkPackageFiles verbosity pd oot = -- 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) - -- ... 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)})) - condSubLibraries_ - mapM_ (checkCondTarget genPackageFlags_ - checkForeignLib - (const id)) - condForeignLibs_ - mapM_ (checkCondTarget genPackageFlags_ - (checkExecutable (package packageDescription_) ads) - (const id)) - condExecutables_ - mapM_ (checkCondTarget genPackageFlags_ - (checkTestSuite ads) - (\u l -> l {testName = u})) - 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 + :: 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) + -- ... 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)}) + ) + condSubLibraries_ + mapM_ + ( checkCondTarget + genPackageFlags_ + checkForeignLib + (const id) + ) + condForeignLibs_ + mapM_ + ( checkCondTarget + genPackageFlags_ + (checkExecutable (package packageDescription_) ads) + (const id) + ) + condExecutables_ + mapM_ + ( checkCondTarget + genPackageFlags_ + (checkTestSuite ads) + (\u l -> l{testName = u}) + ) + 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 + ] 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_ + 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))) + 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)) + ) 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 + 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) + 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 () + 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] - - unknownLicenseVersion (GPL (Just v)) - | v `notElem` knownVersions = Just knownVersions - where knownVersions = [ v' | GPL (Just v') <- knownLicenses ] - unknownLicenseVersion (LGPL (Just v)) - | v `notElem` knownVersions = Just knownVersions - where knownVersions = [ v' | LGPL (Just v') <- knownLicenses ] - unknownLicenseVersion (AGPL (Just v)) - | v `notElem` knownVersions = Just knownVersions - where knownVersions = [ v' | AGPL (Just v') <- knownLicenses ] - unknownLicenseVersion (Apache (Just v)) - | v `notElem` knownVersions = Just knownVersions - where knownVersions = [ v' | Apache (Just v') <- knownLicenses ] - unknownLicenseVersion _ = Nothing + 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 + ] + + unknownLicenseVersion (GPL (Just v)) + | v `notElem` knownVersions = Just knownVersions + where + knownVersions = [v' | GPL (Just v') <- knownLicenses] + unknownLicenseVersion (LGPL (Just v)) + | v `notElem` knownVersions = Just knownVersions + where + knownVersions = [v' | LGPL (Just v') <- knownLicenses] + unknownLicenseVersion (AGPL (Just v)) + | v `notElem` knownVersions = Just knownVersions + where + knownVersions = [v' | AGPL (Just v') <- knownLicenses] + unknownLicenseVersion (Apache (Just v)) + | v `notElem` knownVersions = Just knownVersions + where + knownVersions = [v' | Apache (Just v') <- knownLicenses] + unknownLicenseVersion _ = Nothing checkSourceRepos :: Monad m => [SourceRepo] -> CheckM m () checkSourceRepos rs = do - mapM_ repoCheck rs - checkMissingVcsInfo rs - where - -- 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 () + mapM_ repoCheck rs + checkMissingVcsInfo rs + where + -- 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)) - (PackageDistSuspicious MissingSourceControl) - where - 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"] + let rdirs = concatMap repoTypeDirname knownRepoTypes + in checkPkg + ( \ops -> do + us <- or <$> traverse (doesDirectoryExist ops) rdirs + return (null rs && us) + ) + (PackageDistSuspicious MissingSourceControl) + where + 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"] -- ------------------------------------------------------------ --- * Package and distribution checks +-- Package and distribution checks -- ------------------------------------------------------------ -- | Find a package description file in the given directory. Looks for @@ -552,72 +711,89 @@ checkMissingVcsInfo rs = -- 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" ] - return cabalFiles + 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" + ] + 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]) - -- Multiple .cabal files. - where - 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 - - bomUtf8 :: BS.ByteString - bomUtf8 = BS.pack [0xef,0xbb,0xbf] -- U+FEFF encoded as UTF8 - - 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 => SymbolicPath PackageDir LicenseFile -> - CheckM m () + -- 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 + -- Multiple .cabal files. + + 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 + + bomUtf8 :: BS.ByteString + bomUtf8 = BS.pack [0xef, 0xbb, 0xbf] -- U+FEFF encoded as UTF8 + 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 + => SymbolicPath PackageDir LicenseFile + -> CheckM m () checkLicFileExist sp = do - let fp = getSymbolicPath sp - checkPkg (\ops -> not <$> doesFileExist ops fp) - (PackageBuildWarning $ UnknownFile "license-file" sp) + 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) + 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) + checkPkg + ( \ops -> do + ba <- doesFileExist ops "Setup.hs" + bb <- doesFileExist ops "Setup.lhs" + return (not $ ba || bb) + ) + (PackageDistInexcusable MissingSetupFile) -- The following functions are similar to 'CheckPackageContentOps m' ones, -- but, as they inspect the files included in the package, but are primarily @@ -635,73 +811,76 @@ checkSetupExists _ = -- because that will make us say that Hackage would reject the package. -- But, because Hackage doesn't yet run these tests, that will be a lie! -checkGlobFile :: Monad m => CabalSpecVersion -> - FilePath -> -- Glob pattern. - FilePath -> -- Folder to check. - CabalField -> -- .cabal field we are checking. - CheckM m () +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 + 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 mathching (<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 + :: 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 - 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. - 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 (GlobWarnMultiDot file) = - Just $ PackageDistSuspiciousWarn (GlobExactMatch title fp file) - getWarning (GlobMissingDirectory dir) = - Just $ PackageDistSuspiciousWarn (GlobNoDir title fp dir) - + where + 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. + 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 (GlobWarnMultiDot file) = + Just $ PackageDistSuspiciousWarn (GlobExactMatch title fp file) + getWarning (GlobMissingDirectory dir) = + Just $ PackageDistSuspiciousWarn (GlobNoDir title fp dir) -- ------------------------------------------------------------ --- * Other exports +-- Other exports -- ------------------------------------------------------------ -- | 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) + +-- 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 +-- Ancillaries -- ------------------------------------------------------------ -- Gets a list of dependencies from a Library target to pass to PVP related @@ -709,15 +888,16 @@ wrapParseWarning fp pw = PackageDistSuspicious (ParseWarning fp pw) -- 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 + :: UnqualComponentName -- Name of the target library + -> CondTree ConfVar [Dependency] Library + -> AssocDep extractAssocDeps n ct = - let a = ignoreConditions ct - -- Merging is fine here, remember the specific - -- library dependencies will be checked branch - -- by branch. - in (n, snd a) + 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 @@ -727,67 +907,82 @@ extractAssocDeps n ct = -- 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) } - - -- 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 } + 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) + } + + -- 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 + :: 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 - extraDocSupport <- (>= CabalSpecV1_18) <$> asksCM ccSpecVersion - - -- Everything in this block uses CheckPreDistributionOps interface. - liftInt ciPreDistOps (\ops -> do - + -- 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. + -- 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 + let realGlob t = + concatMap globMatches + <$> mapM (runDirFileGlobM ops "") t rgs <- realGlob dgs res <- realGlob esgs red <- realGlob edgs @@ -797,61 +992,76 @@ checkMissingDocs dgs esgs edgs = do -- 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 [] + pcsSource = + if extraDocSupport + then + checkDocMove + extraDocSupport + "extra-source-files" + des + res + else [] pcs = pcsData ++ pcsSource - return (mcs ++ pcs)) - where - -- From Distribution.Simple.Glob. - globMatches :: [GlobResult a] -> [a] - globMatches input = [a | GlobMatch a <- input] - - 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] + return (mcs ++ pcs) + ) + where + -- From Distribution.Simple.Glob. + globMatches :: [GlobResult a] -> [a] + globMatches input = [a | GlobMatch a <- input] + + 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 + ] -- Predicate for desirable documentation file on Hackage server. isDesirableExtraDocFile :: FilePath -> Bool -isDesirableExtraDocFile path = basename `elem` desirableChangeLog && - ext `elem` desirableChangeLogExtensions +isDesirableExtraDocFile path = + basename `elem` desirableChangeLog + && ext `elem` desirableChangeLogExtensions 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"] + (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"] -- Remove duplicates from list. dups :: Ord a => [a] -> [a] -dups xs = [ x | (x:_:_) <- group (sort xs) ] - +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 index d0f1da83911..4c528831430 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Common.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Common.hs @@ -1,4 +1,3 @@ ------------------------------------------------------------------------------ -- | -- Module : Distribution.PackageDescription.Check.Common -- Copyright : Francesco Ariis 2022 @@ -9,17 +8,15 @@ -- -- 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 +module Distribution.PackageDescription.Check.Common + ( AssocDep + , CabalField + , PathKind (..) + , checkCustomField + , partitionDeps + , checkPVP + , checkPVPs + ) where import Distribution.Compat.Prelude import Prelude () @@ -35,9 +32,9 @@ import Control.Monad -- Type of FilePath. data PathKind - = PathKindFile - | PathKindDirectory - | PathKindGlob + = PathKindFile + | PathKindDirectory + | PathKindGlob deriving (Eq) -- | .cabal field we are referring to. As now it is just a synonym to help @@ -47,11 +44,12 @@ type CabalField = String checkCustomField :: Monad m => (String, String) -> CheckM m () checkCustomField (n, _) = - checkP (any (not . isAscii) n) - (PackageDistInexcusable $ NonASCIICustomField [n]) + checkP + (any (not . isAscii) n) + (PackageDistInexcusable $ NonASCIICustomField [n]) -- ------------------------------------------------------------ --- * PVP types/functions +-- PVP types/functions -- ------------------------------------------------------------ -- A library name / dependencies association list. Ultimately to be @@ -66,80 +64,86 @@ type AssocDep = (UnqualComponentName, [Dependency]) -- 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 + :: 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 + -- 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 + :: 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 + 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 +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 - + 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 index a18cf9eaab3..49356575f7f 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Conditional.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Conditional.hs @@ -1,6 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------ -- | -- Module : Distribution.PackageDescription.Check.Conditional -- Copyright : Lennart Kolmodin 2008, Francesco Ariis 2023 @@ -12,11 +11,10 @@ -- Checks on conditional targes (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 +module Distribution.PackageDescription.Check.Conditional + ( checkCondTarget + , checkDuplicateModules + ) where import Distribution.Compat.Prelude import Prelude () @@ -28,11 +26,10 @@ import Distribution.PackageDescription import Distribution.PackageDescription.Check.Monad import Distribution.System -import qualified Data.Map as Map +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 @@ -41,130 +38,144 @@ import Control.Monad -- | @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 + :: 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 } +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 + :: 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 + 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 + :: 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 + 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) - -- Using simplifyCondition is convenient and correct, - -- if checks become more complex we can always walk - -- 'Condition'. - in 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 () + 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, @@ -172,33 +183,39 @@ checkCondVars cond = -- 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) + 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 + 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 [] - + 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 index d6127d10dbd..9e375e8d9b8 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Monad.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Monad.hs @@ -1,7 +1,6 @@ -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------ -- | -- Module : Distribution.PackageDescription.Check.Monad -- Copyright : Francesco Ariis 2022 @@ -13,37 +12,35 @@ -- 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 + ( -- * 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 () @@ -56,159 +53,166 @@ import Distribution.Simple.Glob (Glob, GlobResult) import Distribution.Types.ExeDependency (ExeDependency) import Distribution.Types.GenericPackageDescription import Distribution.Types.LegacyExeDependency (LegacyExeDependency) -import Distribution.Types.PackageId (PackageIdentifier) 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.Writer as Writer 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. - } +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 +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] - } +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. - } +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 + :: 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) + 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} +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. - } +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] - } +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) +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. +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 + 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 () @@ -217,116 +221,134 @@ 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 + 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 +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 + :: 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) +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 + :: 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 +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) +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 () @@ -338,13 +360,13 @@ 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 + :: 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) - + 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 index cd2dfb65d42..f389c6797be 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Paths.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Paths.hs @@ -1,4 +1,3 @@ ------------------------------------------------------------------------------ -- | -- Module : Distribution.PackageDescription.Check.Paths -- Copyright : Lennart Kolmodin 2008, Francesco Ariis 2023 @@ -8,105 +7,113 @@ -- Portability : portable -- -- Functions to check filepaths, directories, globs, etc. - -module Distribution.PackageDescription.Check.Paths ( - checkGlob, - checkPath, - fileExtensionSupportedLanguage, - isGoodRelativeDirectoryPath, - isGoodRelativeFilePath, - isGoodRelativeGlob, - isInsideDist - ) where +module Distribution.PackageDescription.Check.Paths + ( checkGlob + , checkPath + , fileExtensionSupportedLanguage + , isGoodRelativeDirectoryPath + , isGoodRelativeFilePath + , isGoodRelativeGlob + , isInsideDist + ) where import Distribution.Compat.Prelude import Prelude () -import Distribution.PackageDescription.Check.Monad 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 (takeExtension, splitDirectories, splitPath) +import System.FilePath (splitDirectories, splitPath, takeExtension) import qualified System.FilePath.Windows as FilePath.Windows (isValid) - - fileExtensionSupportedLanguage :: FilePath -> Bool fileExtensionSupportedLanguage path = - isHaskell || isC + isHaskell || isC where extension = takeExtension path isHaskell = extension `elem` [".hs", ".lhs"] - isC = isJust (filenameCDialect extension) + 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 + :: 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 + 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 + -- 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 () + 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 (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]) + 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 + 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. -- @@ -115,36 +122,36 @@ checkWindowsPath isGlob path = -- 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 + | 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 - + 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 + 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 _ [] = 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) + pack' maxLen n (c : cs) | n' <= maxLen = pack' maxLen n' cs - where n' = n + length c - pack' _ _ cs = cs + where + n' = n + length c + pack' _ _ cs = cs longPath = PackageDistInexcusable (FilePathTooLong path) longName = PackageDistInexcusable (FilePathNameTooLong path) @@ -153,24 +160,31 @@ checkTarPath path -- `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 + :: 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) + 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 @@ -211,94 +225,106 @@ checkGlob title pat = do -- -- >>> 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 + 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 + 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 + 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 + 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 + 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 + 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 +isGoodRelativeGlob = isGoodRelativeFilePath . map f + where f '*' = 'x' - f c = c + 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 + 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 + 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 + 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 + 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 + 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 + state5 [] = Nothing -- "." + state5 (c : cs) + | c == '.' = state3 cs + | c == '/' = state1 cs + | otherwise = state4 cs -- [Note: Good relative paths] -- @@ -384,4 +410,3 @@ isGoodRelativeDirectoryPath = state0 -- | x <= CSlash -> 1 -- | otherwise -> 4 -- @ - diff --git a/Cabal/src/Distribution/PackageDescription/Check/Target.hs b/Cabal/src/Distribution/PackageDescription/Check/Target.hs index aefe9d4b936..67865fa0020 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Target.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Target.hs @@ -1,4 +1,3 @@ ------------------------------------------------------------------------------ -- | -- Module : Distribution.PackageDescription.Check.Target -- Copyright : Lennart Kolmodin 2008, Francesco Ariis 2023 @@ -8,14 +7,13 @@ -- Portability : portable -- -- Fully-realised target (library, executable, …) checking functions. - -module Distribution.PackageDescription.Check.Target ( - checkLibrary, - checkForeignLib, - checkExecutable, - checkTestSuite, - checkBenchmark, - ) where +module Distribution.PackageDescription.Check.Target + ( checkLibrary + , checkForeignLib + , checkExecutable + , checkTestSuite + , checkBenchmark + ) where import Distribution.Compat.Prelude import Prelude () @@ -23,7 +21,6 @@ import Prelude () import Distribution.CabalSpecVersion import Distribution.Compat.Lens import Distribution.Compiler -import Language.Haskell.Extension import Distribution.ModuleName (ModuleName) import Distribution.Package import Distribution.PackageDescription @@ -31,198 +28,274 @@ import Distribution.PackageDescription.Check.Common import Distribution.PackageDescription.Check.Monad import Distribution.PackageDescription.Check.Paths import Distribution.Pretty (prettyShow) -import Distribution.Simple.BuildPaths (autogenPathsModuleName, - autogenPackageInfoModuleName) +import Distribution.Simple.BuildPaths + ( autogenPackageInfoModuleName + , autogenPathsModuleName + ) import Distribution.Simple.Utils hiding (findPackageDesc, notice) -import Distribution.Version 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) +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 + 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 => - PackageId -> - [AssocDep] -> -- “Inherited” dependencies for PVP checks. - Executable -> - CheckM m () -checkExecutable pid 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. - 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 +checkForeignLib + ( ForeignLib + foreignLibName_ + _foreignLibType_ + _foreignLibOptions_ + foreignLibBuildInfo_ + _foreignLibVersionInfo_ + _foreignLibVersionLinux_ + _foreignLibModDefFile_ + ) = do + checkBuildInfo + (CETForeignLibrary foreignLibName_) + [] + [] + foreignLibBuildInfo_ + +checkExecutable + :: Monad m + => PackageId + -> [AssocDep] -- “Inherited” dependencies for PVP checks. + -> Executable + -> CheckM m () +checkExecutable + pid + 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. + 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 - 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 + TestSuiteExeV10 _ f -> not (fileExtensionSupportedLanguage f) + _ -> False - -- 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_ + 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 + -- Cannot abstract with similar function in checkTestSuite, + -- they are different. + mainIsWrongExt = + case benchmarkInterface_ of + BenchmarkExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"] + _ -> False -- ------------------------------------------------------------ --- * Build info +-- Build info -- ------------------------------------------------------------ -- Check a great deal of things in buildInfo. @@ -233,289 +306,403 @@ checkBenchmark ads bm@(Benchmark -- 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 + :: 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 - 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") - (map getSymbolicPath $ hsSourceDirs bi) + -- 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 + 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") + (map 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_ checkDep (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) - - checkDep :: Monad m => Dependency -> CheckM m () - checkDep 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 (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 && -- internal - name `notElem`exns) -- not present - (PackageBuildImpossible $ MissingInternalExe [ed]) - when (name `elem` exns) - (checkP (not $ pVer `withinRange` vrange) - (PackageBuildImpossible $ ImpossibleInternalExe [ed])) + mapM_ checkLang (allLanguages bi) + mapM_ checkExt (allExtensions bi) + mapM_ checkDep (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) + + checkDep :: Monad m => Dependency -> CheckM m () + checkDep 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 + (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) - (map 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 () + 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) + (map 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 + :: 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) + -- 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] + 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 + :: 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 () + 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) + checkPkg + ( \ops -> do + dn <- not <$> doesDirectoryExist ops dir + let rp = not (isAbsoluteOnAnyPlatform dir) + return (rp && dn) + ) + (PackageBuildWarning $ UnknownDirectory title dir) -- PVP -- @@ -528,238 +715,320 @@ checkLocalPathExist title dir = -- 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 +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 -- ------------------------------------------------------------ --- * Options +-- Options -- ------------------------------------------------------------ -- Target type for option checking. data BITarget = BITLib | BITTestBench | BITOther - deriving (Eq, Show) + deriving (Eq, Show) cet2bit :: CEType -> BITarget -cet2bit (CETLibrary {}) = BITLib -cet2bit (CETForeignLibrary {}) = BITLib -cet2bit (CETExecutable {}) = BITOther -cet2bit (CETTest {}) = BITTestBench -cet2bit (CETBenchmark {}) = BITTestBench +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) + 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 + :: 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 ["-fvia-C"] - (PackageDistSuspicious $ OptViaC title) - checkFlags ["-fhpc"] - (PackageDistInexcusable $ OptHpc title) - checkFlags ["-prof"] - (PackageBuildWarning $ OptProf title) - 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 () + 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 + ["-fvia-C"] + (PackageDistSuspicious $ OptViaC title) + checkFlags + ["-fhpc"] + (PackageDistInexcusable $ OptHpc title) + checkFlags + ["-prof"] + (PackageBuildWarning $ OptProf title) + 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 + 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 () + 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 - + 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 index ec2f175799c..c56c6b4329e 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs @@ -1,8 +1,7 @@ -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------ -- | -- Module : Distribution.PackageDescription.Check.Warning -- Copyright : Francesco Ariis 2022 @@ -12,20 +11,19 @@ -- Portability : portable -- -- Warning types, messages, severity and associated functions. - module Distribution.PackageDescription.Check.Warning - ( -- * Types and constructors - PackageCheck(..), - CheckExplanation(..), - CEField(..), - CEType(..), - WarnLang(..), + ( -- * Types and constructors + PackageCheck (..) + , CheckExplanation (..) + , CEField (..) + , CEType (..) + , WarnLang (..) - -- * Operations - ppPackageCheck, - isHackageDistError, - extractCheckExplantion - ) where + -- * Operations + , ppPackageCheck + , isHackageDistError + , extractCheckExplantion + ) where import Distribution.Compat.Prelude import Prelude () @@ -36,24 +34,27 @@ 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.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.LibraryName (LibraryName(..), showLibraryName) import Distribution.Types.TestType (TestType, knownTestTypes) import Distribution.Types.UnqualComponentName import Distribution.Types.Version (Version) -import Distribution.Utils.Path (LicenseFile, PackageDir, SymbolicPath, - getSymbolicPath) +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 +-- Check types and explanations -- ------------------------------------------------------------ -- | Results of some kind of failed package check. @@ -62,204 +63,198 @@ import qualified Data.Set as Set -- 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 } +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 + 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 + (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 - | 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 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. +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 + | 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 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 @@ -270,38 +265,38 @@ 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) +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 + 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) +data CEField + = CEFCategory + | CEFMaintainer + | CEFSynopsis + | CEFDescription + | CEFSynOrDesc + deriving (Eq, Ord, Show) -- | Pretty printing `CEField`. --- ppCEField :: CEField -> String ppCEField CEFCategory = "category" ppCEField CEFMaintainer = "maintainer" @@ -310,490 +305,607 @@ 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) + 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." + "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." + "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." + "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'." + "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" + 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'." + "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' or 'other-modules'." + "An 'autogen-module' is neither on 'exposed-modules' or 'other-modules'." ppExplanation AutogenIncludesNotIncluded = - "An include in 'autogen-includes' is neither in 'includes' or " - ++ "'install-includes'." + "An include in 'autogen-includes' is neither in 'includes' or " + ++ "'install-includes'." ppExplanation (NoMainIs eName) = - "No 'main-is' field found for executable " ++ prettyShow 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." + "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." + "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'" + "On " + ++ ppCET ct + ++ " an 'autogen-module'" + ++ " is not on 'other-modules'" ppExplanation AutogenIncludesNotIncludedExe = - "An include in 'autogen-includes' is not in 'includes'." + "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) + 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) + 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) + 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) + 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)." + "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." + "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." + "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'." + "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." + "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." + "Unknown compiler " + ++ commaSep (map quote unknownCompilers) + ++ " in 'tested-with' field." ppExplanation (UnknownLanguages unknownLanguages) = - "Unknown languages: " ++ commaSep unknownLanguages + "Unknown languages: " ++ commaSep unknownLanguages ppExplanation (UnknownExtensions unknownExtensions) = - "Unknown extensions: " ++ commaSep 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." + "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 ] + "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." + "No '" ++ ppCEField cef ++ "' field." ppExplanation SynopsisTooLong = - "The 'synopsis' field is rather long (max 80 chars is recommended)." + "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." + "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'." + "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." + "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." + "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) + "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?" + "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'." + "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) + 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." + "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." + "'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'" + 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." + "The source-repository 'type' is a required field." ppExplanation MissingLocation = - "The source-repository 'location' is a required field." + "The source-repository 'location' is a required field." ppExplanation MissingModule = - "For a CVS source-repository, the 'module' is a required field." + "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." + "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." + "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 + "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." + "'" + ++ 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." + "'" + ++ 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." + "'" + ++ 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." + "'" + ++ 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." + "'" + ++ fieldName + ++ ": -o' is not needed. " + ++ "The output files are named automatically." ppExplanation (OptHide fieldName) = - "'" ++ fieldName ++ ": -hide-package' is never needed. " - ++ "Cabal hides all packages." + "'" + ++ fieldName + ++ ": -hide-package' is never needed. " + ++ "Cabal hides all packages." ppExplanation (OptMake fieldName) = - "'" ++ fieldName - ++ ": --make' is never needed. Cabal uses this automatically." + "'" + ++ fieldName + ++ ": --make' is never needed. Cabal uses this automatically." ppExplanation (OptONot fieldName) = - "'" ++ fieldName ++ ": -O0' is not needed. " - ++ "Use the --disable-optimization configure flag." + "'" + ++ 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." + "'" + ++ 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." + "'" + ++ 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." + "'" + ++ 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." + "'" + ++ 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." + "'" + ++ 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." + "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." + "'" + ++ 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." + "'" + ++ 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." + "'" + ++ 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." + "'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 + "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'." + 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." + 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 + 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 + 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 + "In the '" ++ field ++ "' field: " ++ expl ppExplanation (RecursiveGlobInRoot field glob) = - "In the '" ++ field ++ "': glob '" ++ 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" + "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 + "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 + "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 + "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." + "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." + "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'." + "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." + "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." + "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'." + "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." + "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'." + "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." + "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'." + "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." + "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'." + "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) + "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'." + "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'." + "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." + "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'." + "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'." + "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." + "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." + "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." + "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." + "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." + "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) + "Unknown operating system name " ++ commaSep (map quote unknownOSs) ppExplanation (UnknownArch unknownArches) = - "Unknown architecture name " ++ commaSep (map quote unknownArches) + "Unknown architecture name " ++ commaSep (map quote unknownArches) ppExplanation (UnknownCompiler unknownImpls) = - "Unknown compiler name " ++ commaSep (map quote 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'." + "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. More informations at https://pvp.haskell.org/" + let separator = "\n - " + in "On " + ++ ppCET ct + ++ ", " + ++ "these packages miss upper bounds:" + ++ separator + ++ List.intercalate separator names + ++ "\n" + ++ "Please add them. More informations at https://pvp.haskell.org/" 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." + "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 + "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." + "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'." + "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 " + "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," +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 " +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 " +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 " +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 " @@ -801,65 +913,93 @@ ppExplanation (ProfilingUnneeded fieldName) = addConditionalExp $ ++ "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." + "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) + "Duplicate modules in " + ++ s + ++ ": " + ++ commaSep (map prettyShow dupLibsLax) ppExplanation (PotentialDupModule s dupLibsStrict) = - "Potential duplicate modules (subject to conditionals) in " ++ s - ++ ": " ++ commaSep (map prettyShow 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." + 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 ++ ")" + "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" + "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 + "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." + "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." + "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." + "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." + 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." + "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" + "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" + "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 @@ -870,8 +1010,8 @@ 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." - +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 25bbf960ed6..01592a0970e 100644 --- a/Cabal/src/Distribution/Simple/BuildToolDepends.hs +++ b/Cabal/src/Distribution/Simple/BuildToolDepends.hs @@ -15,20 +15,29 @@ import Distribution.PackageDescription -- | Same as 'desugarBuildTool', but requires atomic informations (package -- name, executable names) instead of a whole 'PackageDescription'. -desugarBuildToolSimple :: PackageName - -> [UnqualComponentName] - -> LegacyExeDependency - -> Maybe ExeDependency +desugarBuildToolSimple + :: PackageName + -> [UnqualComponentName] + -> LegacyExeDependency + -> Maybe ExeDependency desugarBuildToolSimple pname exeNames (LegacyExeDependency name reqVer) - | foundLocal = Just $ ExeDependency pname toolName reqVer - | otherwise = Map.lookup name allowMap + | 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 -> + 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 @@ -48,10 +57,11 @@ desugarBuildTool :: PackageDescription -> LegacyExeDependency -> Maybe ExeDependency -desugarBuildTool pkg led = desugarBuildToolSimple - (packageName pkg) - (map exeName $ executables pkg) - led +desugarBuildTool pkg led = + 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. From 148d8dd2044a4d70b0a738056888f7237de05138 Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Thu, 1 Jun 2023 17:27:13 +0200 Subject: [PATCH 11/18] Do not check for OptO in scripts See #8963 for reason and clarification requests. --- .../Distribution/PackageDescription/Check/Target.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/Cabal/src/Distribution/PackageDescription/Check/Target.hs b/Cabal/src/Distribution/PackageDescription/Check/Target.hs index 67865fa0020..9884a1ce724 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Target.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Target.hs @@ -796,9 +796,13 @@ checkGHCOptions title t opts = do checkFlags ["-prof"] (PackageBuildWarning $ OptProf title) - checkFlags - ["-o"] - (PackageBuildWarning $ OptO 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) From 87ca48226a7eeed9b58060ebcea88f1a4178f924 Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Thu, 1 Jun 2023 17:31:02 +0200 Subject: [PATCH 12/18] Remove useless PackageId parameter It is now in the Reader part of CheckM monad. --- Cabal/src/Distribution/PackageDescription/Check.hs | 2 +- Cabal/src/Distribution/PackageDescription/Check/Target.hs | 5 ++--- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index e31969ca891..69f7003a9a8 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -309,7 +309,7 @@ checkGenericPackageDescription mapM_ ( checkCondTarget genPackageFlags_ - (checkExecutable (package packageDescription_) ads) + (checkExecutable ads) (const id) ) condExecutables_ diff --git a/Cabal/src/Distribution/PackageDescription/Check/Target.hs b/Cabal/src/Distribution/PackageDescription/Check/Target.hs index 9884a1ce724..135bc5c6e20 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Target.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Target.hs @@ -129,12 +129,10 @@ checkForeignLib checkExecutable :: Monad m - => PackageId - -> [AssocDep] -- “Inherited” dependencies for PVP checks. + => [AssocDep] -- “Inherited” dependencies for PVP checks. -> Executable -> CheckM m () checkExecutable - pid ads exe@( Executable exeName_ @@ -150,6 +148,7 @@ checkExecutable (null modulePath_) (PackageBuildImpossible (NoMainIs exeName_)) -- This check does not apply to scripts. + pid <- asksCM (pnPackageId . ccNames) checkP ( pid /= fakePackageId && not (null modulePath_) From 32377669dbdfb7c3649ec3f9a6c86e7c9281cdff Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Tue, 6 Jun 2023 10:58:24 +0200 Subject: [PATCH 13/18] Do not check PVP on internal targets Internal: testsuite, benchmark. See #8361. --- .../PackageDescription/Check/Target.hs | 14 +++++++++++++- doc/cabal-commands.rst | 2 +- 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/Cabal/src/Distribution/PackageDescription/Check/Target.hs b/Cabal/src/Distribution/PackageDescription/Check/Target.hs index 135bc5c6e20..4d24f190710 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Target.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Target.hs @@ -338,7 +338,9 @@ checkBuildInfo cet ams ads bi = do let ick = const (PackageDistInexcusable BaseNoUpperBounds) rck = PackageDistSuspiciousWarn . MissingUpperBounds cet checkPVP ick ids - checkPVPs rck rds + unless + (isInternalTarget cet) + (checkPVPs rck rds) -- Custom fields well-formedness (ASCII). mapM_ checkCustomField (customFieldsBI bi) @@ -728,6 +730,16 @@ mergeDependencies l@(d : _) = 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 -- ------------------------------------------------------------ diff --git a/doc/cabal-commands.rst b/doc/cabal-commands.rst index c11461ef82c..1ae0d9934d6 100644 --- a/doc/cabal-commands.rst +++ b/doc/cabal-commands.rst @@ -1258,7 +1258,7 @@ A list of all warnings with their constructor: - 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. +- 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. From 822ada53926d0620376ba0352a71f0dd6b748b8b Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Fri, 14 Jul 2023 19:31:24 +0200 Subject: [PATCH 14/18] Make hlint happy --- Cabal/src/Distribution/PackageDescription/Check/Target.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Cabal/src/Distribution/PackageDescription/Check/Target.hs b/Cabal/src/Distribution/PackageDescription/Check/Target.hs index 4d24f190710..9505dc4d57d 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Target.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Target.hs @@ -355,8 +355,8 @@ checkBuildInfo cet ams ads bi = do (extraFrameworkDirs bi) mapM_ (checkLocalPathExist "include-dirs") (includeDirs bi) mapM_ - (checkLocalPathExist "hs-source-dirs") - (map getSymbolicPath $ hsSourceDirs bi) + (checkLocalPathExist "hs-source-dirs" . getSymbolicPath) + (hsSourceDirs bi) -- Well formedness of BI contents (no `Haskell2015`, no deprecated -- extensions etc). @@ -436,8 +436,8 @@ checkBuildInfoPathsWellFormedness bi = do (checkPath False "install-includes" PathKindFile) (installIncludes bi) mapM_ - (checkPath False "hs-source-dirs" PathKindDirectory) - (map getSymbolicPath $ hsSourceDirs bi) + (checkPath False "hs-source-dirs" PathKindDirectory . getSymbolicPath) + (hsSourceDirs bi) -- Possibly absolute paths. mapM_ (checkPath True "includes" PathKindFile) (includes bi) mapM_ From e0cbccc318654b839fc5e556d934e38fcdc45243 Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Tue, 25 Jul 2023 09:23:36 +0200 Subject: [PATCH 15/18] Fix #9122 When checking internal version ranges, we need to make sure we are not mistaking a libraries with the same name but from different packages. See #9132. --- .../Distribution/PackageDescription/Check/Target.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/Cabal/src/Distribution/PackageDescription/Check/Target.hs b/Cabal/src/Distribution/PackageDescription/Check/Target.hs index 9505dc4d57d..f3cb7d3d8c1 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Target.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Target.hs @@ -364,7 +364,7 @@ checkBuildInfoPathsContent :: Monad m => BuildInfo -> CheckM m () checkBuildInfoPathsContent bi = do mapM_ checkLang (allLanguages bi) mapM_ checkExt (allExtensions bi) - mapM_ checkDep (targetBuildDepends 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) @@ -387,8 +387,8 @@ checkBuildInfoPathsContent bi = do (not . null $ dss) (PackageDistSuspicious $ DeprecatedExtensions dss) - checkDep :: Monad m => Dependency -> CheckM m () - checkDep d@(Dependency name vrange _) = do + checkIntDep :: Monad m => Dependency -> CheckM m () + checkIntDep d@(Dependency name vrange _) = do mpn <- asksCM ( packageNameToUnqualComponentName @@ -400,7 +400,11 @@ checkBuildInfoPathsContent bi = do pVer <- asksCM (pkgVersion . pnPackageId . ccNames) let allLibNs = mpn : lns when - (packageNameToUnqualComponentName name `elem` allLibNs) + ( 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]) From d52f1e9c8f2c3bfb6b5790b69bb057b6dc347815 Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Thu, 24 Aug 2023 20:59:33 +0200 Subject: [PATCH 16/18] Fix grammar MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit neither…nor, completing what done in #9162 --- Cabal/src/Distribution/PackageDescription/Check/Warning.hs | 4 ++-- .../Check/ConfiguredPackage/Sanity/AutogenIncludes/cabal.out | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs index c56c6b4329e..fad3c6a172c 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs @@ -343,9 +343,9 @@ 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' or 'other-modules'." + "An 'autogen-module' is neither on 'exposed-modules' nor 'other-modules'." ppExplanation AutogenIncludesNotIncluded = - "An include in 'autogen-includes' is neither in 'includes' or " + "An include in 'autogen-includes' is neither in 'includes' nor " ++ "'install-includes'." ppExplanation (NoMainIs eName) = "No 'main-is' field found for executable " ++ prettyShow eName 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. From a051dd672fd951eb7a12f7a20b23e6ee8d331181 Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Thu, 9 Nov 2023 22:36:50 +0100 Subject: [PATCH 17/18] =?UTF-8?q?Integrate=20Brandon=E2=80=99s=20review:?= =?UTF-8?q?=20grammar?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../ParserTests/regressions/all-upper-bound.check | 2 +- .../tests/ParserTests/regressions/ghc-option-j.check | 4 ++-- .../ParserTests/regressions/nothing-unicode.check | 2 +- Cabal/src/Distribution/PackageDescription/Check.hs | 2 +- .../PackageDescription/Check/Conditional.hs | 2 +- .../Distribution/PackageDescription/Check/Warning.hs | 12 ++++++------ .../ConfiguredPackage/Paths/DistPoint/cabal.out | 2 +- .../NonConfCheck/DevOnlyFlags/ElseCheck/cabal.out | 2 +- .../Check/NonConfCheck/DevOnlyFlags/Jn/cabal.out | 2 +- .../PackageVersionsInternalSimple/cabal.out | 2 +- .../NonConfCheck/PackageVersionsLibInt/cabal.out | 2 +- .../Check/PackageFiles/VCSInfo/cabal.out | 2 +- 12 files changed, 18 insertions(+), 18 deletions(-) diff --git a/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.check b/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.check index 7e2cfb4a499..ad65af510aa 100644 --- a/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.check +++ b/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.check @@ -3,4 +3,4 @@ On library, these packages miss upper bounds: - alphalib - betalib - deltalib -Please add them. More informations at https://pvp.haskell.org/ +Please add them. There is more information at https://pvp.haskell.org/ 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/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/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index 69f7003a9a8..fb3c05a64b6 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -832,7 +832,7 @@ checkGlobFile cv ddir title fp = do rs <- runDirFileGlobM po dir parsedGlob return $ checkGlobResult title fp rs --- | Checks for matchless globs and too strict mathching (<2.4 spec). +-- | 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 diff --git a/Cabal/src/Distribution/PackageDescription/Check/Conditional.hs b/Cabal/src/Distribution/PackageDescription/Check/Conditional.hs index 49356575f7f..2d4963e434a 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Conditional.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Conditional.hs @@ -8,7 +8,7 @@ -- Maintainer : cabal-devel@haskell.org -- Portability : portable -- --- Checks on conditional targes (libraries, executables, etc. that are +-- 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 diff --git a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs index fad3c6a172c..db1e8af7565 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs @@ -396,7 +396,7 @@ ppExplanation (InvalidNameWin pkg) = ++ prettyShow pkg ++ "' is " ++ "invalid on Windows. Many tools need to convert package names to " - ++ "file names so using this name would cause problems." + ++ "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." @@ -637,7 +637,7 @@ ppExplanation (DistPoint mfield path) = ++ " 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 " + ++ "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` @@ -841,12 +841,12 @@ ppExplanation (MissingUpperBounds ct names) = ++ separator ++ List.intercalate separator names ++ "\n" - ++ "Please add them. More informations at https://pvp.haskell.org/" + ++ "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, flag shouldn't " + ++ "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) = @@ -887,7 +887,7 @@ ppExplanation (JUnneeded fieldName) = addConditionalExp $ "'" ++ fieldName - ++ ": -j[N]' can make sense for specific user's setup," + ++ ": -j[N]' can make sense for a particular user's setup," ++ " but it is not appropriate for a distributed package." ppExplanation (FDeferTypeErrorsUnneeded fieldName) = addConditionalExp $ @@ -966,7 +966,7 @@ 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 " + "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/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/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.out index 405f3087efb..a5ef963c71f 100644 --- a/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.out +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/DevOnlyFlags/ElseCheck/cabal.out @@ -1,4 +1,4 @@ # cabal check The following errors will cause portability problems on other environments: -Error: '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. +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/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/PackageVersionsInternalSimple/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.out index f62b27ad803..ff21f73f613 100644 --- a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.out +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.out @@ -2,4 +2,4 @@ These warnings may cause trouble when distributing the package: Warning: On executable 'prova', these packages miss upper bounds: - acme-box -Please add them. More informations at https://pvp.haskell.org/ +Please add them. There is more information at https://pvp.haskell.org/ diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.out index cb35fe0b644..e0821ac6ea5 100644 --- a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.out +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.out @@ -2,4 +2,4 @@ These warnings may cause trouble when distributing the package: Warning: On library 'int-lib', these packages miss upper bounds: - text -Please add them. More informations at https://pvp.haskell.org/ +Please add them. There is more information at https://pvp.haskell.org/ 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. From d4e43fc7d0b744b090d32e02f21fde00a400ddd7 Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Thu, 9 Nov 2023 23:20:37 +0100 Subject: [PATCH 18/18] Remove unnecessary `-fvia-C` check MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Brandon’s review/II. --- Cabal/src/Distribution/PackageDescription/Check/Target.hs | 3 --- .../src/Distribution/PackageDescription/Check/Warning.hs | 8 -------- 2 files changed, 11 deletions(-) diff --git a/Cabal/src/Distribution/PackageDescription/Check/Target.hs b/Cabal/src/Distribution/PackageDescription/Check/Target.hs index f3cb7d3d8c1..99ae5a8d379 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Target.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Target.hs @@ -802,9 +802,6 @@ checkGHCOptions title t opts = do checkFlags ["-fasm"] (PackageDistInexcusable $ OptFasm title) - checkFlags - ["-fvia-C"] - (PackageDistSuspicious $ OptViaC title) checkFlags ["-fhpc"] (PackageDistInexcusable $ OptHpc title) diff --git a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs index db1e8af7565..a8d9ac78195 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs @@ -164,7 +164,6 @@ data CheckExplanation | SubdirRelPath | SubdirGoodRelPath String | OptFasm String - | OptViaC String | OptHpc String | OptProf String | OptO String @@ -520,13 +519,6 @@ 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