From c2aaf71658567dc1c67e3a0012303f5b20e46df5 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Wed, 26 Jun 2024 17:14:31 +0200 Subject: [PATCH] Use default-package-bounds in check and cabal-install --- .../Distribution/PackageDescription/Check.hs | 27 ++++++++++++++++++- .../PackageDescription/Check/Common.hs | 17 ++++++++---- .../PackageDescription/Check/Target.hs | 5 ++++ .../PackageDescription/Check/Warning.hs | 13 +++++++++ .../src/Distribution/Client/Dependency.hs | 5 ++-- .../src/Distribution/Client/IndexUtils.hs | 1 + cabal-install/tests/IntegrationTests2.hs | 1 + .../Distribution/Solver/Modular/DSL.hs | 1 + 8 files changed, 62 insertions(+), 8 deletions(-) diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index ef97b0d23be..c6aeceed141 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -226,6 +226,7 @@ checkGenericPackageDescription packageDescription_ _gpdScannedVersion_ genPackageFlags_ + genDefaultPackageBounds_ condLibrary_ condSubLibraries_ condForeignLibs_ @@ -272,6 +273,8 @@ checkGenericPackageDescription checkPackageDescription packageDescription_ -- Flag names. mapM_ checkFlagName genPackageFlags_ + -- default package bounds + mapM_ checkDefaultBounds genDefaultPackageBounds_ -- § Feature checks. checkSpecVer @@ -294,9 +297,11 @@ checkGenericPackageDescription . pnPackageId . ccNames ) + let ads = maybe [] ((: []) . extractAssocDeps pName) condLibrary_ ++ map (uncurry extractAssocDeps) condSubLibraries_ + ++ maybe [] ((: []) . Left . defaultTargetBuildDepends) genDefaultPackageBounds_ case condLibrary_ of Just cl -> @@ -362,6 +367,26 @@ checkGenericPackageDescription (invalidFlagName fn) (PackageDistInexcusable $ SuspiciousFlagName [fn]) + checkDefaultBounds :: Monad m => DefaultBounds -> CheckM m () + checkDefaultBounds (DefaultBounds db dbt) = + let noBound = isAnyVersion . depVerRange + noExeBound = isAnyVersion . exeDepVerRange + in do + mapM_ + ( \b -> + checkP + (noBound b) + (PackageDistInexcusable $ DefaultBoundsNoBound [unPackageName $ depPkgName b]) + ) + db + mapM_ + ( \b -> + checkP + (noExeBound b) + (PackageDistInexcusable $ DefaultBoundsNoBound [unPackageName $ exeDepPkgName b]) + ) + dbt + decFlags :: Set.Set FlagName decFlags = toSetOf (L.genPackageFlags . traverse . L.flagName) gpd @@ -916,7 +941,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..bbe0b24c961 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Common.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Common.hs @@ -54,7 +54,7 @@ checkCustomField (n, _) = -- A library name / dependencies association list. Ultimately to be -- fed to PVP check. -type AssocDep = (UnqualComponentName, [Dependency]) +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 -> [UnqualComponentName] -- List of package names ("base", "Cabal"…) -> [Dependency] -- Dependencies to check. -> CheckM m ([Dependency], [Dependency]) @@ -77,11 +77,17 @@ 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 + ( \ad -> case ad of + Left{} -> True + Right (x, _) -> elem x dqs + ) + 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,6 +95,7 @@ partitionDeps ads ns ds = do -- 2. the names of main library / sub libraries themselves. -- -- So in myPackage.cabal + -- -- library -- build-depends: text < 5 -- ⁝ diff --git a/Cabal/src/Distribution/PackageDescription/Check/Target.hs b/Cabal/src/Distribution/PackageDescription/Check/Target.hs index c40fc0ef09a..2ac4b9c30ca 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 @@ -336,6 +338,7 @@ checkBuildInfo cet ams ads bi = do ads [mkUnqualComponentName "base"] (mergeDependencies $ targetBuildDepends bi) + let ick = const (PackageDistInexcusable BaseNoUpperBounds) rck = PackageDistSuspiciousWarn . MissingUpperBounds cet checkPVP ick ids @@ -760,6 +763,7 @@ isInternalTarget (CETExecutable{}) = False isInternalTarget (CETTest{}) = True isInternalTarget (CETBenchmark{}) = True isInternalTarget (CETSetup{}) = False +isInternalTarget (CETDefaultPackageBounds{}) = True -- ------------------------------------------------------------ -- Options @@ -776,6 +780,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 859b3f12c50..c609bee7faf 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs @@ -255,6 +255,7 @@ data CheckExplanation | UnknownCompiler [String] | BaseNoUpperBounds | MissingUpperBounds CEType [String] + | DefaultBoundsNoBound [String] | SuspiciousFlagName [String] | DeclaredUsedFlags (Set.Set FlagName) (Set.Set FlagName) | NonASCIICustomField [String] @@ -417,6 +418,7 @@ data CheckExplanationID | CIUnknownCompiler | CIBaseNoUpperBounds | CIMissingUpperBounds + | CIDefaultBoundsNoBound | CISuspiciousFlagName | CIDeclaredUsedFlags | CINonASCIICustomField @@ -558,6 +560,7 @@ checkExplanationId (UnknownArch{}) = CIUnknownArch checkExplanationId (UnknownCompiler{}) = CIUnknownCompiler checkExplanationId (BaseNoUpperBounds{}) = CIBaseNoUpperBounds checkExplanationId (MissingUpperBounds{}) = CIMissingUpperBounds +checkExplanationId (DefaultBoundsNoBound{}) = CIDefaultBoundsNoBound checkExplanationId (SuspiciousFlagName{}) = CISuspiciousFlagName checkExplanationId (DeclaredUsedFlags{}) = CIDeclaredUsedFlags checkExplanationId (NonASCIICustomField{}) = CINonASCIICustomField @@ -704,6 +707,7 @@ ppCheckExplanationId CIUnknownArch = "unknown-arch" ppCheckExplanationId CIUnknownCompiler = "unknown-compiler" ppCheckExplanationId CIBaseNoUpperBounds = "missing-bounds-important" ppCheckExplanationId CIMissingUpperBounds = "missing-upper-bounds" +ppCheckExplanationId CIDefaultBoundsNoBound = "default-bounds-no-bound" ppCheckExplanationId CISuspiciousFlagName = "suspicious-flag" ppCheckExplanationId CIDeclaredUsedFlags = "unused-flag" ppCheckExplanationId CINonASCIICustomField = "non-ascii" @@ -746,6 +750,7 @@ data CEType | CETTest UnqualComponentName | CETBenchmark UnqualComponentName | CETSetup + | CETDefaultPackageBounds deriving (Eq, Ord, Show) -- | Pretty printing `CEType`. @@ -757,6 +762,7 @@ ppCET cet = case cet of CETTest n -> "test suite" ++ qn n CETBenchmark n -> "benchmark" ++ qn n CETSetup -> "custom-setup" + CETDefaultPackageBounds -> "default package bounds" where qn :: UnqualComponentName -> String qn wn = (" " ++) . quote . prettyShow $ wn @@ -1302,6 +1308,13 @@ ppExplanation (MissingUpperBounds ct names) = ++ List.intercalate separator names ++ "\n" ++ "Please add them. There is more information at https://pvp.haskell.org/" +ppExplanation (DefaultBoundsNoBound names) = + let separator = "\n - " + in "These default-package-bounds declarations are missing bounds:" + ++ separator + ++ List.intercalate separator names + ++ "\n" + ++ "It doesn't make sense to have empty bounds on default-package-bounds. Please add them." ppExplanation (SuspiciousFlagName invalidFlagNames) = "Suspicious flag names: " ++ unwords invalidFlagNames diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs index 2949b4d21d1..2812b8f82cb 100644 --- a/cabal-install/src/Distribution/Client/Dependency.hs +++ b/cabal-install/src/Distribution/Client/Dependency.hs @@ -554,13 +554,14 @@ relaxPackageDeps -> PD.GenericPackageDescription -> PD.GenericPackageDescription relaxPackageDeps _ rd gpd | not (isRelaxDeps rd) = gpd -- subsumed by no-op case in 'removeBounds' -relaxPackageDeps relKind RelaxDepsAll gpd = PD.transformAllBuildDepends relaxAll gpd +relaxPackageDeps relKind RelaxDepsAll gpd = + PD.transformDefaultBuildDepends relaxAll $ PD.transformAllBuildDepends relaxAll gpd where relaxAll :: Dependency -> Dependency relaxAll (Dependency pkgName verRange cs) = Dependency pkgName (removeBound relKind RelaxDepModNone verRange) cs relaxPackageDeps relKind (RelaxDepsSome depsToRelax0) gpd = - PD.transformAllBuildDepends relaxSome gpd + PD.transformDefaultBuildDepends relaxSome $ PD.transformAllBuildDepends relaxSome gpd where thisPkgName = packageName gpd thisPkgId = packageId gpd diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index 5958deca553..646deb96687 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -1075,6 +1075,7 @@ packageListFromCache verbosity mkPkg hnd Cache{..} = accum mempty [] mempty cach } , gpdScannedVersion = Just specVer -- tells index scanner to skip this file. , genPackageFlags = [] + , genDefaultPackageBounds = Nothing , condLibrary = Nothing , condSubLibraries = [] , condForeignLibs = [] diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs index b5b49053b6d..81c49d0aceb 100644 --- a/cabal-install/tests/IntegrationTests2.hs +++ b/cabal-install/tests/IntegrationTests2.hs @@ -467,6 +467,7 @@ testTargetSelectorAmbiguous reportSubCase = do packageDescription = emptyPackageDescription { package = pkgid }, gpdScannedVersion = Nothing, genPackageFlags = [], + genDefaultPackageBounds = Nothing, condLibrary = Nothing, condSubLibraries = [], condForeignLibs = [], diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs index 991c5cafa0e..914ce6f2b55 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -455,6 +455,7 @@ exAvSrcPkg ex = } , C.gpdScannedVersion = Nothing , C.genPackageFlags = flags + , C.genDefaultPackageBounds = Nothing , C.condLibrary = let mkLib v bi = mempty{C.libVisibility = v, C.libBuildInfo = bi} -- Avoid using the Monoid instance for [a] when getting