default-package-bounds (RFC #9569) implementation

Cabal-syntax/Cabal-syntax.cabal

@@ -134,6 +134,8 @@ library
     Distribution.Types.CondTree
     Distribution.Types.Condition
     Distribution.Types.ConfVar
+    Distribution.Types.DefaultBounds
+    Distribution.Types.DefaultBounds.Lens
     Distribution.Types.Dependency
     Distribution.Types.DependencyMap
     Distribution.Types.ExeDependency

Cabal-syntax/src/Distribution/Package.hs

@@ -25,6 +25,7 @@ module Distribution.Package
   , module Distribution.Types.PackageName
   , module Distribution.Types.PkgconfigName
   , module Distribution.Types.Dependency
+  , module Distribution.Types.DefaultBounds
   , Package (..)
   , packageName
   , packageVersion
@@ -44,6 +45,7 @@ import Distribution.Version
 
 import Distribution.Types.AbiHash
 import Distribution.Types.ComponentId
+import Distribution.Types.DefaultBounds
 import Distribution.Types.Dependency
 import Distribution.Types.Module
 import Distribution.Types.MungedPackageId

Cabal-syntax/src/Distribution/PackageDescription.hs

@@ -62,6 +62,7 @@ module Distribution.PackageDescription
   , module Distribution.Types.PkgconfigVersionRange
 
     -- * Dependencies
+  , module Distribution.Types.DefaultBounds
   , module Distribution.Types.Dependency
   , module Distribution.Types.ExeDependency
   , module Distribution.Types.LegacyExeDependency
@@ -95,6 +96,7 @@ import Distribution.Types.ComponentName
 import Distribution.Types.CondTree
 import Distribution.Types.Condition
 import Distribution.Types.ConfVar
+import Distribution.Types.DefaultBounds
 import Distribution.Types.Dependency
 import Distribution.Types.ExeDependency
 import Distribution.Types.Executable

Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs

@@ -32,6 +32,7 @@ module Distribution.PackageDescription.Configuration
   , transformAllBuildInfos
   , transformAllBuildDepends
   , transformAllBuildDependsN
+  , transformDefaultBuildDepends
   , simplifyWithSysParams
   ) where
 
@@ -40,6 +41,7 @@ import Prelude ()
 
 -- lens
 import qualified Distribution.Types.BuildInfo.Lens as L
+import qualified Distribution.Types.DefaultBounds.Lens as L
 import qualified Distribution.Types.GenericPackageDescription.Lens as L
 import qualified Distribution.Types.PackageDescription.Lens as L
 import qualified Distribution.Types.SetupBuildInfo.Lens as L
@@ -476,7 +478,7 @@ finalizePD
   (Platform arch os)
   impl
   constraints
-  (GenericPackageDescription pkg _ver flags mb_lib0 sub_libs0 flibs0 exes0 tests0 bms0) = do
+  (GenericPackageDescription pkg _ver flags defBounds mb_lib0 sub_libs0 flibs0 exes0 tests0 bms0) = do
     (targetSet, flagVals) <-
       resolveWithFlags flagChoices enabled os arch impl constraints condTrees check
     let
@@ -509,14 +511,20 @@ finalizePD
       , flagVals
       )
     where
+      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 =
-        maybeToList (fmap (mapTreeData Lib) mb_lib0)
-          ++ map (\(name, tree) -> mapTreeData (SubComp name . CLib) tree) sub_libs0
-          ++ map (\(name, tree) -> mapTreeData (SubComp name . CFLib) tree) flibs0
-          ++ map (\(name, tree) -> mapTreeData (SubComp name . CExe) tree) exes0
-          ++ map (\(name, tree) -> mapTreeData (SubComp name . CTest) tree) tests0
-          ++ map (\(name, tree) -> mapTreeData (SubComp name . CBench) 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
@@ -556,7 +564,7 @@ resolveWithFlags [] Distribution.System.Linux Distribution.System.I386 (Distribu
 -- function.
 flattenPackageDescription :: GenericPackageDescription -> PackageDescription
 flattenPackageDescription
-  (GenericPackageDescription pkg _ _ mlib0 sub_libs0 flibs0 exes0 tests0 bms0) =
+  (GenericPackageDescription pkg _ _ _ mlib0 sub_libs0 flibs0 exes0 tests0 bms0) =
     pkg
       { library = mlib
       , subLibraries = reverse sub_libs
@@ -668,3 +676,11 @@ transformAllBuildDependsN f =
     . over (L.packageDescription . L.setupBuildInfo . traverse . L.setupDepends) f
     -- cannot be point-free as normal because of higher rank
     . over (\f' -> L.allCondTrees $ traverseCondTreeC f') f
+
+-- | Apply @f@ to the default bounds in the 'PackageDescription'.
+transformDefaultBuildDepends
+  :: (Dependency -> Dependency)
+  -> GenericPackageDescription
+  -> GenericPackageDescription
+transformDefaultBuildDepends f =
+  over (L.genDefaultPackageBounds . L.defaultTargetBuildDepends . traverse) f

Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs

@@ -65,6 +65,9 @@ module Distribution.PackageDescription.FieldGrammar
 
     -- * Component build info
   , buildInfoFieldGrammar
+
+    -- * default-package-bounds
+  , defaultPackageBoundsFieldGrammar
   ) where
 
 import Distribution.Compat.Lens
@@ -807,6 +810,24 @@ setupBInfoFieldGrammar def =
 {-# SPECIALIZE setupBInfoFieldGrammar :: Bool -> ParsecFieldGrammar' SetupBuildInfo #-}
 {-# SPECIALIZE setupBInfoFieldGrammar :: Bool -> PrettyFieldGrammar' SetupBuildInfo #-}
 
+-------------------------------------------------------------------------------
+-- default-package-bounds
+-------------------------------------------------------------------------------
+
+defaultPackageBoundsFieldGrammar
+  :: ( FieldGrammar c g
+     , Applicative (g DefaultBounds)
+     , c (List CommaVCat (Identity Dependency) Dependency)
+     , c (List CommaFSep (Identity ExeDependency) ExeDependency)
+     )
+  => g DefaultBounds DefaultBounds
+defaultPackageBoundsFieldGrammar =
+  DefaultBounds
+    <$> (monoidalFieldAla "build-depends" formatDependencyList L.defaultTargetBuildDepends)
+    <*> (monoidalFieldAla "build-tool-depends" (alaList CommaFSep) L.defaultBuildToolDepends)
+{-# SPECIALIZE defaultPackageBoundsFieldGrammar :: ParsecFieldGrammar' DefaultBounds #-}
+{-# SPECIALIZE defaultPackageBoundsFieldGrammar :: PrettyFieldGrammar' DefaultBounds #-}
+
 -------------------------------------------------------------------------------
 -- Define how field values should be formatted for 'pretty'.
 -------------------------------------------------------------------------------

Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs

@@ -247,7 +247,7 @@ goSections specVer = traverse_ process
     process (Field (Name pos name) _) =
       lift $
         parseWarning pos PWTTrailingFields $
-          "Ignoring trailing fields after sections: " ++ show name
+          "Ignoring trailing fields after sections: " ++ show name ++ ". Consider moving these fields before any stanzas in your cabal file."
     process (Section name args secFields) =
       parseSection name args secFields
 
@@ -395,6 +395,12 @@ goSections specVer = traverse_ process
           flag <- lift $ parseFields specVer fields (flagFieldGrammar name'')
           -- Check default flag
           stateGpd . L.genPackageFlags %= snoc flag
+      | name == "default-package-bounds" =
+          if specVer >= CabalSpecV3_14
+            then do
+              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)
           stateGpd . L.packageDescription . L.setupBuildInfo ?= sbi

Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs

@@ -231,6 +231,7 @@ pdToGpd pd =
     { packageDescription = pd
     , gpdScannedVersion = Nothing
     , genPackageFlags = []
+    , genDefaultPackageBounds = emptyDefaultBounds
     , condLibrary = mkCondTree <$> library pd
     , condSubLibraries = mkCondTreeL <$> subLibraries pd
     , condForeignLibs = mkCondTree' foreignLibName <$> foreignLibs pd

Cabal-syntax/src/Distribution/Types/DefaultBounds.hs

@@ -0,0 +1,65 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+module Distribution.Types.DefaultBounds
+  ( DefaultBounds (..)
+  , applyDefaultBoundsToCondTree
+  , emptyDefaultBounds
+  ) where
+
+import Distribution.Compat.Lens
+import Distribution.Compat.Prelude
+
+import qualified Distribution.Types.BuildInfo.Lens as L
+import Distribution.Types.CondTree
+import Distribution.Types.Dependency
+import Distribution.Types.ExeDependency
+import Distribution.Types.VersionRange
+
+data DefaultBounds = DefaultBounds
+  { defaultTargetBuildDepends :: [Dependency]
+  , defaultBuildToolDepends :: [ExeDependency]
+  }
+  deriving (Generic, Read, Show, Eq, Data, Typeable)
+
+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)
+
+applyDefaultBoundsToBuildInfo :: L.HasBuildInfo a => DefaultBounds -> a -> a
+applyDefaultBoundsToBuildInfo db bi =
+  bi
+    & L.targetBuildDepends %~ applyDefaultBoundsToDependencies db
+    & L.buildToolDepends %~ applyDefaultBoundsToExeDependencies db
+
+applyDefaultBoundsToDependencies :: DefaultBounds -> [Dependency] -> [Dependency]
+applyDefaultBoundsToDependencies (DefaultBounds [] _) = id
+applyDefaultBoundsToDependencies (DefaultBounds bd _) =
+  map
+    ( \dep@(Dependency pkg vorig l) ->
+        if isAnyVersion vorig
+          then maybe dep (\v -> Dependency pkg (depVerRange v) l) $ find ((pkg ==) . depPkgName) bd
+          else dep
+    )
+
+applyDefaultBoundsToExeDependencies :: DefaultBounds -> [ExeDependency] -> [ExeDependency]
+applyDefaultBoundsToExeDependencies (DefaultBounds _ []) = id
+applyDefaultBoundsToExeDependencies (DefaultBounds _ btd) =
+  map
+    ( \dep@(ExeDependency pkg comp vorig) ->
+        if isAnyVersion vorig
+          then maybe dep (ExeDependency pkg comp . exeDepVerRange) $ find (\(ExeDependency pkg' comp' _) -> pkg == pkg' && comp == comp') btd
+          else dep
+    )

Cabal-syntax/src/Distribution/Types/DefaultBounds/Lens.hs

@@ -0,0 +1,26 @@
+module Distribution.Types.DefaultBounds.Lens
+  ( DefaultBounds
+  , module Distribution.Types.DefaultBounds.Lens
+  ) where
+
+import Distribution.Compat.Lens
+import Distribution.Compat.Prelude
+import Prelude ()
+
+import qualified Distribution.Types.DefaultBounds as T
+
+import Distribution.Types.DefaultBounds (DefaultBounds)
+import Distribution.Types.Dependency (Dependency)
+import Distribution.Types.ExeDependency (ExeDependency)
+
+-------------------------------------------------------------------------------
+-- GenericPackageDescription
+-------------------------------------------------------------------------------
+
+defaultTargetBuildDepends :: Lens' DefaultBounds [Dependency]
+defaultTargetBuildDepends f s = fmap (\x -> s{T.defaultTargetBuildDepends = x}) (f (T.defaultTargetBuildDepends s))
+{-# INLINE defaultTargetBuildDepends #-}
+
+defaultBuildToolDepends :: Lens' DefaultBounds [ExeDependency]
+defaultBuildToolDepends f s = fmap (\x -> s{T.defaultBuildToolDepends = x}) (f (T.defaultBuildToolDepends s))
+{-# INLINE defaultBuildToolDepends #-}

Cabal-syntax/src/Distribution/Types/ExeDependency.hs

@@ -4,6 +4,9 @@
 module Distribution.Types.ExeDependency
   ( ExeDependency (..)
   , qualifiedExeName
+  , exeDepPkgName
+  , exeDepUnqualComp
+  , exeDepVerRange
   ) where
 
 import Distribution.Compat.Prelude
@@ -31,6 +34,15 @@ instance Binary ExeDependency
 instance Structured ExeDependency
 instance NFData ExeDependency where rnf = genericRnf
 
+exeDepPkgName :: ExeDependency -> PackageName
+exeDepPkgName (ExeDependency pn _ _) = pn
+
+exeDepUnqualComp :: ExeDependency -> UnqualComponentName
+exeDepUnqualComp (ExeDependency _ uc _) = uc
+
+exeDepVerRange :: ExeDependency -> VersionRange
+exeDepVerRange (ExeDependency _ _ vr) = vr
+
 instance Pretty ExeDependency where
   pretty (ExeDependency name exe ver) =
     pretty name <<>> PP.colon <<>> pretty exe PP.<+> pver

Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs

@@ -44,6 +44,7 @@ data GenericPackageDescription = GenericPackageDescription
   --   Perfectly, PackageIndex should have sum type, so we don't need to
   --   have dummy GPDs.
   , genPackageFlags :: [PackageFlag]
+  , genDefaultPackageBounds :: DefaultBounds
   , condLibrary :: Maybe (CondTree ConfVar [Dependency] Library)
   , condSubLibraries
       :: [ ( UnqualComponentName
@@ -81,17 +82,18 @@ instance Structured GenericPackageDescription
 instance NFData GenericPackageDescription where rnf = genericRnf
 
 emptyGenericPackageDescription :: GenericPackageDescription
-emptyGenericPackageDescription = GenericPackageDescription emptyPackageDescription Nothing [] Nothing [] [] [] [] []
+emptyGenericPackageDescription = GenericPackageDescription emptyPackageDescription Nothing [] emptyDefaultBounds Nothing [] [] [] [] []
 
 -- -----------------------------------------------------------------------------
 -- Traversal Instances
 
 instance L.HasBuildInfos GenericPackageDescription where
-  traverseBuildInfos f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6) =
+  traverseBuildInfos f (GenericPackageDescription p v a1 bs x1 x2 x3 x4 x5 x6) =
     GenericPackageDescription
       <$> L.traverseBuildInfos f p
       <*> pure v
       <*> pure a1
+      <*> pure bs
       <*> (traverse . traverseCondTreeBuildInfo) f x1
       <*> (traverse . L._2 . traverseCondTreeBuildInfo) f x2
       <*> (traverse . L._2 . traverseCondTreeBuildInfo) f x3

Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs

@@ -22,6 +22,7 @@ import Distribution.System (Arch, OS)
 import Distribution.Types.Benchmark (Benchmark)
 import Distribution.Types.CondTree (CondTree)
 import Distribution.Types.ConfVar (ConfVar (..))
+import Distribution.Types.DefaultBounds (DefaultBounds)
 import Distribution.Types.Dependency (Dependency)
 import Distribution.Types.Executable (Executable)
 import Distribution.Types.Flag (FlagName, PackageFlag (MkPackageFlag))
@@ -49,6 +50,10 @@ genPackageFlags :: Lens' GenericPackageDescription [PackageFlag]
 genPackageFlags f s = fmap (\x -> s{T.genPackageFlags = x}) (f (T.genPackageFlags s))
 {-# INLINE genPackageFlags #-}
 
+genDefaultPackageBounds :: Lens' GenericPackageDescription DefaultBounds
+genDefaultPackageBounds f s = fmap (\x -> s{T.genDefaultPackageBounds = x}) (f (T.genDefaultPackageBounds s))
+{-# INLINE genDefaultPackageBounds #-}
+
 condLibrary :: Lens' GenericPackageDescription (Maybe (CondTree ConfVar [Dependency] Library))
 condLibrary f s = fmap (\x -> s{T.condLibrary = x}) (f (T.condLibrary s))
 {-# INLINE condLibrary #-}
@@ -81,11 +86,12 @@ allCondTrees
      )
   -> GenericPackageDescription
   -> f GenericPackageDescription
-allCondTrees f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6) =
+allCondTrees f (GenericPackageDescription p v a1 bs x1 x2 x3 x4 x5 x6) =
   GenericPackageDescription
     <$> pure p
     <*> pure v
     <*> pure a1
+    <*> pure bs
     <*> traverse f x1
     <*> (traverse . _2) f x2
     <*> (traverse . _2) f x3

Cabal-syntax/src/Distribution/Types/Lens.hs

@@ -1,6 +1,7 @@
 module Distribution.Types.Lens
   ( module Distribution.Types.Benchmark.Lens
   , module Distribution.Types.BuildInfo.Lens
+  , module Distribution.Types.DefaultBounds.Lens
   , module Distribution.Types.Executable.Lens
   , module Distribution.Types.ForeignLib.Lens
   , module Distribution.Types.GenericPackageDescription.Lens
@@ -14,6 +15,7 @@ module Distribution.Types.Lens
 
 import Distribution.Types.Benchmark.Lens
 import Distribution.Types.BuildInfo.Lens
+import Distribution.Types.DefaultBounds.Lens
 import Distribution.Types.Executable.Lens
 import Distribution.Types.ForeignLib.Lens
 import Distribution.Types.GenericPackageDescription.Lens

Cabal-tests/tests/NoThunks.hs

@@ -69,6 +69,7 @@ instance NoThunks BuildType
 instance NoThunks CabalSpecVersion
 instance NoThunks CompilerFlavor
 instance NoThunks ConfVar
+instance NoThunks DefaultBounds
 instance NoThunks Dependency
 instance NoThunks Executable
 instance NoThunks ExecutableScope

Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr

@@ -69,6 +69,10 @@ GenericPackageDescription {
     extraDocFiles = []},
   gpdScannedVersion = Nothing,
   genPackageFlags = [],
+  genDefaultPackageBounds =
+  DefaultBounds {
+    defaultTargetBuildDepends = [],
+    defaultBuildToolDepends = []},
   condLibrary = Just
     CondNode {
       condTreeData = Library {