Implement default-package-bounds field

haskell · Dec 27, 2023 · 5ef1e11 · 5ef1e11
1 parent 52d1fb6
commit 5ef1e11
Show file tree

Hide file tree

Showing 5 changed files with 26 additions and 2 deletions.
diff --git a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
@@ -104,6 +104,7 @@ packageDescriptionFieldGrammar
      , c (List FSep (Identity (SymbolicPath PackageDir LicenseFile)) (SymbolicPath PackageDir LicenseFile))
      , c (List FSep TestedWith (CompilerFlavor, VersionRange))
      , c (List VCat FilePathNT String)
+     , c (List CommaVCat (Identity Dependency) Dependency)
      , c FilePathNT
      , c CompatLicenseFile
      , c CompatFilePath
@@ -146,6 +147,8 @@ packageDescriptionFieldGrammar =
     <*> monoidalFieldAla "extra-source-files" formatExtraSourceFiles L.extraSrcFiles
     <*> monoidalFieldAla "extra-tmp-files" (alaList' VCat FilePathNT) L.extraTmpFiles
     <*> monoidalFieldAla "extra-doc-files" (alaList' VCat FilePathNT) L.extraDocFiles
+    <*> monoidalFieldAla "default-package-bounds" formatDependencyList L.defaultPackageBounds
+      ^^^ availableSince CabalSpecV3_12 []
   where
     packageIdentifierGrammar =
       PackageIdentifier

diff --git a/Cabal-syntax/src/Distribution/Types/PackageDescription.hs b/Cabal-syntax/src/Distribution/Types/PackageDescription.hs
@@ -146,6 +146,8 @@ data PackageDescription = PackageDescription
   , extraSrcFiles :: [FilePath]
   , extraTmpFiles :: [FilePath]
   , extraDocFiles :: [FilePath]
+  , -- default constraints to override unversioned dependencies
+    defaultPackageBounds :: [Dependency]
   }
   deriving (Generic, Show, Read, Eq, Ord, Typeable, Data)
 
@@ -232,6 +234,7 @@ emptyPackageDescription =
     , extraSrcFiles = []
     , extraTmpFiles = []
     , extraDocFiles = []
+    , defaultPackageBounds = []
     }
 
 -- ---------------------------------------------------------------------------
@@ -488,6 +491,7 @@ instance L.HasBuildInfos PackageDescription where
         a22
         a23
         a24
+        a25
       ) =
       PackageDescription a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19
         <$> (traverse . L.buildInfo) f x1 -- library
@@ -501,3 +505,4 @@ instance L.HasBuildInfos PackageDescription where
         <*> pure a22 -- extra src files
         <*> pure a23 -- extra temp files
         <*> pure a24 -- extra doc files
+        <*> pure a25 -- default constraints
diff --git a/Cabal-syntax/src/Distribution/Types/PackageDescription/Lens.hs b/Cabal-syntax/src/Distribution/Types/PackageDescription/Lens.hs
@@ -19,6 +19,7 @@ import Distribution.Types.Benchmark.Lens (benchmarkBuildInfo, benchmarkName)
 import Distribution.Types.BuildInfo (BuildInfo)
 import Distribution.Types.BuildType (BuildType)
 import Distribution.Types.ComponentName (ComponentName (..))
+import Distribution.Types.Dependency (Dependency (..))
 import Distribution.Types.Executable (Executable, exeModules)
 import Distribution.Types.Executable.Lens (exeBuildInfo, exeName)
 import Distribution.Types.ForeignLib (ForeignLib, foreignLibModules)
@@ -158,6 +159,10 @@ extraDocFiles :: Lens' PackageDescription [String]
 extraDocFiles f s = fmap (\x -> s{T.extraDocFiles = x}) (f (T.extraDocFiles s))
 {-# INLINE extraDocFiles #-}
 
+defaultPackageBounds :: Lens' PackageDescription [Dependency]
+defaultPackageBounds f s = fmap (\x -> s{T.defaultPackageBounds = x}) (f (T.defaultPackageBounds s))
+{-# INLINE defaultPackageBounds #-}
+
 -- | @since 3.0.0.0
 allLibraries :: Traversal' PackageDescription Library
 allLibraries f pd = mk <$> traverse f (T.library pd) <*> traverse f (T.subLibraries pd)

diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs
@@ -395,6 +395,7 @@ checkPackageDescription
           extraSrcFiles_
           extraTmpFiles_
           extraDocFiles_
+          _packageConstraints
         ) = do
     -- § Sanity checks.
     checkPackageId package_

diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
@@ -20,6 +20,7 @@ import Distribution.Types.ComponentName              -- from Cabal
 import Distribution.Types.CondTree                   -- from Cabal
 import Distribution.Types.MungedPackageId            -- from Cabal
 import Distribution.Types.MungedPackageName          -- from Cabal
+import Distribution.Types.VersionRange               -- from Cabal
 import Distribution.PackageDescription               -- from Cabal
 import Distribution.PackageDescription.Configuration
 import qualified Distribution.Simple.PackageIndex as SI
@@ -339,8 +340,7 @@ convCondTree flags dr pkg os arch cinfo pn fds comp getInfo solveExes@(SolveExec
              mergeSimpleDeps $
                  [ D.Simple singleDep comp
                  | dep <- ds
-                 , singleDep <- convLibDeps dr dep ]  -- unconditional package dependencies
-
+                 , singleDep <- convLibDeps dr (alterDep dep) ]  -- unconditional package dependencies
               ++ L.map (\e -> D.Simple (LDep dr (Ext  e)) comp) (allExtensions bi) -- unconditional extension dependencies
               ++ L.map (\l -> D.Simple (LDep dr (Lang l)) comp) (allLanguages  bi) -- unconditional language dependencies
               ++ L.map (\(PkgconfigDependency pkn vr) -> D.Simple (LDep dr (Pkg pkn vr)) comp) (pkgconfigDepends bi) -- unconditional pkg-config dependencies
@@ -358,6 +358,16 @@ convCondTree flags dr pkg os arch cinfo pn fds comp getInfo solveExes@(SolveExec
   where
     bi = getInfo info
 
+    -- apply default-package-bounds field of pkg to the actual declared
+    -- dependencies
+    alterDep x@(Dependency name vorig ls) =
+      if vorig == anyVersion
+      then
+        maybe x (\v -> Dependency name v ls) $
+        listToMaybe [ v2 | Dependency name2 v2 _ <- defaultPackageBounds pkg
+                         , name2 == name ]
+      else x
+
 data SimpleFlaggedDepKey qpn =
     SimpleFlaggedDepKey (PkgComponent qpn) Component
   deriving (Eq, Ord)