Extend cabal check for defaultPackageBounds

haskell · Dec 27, 2023 · 9612a48 · 9612a48
1 parent 5ef1e11
commit 9612a48
Show file tree

Hide file tree

Showing 4 changed files with 31 additions and 9 deletions.
diff --git 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
@@ -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,23 +77,27 @@ 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
   --    sublibrary; and of course
   -- 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
@@ -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
@@ -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