From 9612a4836befca64861be78c7ebe0cc4fe30df42 Mon Sep 17 00:00:00 2001 From: Javier Sagredo <javier.sagredo@iohk.io> Date: Sat, 2 Dec 2023 23:38:51 +0100 Subject: [PATCH] Extend cabal check for defaultPackageBounds --- .../Distribution/PackageDescription/Check.hs | 16 ++++++++++++++-- .../PackageDescription/Check/Common.hs | 18 +++++++++++------- .../PackageDescription/Check/Target.hs | 4 ++++ .../PackageDescription/Check/Warning.hs | 2 ++ 4 files changed, 31 insertions(+), 9 deletions(-) diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index 1d65cd76f11..87bb9a55927 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -283,6 +283,7 @@ checkGenericPackageDescription let ads = maybe [] ((: []) . extractAssocDeps pName) condLibrary_ ++ map (uncurry extractAssocDeps) condSubLibraries_ + ++ [Left (defaultPackageBounds packageDescription_)] case condLibrary_ of Just cl -> @@ -395,7 +396,7 @@ checkPackageDescription extraSrcFiles_ extraTmpFiles_ extraDocFiles_ - _packageConstraints + defaultPackageBounds_ ) = do -- § Sanity checks. checkPackageId package_ @@ -506,6 +507,17 @@ checkPackageDescription mapM_ (checkGlobFile specVersion_ "." "extra-source-files") extraSrcFiles_ mapM_ (checkGlobFile specVersion_ "." "extra-doc-files") extraDocFiles_ mapM_ (checkGlobFile specVersion_ dataDir_ "data-files") dataFiles_ + + -- PVP: we check for base and all other deps. + (ids, rds) <- + partitionDeps + [] + [mkUnqualComponentName "base"] + (mergeDependencies defaultPackageBounds_) + let ick = const (PackageDistInexcusable BaseNoUpperBounds) + rck = PackageDistSuspiciousWarn . MissingUpperBounds CETDefaultPackageBounds + checkPVP ick ids + checkPVPs rck rds where checkNull :: Monad m @@ -898,7 +910,7 @@ extractAssocDeps n ct = in -- Merging is fine here, remember the specific -- library dependencies will be checked branch -- by branch. - (n, snd a) + Right (n, snd a) -- | August 2022: this function is an oddity due to the historical -- GenericPackageDescription/PackageDescription split (check diff --git a/Cabal/src/Distribution/PackageDescription/Check/Common.hs b/Cabal/src/Distribution/PackageDescription/Check/Common.hs index 4c528831430..94c5e0643c4 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Common.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Common.hs @@ -52,9 +52,9 @@ checkCustomField (n, _) = -- PVP types/functions -- ------------------------------------------------------------ --- A library name / dependencies association list. Ultimately to be --- fed to PVP check. -type AssocDep = (UnqualComponentName, [Dependency]) +-- Either a list of dependencies coming from @package-constraints@ or a library +-- name / dependencies association list. Ultimately to be fed to PVP check. +type AssocDep = Either [Dependency] (UnqualComponentName, [Dependency]) -- Convenience function to partition important dependencies by name. To -- be used together with checkPVP. Important: usually “base” or “Cabal”, @@ -67,7 +67,7 @@ type AssocDep = (UnqualComponentName, [Dependency]) partitionDeps :: Monad m => [AssocDep] -- Possibly inherited dependencies, i.e. - -- dependencies from internal/main libs. + -- dependencies from internal/main libs, and from @package-constraints@. -> [UnqualComponentName] -- List of package names ("base", "Cabal"…) -> [Dependency] -- Dependencies to check. -> CheckM m ([Dependency], [Dependency]) @@ -77,11 +77,11 @@ partitionDeps ads ns ds = do -- names of our dependencies dqs = map unqualName ds -- shared targets that match - fads = filter (flip elem dqs . fst) ads + fads = filter (either (const True) (flip elem dqs . fst)) ads -- the names of such targets - inNam = nub $ map fst fads :: [UnqualComponentName] + inNam = nub $ mapMaybe (either (const Nothing) (Just . fst)) fads :: [UnqualComponentName] -- the dependencies of such targets - inDep = concatMap snd fads :: [Dependency] + inDep = concatMap (either id snd) fads :: [Dependency] -- We exclude from checks: -- 1. dependencies which are shared with main library / a @@ -89,11 +89,15 @@ partitionDeps ads ns ds = do -- 2. the names of main library / sub libraries themselves. -- -- So in myPackage.cabal + -- + -- package-constraints: bar < 100 + -- -- library -- build-depends: text < 5 -- ⁝ -- build-depends: myPackage, ← no warning, internal -- text, ← no warning, inherited + -- bar, ← no warning, inherited -- monadacme ← warning! let fFun d = notElem (unqualName d) inNam diff --git a/Cabal/src/Distribution/PackageDescription/Check/Target.hs b/Cabal/src/Distribution/PackageDescription/Check/Target.hs index e6cfba74928..a5b26909035 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Target.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Target.hs @@ -13,6 +13,8 @@ module Distribution.PackageDescription.Check.Target , checkExecutable , checkTestSuite , checkBenchmark + -- Utils + , mergeDependencies ) where import Distribution.Compat.Prelude @@ -753,6 +755,7 @@ isInternalTarget (CETExecutable{}) = False isInternalTarget (CETTest{}) = True isInternalTarget (CETBenchmark{}) = True isInternalTarget (CETSetup{}) = False +isInternalTarget (CETDefaultPackageBounds{}) = True -- ------------------------------------------------------------ -- Options @@ -769,6 +772,7 @@ cet2bit (CETExecutable{}) = BITOther cet2bit (CETTest{}) = BITTestBench cet2bit (CETBenchmark{}) = BITTestBench cet2bit CETSetup = BITOther +cet2bit CETDefaultPackageBounds = BITOther -- General check on all options (ghc, C, C++, …) for common inaccuracies. checkBuildInfoOptions :: Monad m => BITarget -> BuildInfo -> CheckM m () diff --git a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs index 52cb5e289f5..918c6809a70 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs @@ -272,6 +272,7 @@ data CEType | CETTest UnqualComponentName | CETBenchmark UnqualComponentName | CETSetup + | CETDefaultPackageBounds deriving (Eq, Ord, Show) -- | Pretty printing `CEType`. @@ -283,6 +284,7 @@ ppCET cet = case cet of CETTest n -> "test suite" ++ qn n CETBenchmark n -> "benchmark" ++ qn n CETSetup -> "custom-setup" + CETDefaultPackageBounds -> "defaultPackageBounds" where qn :: UnqualComponentName -> String qn wn = (" " ++) . quote . prettyShow $ wn