diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs b/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs index de2c7b07d1b..d3b54ba4c40 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs @@ -511,25 +511,20 @@ finalizePD , flagVals ) where - appBounds :: L.HasBuildInfo a => a -> a - appBounds = maybe id applyDefaultBoundsToBuildInfo defBounds - - appBoundsConstrs - :: [CondTree v [Dependency] a] - -> [CondTree v [Dependency] a] - appBoundsConstrs = case defBounds of - Nothing -> id - Just db -> map (mapTreeConstrs (applyDefaultBoundsToDependencies db)) + appBounds + :: L.HasBuildInfo a + => CondTree v [Dependency] a + -> CondTree v [Dependency] a + appBounds = applyDefaultBoundsToCondTree defBounds -- Combine lib, exes, and tests into one list of @CondTree@s with tagged data condTrees = - appBoundsConstrs $ - maybeToList (fmap (mapTreeData (Lib . appBounds)) mb_lib0) - ++ map (\(name, tree) -> mapTreeData (SubComp name . CLib . appBounds) tree) sub_libs0 - ++ map (\(name, tree) -> mapTreeData (SubComp name . CFLib . appBounds) tree) flibs0 - ++ map (\(name, tree) -> mapTreeData (SubComp name . CExe . appBounds) tree) exes0 - ++ map (\(name, tree) -> mapTreeData (SubComp name . CTest . appBounds) tree) tests0 - ++ map (\(name, tree) -> mapTreeData (SubComp name . CBench . appBounds) tree) bms0 + maybeToList (fmap (mapTreeData Lib . appBounds) mb_lib0) + ++ map (\(name, tree) -> mapTreeData (SubComp name . CLib) $ appBounds tree) sub_libs0 + ++ map (\(name, tree) -> mapTreeData (SubComp name . CFLib) $ appBounds tree) flibs0 + ++ map (\(name, tree) -> mapTreeData (SubComp name . CExe) $ appBounds tree) exes0 + ++ map (\(name, tree) -> mapTreeData (SubComp name . CTest) $ appBounds tree) tests0 + ++ map (\(name, tree) -> mapTreeData (SubComp name . CBench) $ appBounds tree) bms0 flagChoices = map (\(MkPackageFlag n _ d manual) -> (n, d2c manual n d)) flags d2c manual n b = case lookupFlagAssignment n userflags of @@ -688,4 +683,4 @@ transformDefaultBuildDepends -> GenericPackageDescription -> GenericPackageDescription transformDefaultBuildDepends f = - over (L.genDefaultPackageBounds . traverse . L.defaultTargetBuildDepends . traverse) f + over (L.genDefaultPackageBounds . L.defaultTargetBuildDepends . traverse) f diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index 692274dbf48..2959aba17fd 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -398,8 +398,8 @@ goSections specVer = traverse_ process | name == "default-package-bounds" = if specVer >= CabalSpecV3_14 then do - sbi <- lift $ parseFields specVer fields defaultPackageBoundsFieldGrammar - stateGpd . L.genDefaultPackageBounds .= Just sbi + dpb <- lift $ parseFields specVer fields defaultPackageBoundsFieldGrammar + stateGpd . L.genDefaultPackageBounds .= dpb else lift $ parseWarning pos PWTUnknownSection $ "Ignoring section: default-package-bounds. You should set cabal-version: 3.14 or larger to use default-package-bounds." | name == "custom-setup" && null args = do sbi <- lift $ parseFields specVer fields (setupBInfoFieldGrammar False) diff --git a/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs b/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs index 7579886d0c9..cf57578fb6b 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs @@ -231,7 +231,7 @@ pdToGpd pd = { packageDescription = pd , gpdScannedVersion = Nothing , genPackageFlags = [] - , genDefaultPackageBounds = Nothing + , genDefaultPackageBounds = emptyDefaultBounds , condLibrary = mkCondTree <$> library pd , condSubLibraries = mkCondTreeL <$> subLibraries pd , condForeignLibs = mkCondTree' foreignLibName <$> foreignLibs pd diff --git a/Cabal-syntax/src/Distribution/Types/DefaultBounds.hs b/Cabal-syntax/src/Distribution/Types/DefaultBounds.hs index d9e95d70727..e25081d3b79 100644 --- a/Cabal-syntax/src/Distribution/Types/DefaultBounds.hs +++ b/Cabal-syntax/src/Distribution/Types/DefaultBounds.hs @@ -3,10 +3,8 @@ module Distribution.Types.DefaultBounds ( DefaultBounds (..) - , applyDefaultBoundsToBuildInfo - , applyDefaultBoundsToDependencies - , applyDefaultBoundsToExeDependencies , applyDefaultBoundsToCondTree + , emptyDefaultBounds ) where import Distribution.Compat.Lens @@ -28,13 +26,17 @@ instance Binary DefaultBounds instance Structured DefaultBounds instance NFData DefaultBounds where rnf = genericRnf +emptyDefaultBounds :: DefaultBounds +emptyDefaultBounds = DefaultBounds [] [] + applyDefaultBoundsToCondTree :: L.HasBuildInfo a => DefaultBounds -> CondTree cv [Dependency] a -> CondTree cv [Dependency] a applyDefaultBoundsToCondTree db = - mapTreeData (applyDefaultBoundsToBuildInfo db) . mapTreeConstrs (applyDefaultBoundsToDependencies db) + mapTreeData (applyDefaultBoundsToBuildInfo db) + . mapTreeConstrs (applyDefaultBoundsToDependencies db) applyDefaultBoundsToBuildInfo :: L.HasBuildInfo a => DefaultBounds -> a -> a applyDefaultBoundsToBuildInfo db bi = @@ -43,6 +45,7 @@ applyDefaultBoundsToBuildInfo db bi = & L.buildToolDepends %~ applyDefaultBoundsToExeDependencies db applyDefaultBoundsToDependencies :: DefaultBounds -> [Dependency] -> [Dependency] +applyDefaultBoundsToDependencies (DefaultBounds [] _) = id applyDefaultBoundsToDependencies (DefaultBounds bd _) = map ( \dep@(Dependency pkg vorig l) -> @@ -52,6 +55,7 @@ applyDefaultBoundsToDependencies (DefaultBounds bd _) = ) applyDefaultBoundsToExeDependencies :: DefaultBounds -> [ExeDependency] -> [ExeDependency] +applyDefaultBoundsToExeDependencies (DefaultBounds _ []) = id applyDefaultBoundsToExeDependencies (DefaultBounds _ btd) = map ( \dep@(ExeDependency pkg comp vorig) -> diff --git a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs index 2b5ed006da7..ef1ef69bc39 100644 --- a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs +++ b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs @@ -44,7 +44,7 @@ data GenericPackageDescription = GenericPackageDescription -- Perfectly, PackageIndex should have sum type, so we don't need to -- have dummy GPDs. , genPackageFlags :: [PackageFlag] - , genDefaultPackageBounds :: Maybe DefaultBounds + , genDefaultPackageBounds :: DefaultBounds , condLibrary :: Maybe (CondTree ConfVar [Dependency] Library) , condSubLibraries :: [ ( UnqualComponentName @@ -82,7 +82,7 @@ instance Structured GenericPackageDescription instance NFData GenericPackageDescription where rnf = genericRnf emptyGenericPackageDescription :: GenericPackageDescription -emptyGenericPackageDescription = GenericPackageDescription emptyPackageDescription Nothing [] Nothing Nothing [] [] [] [] [] +emptyGenericPackageDescription = GenericPackageDescription emptyPackageDescription Nothing [] emptyDefaultBounds Nothing [] [] [] [] [] -- ----------------------------------------------------------------------------- -- Traversal Instances diff --git a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs index 539e5950064..21105f7d9e9 100644 --- a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs +++ b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs @@ -50,7 +50,7 @@ genPackageFlags :: Lens' GenericPackageDescription [PackageFlag] genPackageFlags f s = fmap (\x -> s{T.genPackageFlags = x}) (f (T.genPackageFlags s)) {-# INLINE genPackageFlags #-} -genDefaultPackageBounds :: Lens' GenericPackageDescription (Maybe DefaultBounds) +genDefaultPackageBounds :: Lens' GenericPackageDescription DefaultBounds genDefaultPackageBounds f s = fmap (\x -> s{T.genDefaultPackageBounds = x}) (f (T.genDefaultPackageBounds s)) {-# INLINE genDefaultPackageBounds #-} diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs index 70370de76c0..b41d862f6f0 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs @@ -35,7 +35,7 @@ md5CheckGenericPackageDescription proxy = md5Check proxy #if MIN_VERSION_base(4,19,0) 0xbcb29fedd00cda89586faf963028e31d #else - 0xbb48247a1d86d5b514ffc4d6df853c74 + 0xb853c69731d382446f1ae86485f953ac #endif md5CheckLocalBuildInfo :: Proxy LocalBuildInfo -> Assertion diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index c6aeceed141..66efe7977ce 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -274,7 +274,7 @@ checkGenericPackageDescription -- Flag names. mapM_ checkFlagName genPackageFlags_ -- default package bounds - mapM_ checkDefaultBounds genDefaultPackageBounds_ + checkDefaultBounds genDefaultPackageBounds_ -- ยง Feature checks. checkSpecVer @@ -301,7 +301,7 @@ checkGenericPackageDescription let ads = maybe [] ((: []) . extractAssocDeps pName) condLibrary_ ++ map (uncurry extractAssocDeps) condSubLibraries_ - ++ maybe [] ((: []) . Left . defaultTargetBuildDepends) genDefaultPackageBounds_ + ++ ((: []) . Left . defaultTargetBuildDepends) genDefaultPackageBounds_ case condLibrary_ of Just cl -> diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs index 5060d1cc552..2621e639ef6 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs @@ -183,7 +183,7 @@ convGPD os arch cinfo constraints strfl solveExes pn appBounds :: HasBuildInfo a => CondTree cv [Dependency] a -> CondTree cv [Dependency] a - appBounds = maybe id applyDefaultBoundsToCondTree defBounds + appBounds = applyDefaultBoundsToCondTree defBounds conv :: Monoid a => Component -> (a -> BuildInfo) -> DependencyReason PN -> CondTree ConfVar [Dependency] a -> FlaggedDeps PN diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index 646deb96687..fb8681864a9 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -79,6 +79,7 @@ import Distribution.Package import Distribution.PackageDescription ( GenericPackageDescription (..) , PackageDescription (..) + , emptyDefaultBounds , emptyPackageDescription ) import Distribution.Simple.Compiler @@ -1075,7 +1076,7 @@ packageListFromCache verbosity mkPkg hnd Cache{..} = accum mempty [] mempty cach } , gpdScannedVersion = Just specVer -- tells index scanner to skip this file. , genPackageFlags = [] - , genDefaultPackageBounds = Nothing + , genDefaultPackageBounds = emptyDefaultBounds , condLibrary = Nothing , condSubLibraries = [] , condForeignLibs = [] diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs index 81c49d0aceb..e5415a7d766 100644 --- a/cabal-install/tests/IntegrationTests2.hs +++ b/cabal-install/tests/IntegrationTests2.hs @@ -467,7 +467,7 @@ testTargetSelectorAmbiguous reportSubCase = do packageDescription = emptyPackageDescription { package = pkgid }, gpdScannedVersion = Nothing, genPackageFlags = [], - genDefaultPackageBounds = Nothing, + genDefaultPackageBounds = emptyDefaultBounds, 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 914ce6f2b55..3c9d9a0e43b 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -455,7 +455,7 @@ exAvSrcPkg ex = } , C.gpdScannedVersion = Nothing , C.genPackageFlags = flags - , C.genDefaultPackageBounds = Nothing + , C.genDefaultPackageBounds = C.emptyDefaultBounds , C.condLibrary = let mkLib v bi = mempty{C.libVisibility = v, C.libBuildInfo = bi} -- Avoid using the Monoid instance for [a] when getting