cabal-install: Use AllowNewer from Cabal

Author: maralorn

cabal-install/cabal-install.cabal

@@ -179,7 +179,6 @@ library
         Distribution.Client.TargetSelector
         Distribution.Client.Targets
         Distribution.Client.Types
-        Distribution.Client.Types.AllowNewer
         Distribution.Client.Types.BuildResults
         Distribution.Client.Types.ConfiguredId
         Distribution.Client.Types.ConfiguredPackage

cabal-install/src/Distribution/Client/Config.hs

@@ -84,15 +84,17 @@ import Distribution.Client.Setup
   , reportCommand
   , uploadCommand
   )
-import Distribution.Client.Types
+import Distribution.Types.AllowNewer
   ( AllowNewer (..)
   , AllowOlder (..)
-  , LocalRepo (..)
   , RelaxDeps (..)
+  , isRelaxDeps
+  )
+import Distribution.Client.Types
+  ( LocalRepo (..)
   , RemoteRepo (..)
   , RepoName (..)
   , emptyRemoteRepo
-  , isRelaxDeps
   , unRepoName
   )
 import Distribution.Client.Types.Credentials (Password (..), Username (..))

cabal-install/src/Distribution/Client/Configure.hs

@@ -130,6 +130,7 @@ import Distribution.Version
   )
 
 import System.FilePath ((</>))
+import Distribution.Types.AllowNewer (AllowOlder(..), AllowNewer (..))
 
 -- | Choose the Cabal version such that the setup scripts compiled against this
 -- version will support the given command-line flags. Currently, it implements no

cabal-install/src/Distribution/Client/Dependency.hs

@@ -77,19 +77,17 @@ import Distribution.Client.Dependency.Types
   )
 import Distribution.Client.SolverInstallPlan (SolverInstallPlan)
 import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan
-import Distribution.Client.Types
+import Distribution.Types.AllowNewer
   ( AllowNewer (..)
   , AllowOlder (..)
-  , PackageSpecifier (..)
-  , RelaxDepMod (..)
-  , RelaxDepScope (..)
-  , RelaxDepSubject (..)
   , RelaxDeps (..)
-  , RelaxedDep (..)
+  , isRelaxDeps
+  )
+import Distribution.Client.Types
+  (  PackageSpecifier (..)
   , SourcePackageDb (SourcePackageDb)
   , UnresolvedPkgLoc
   , UnresolvedSourcePackage
-  , isRelaxDeps
   , pkgSpecifierConstraints
   , pkgSpecifierTarget
   )
@@ -163,6 +161,7 @@ import Data.List
   )
 import qualified Data.Map as Map
 import qualified Data.Set as Set
+import Distribution.AllowNewer (RelaxKind (..), relaxPackageDeps)
 
 -- ------------------------------------------------------------
 
@@ -528,8 +527,6 @@ removeUpperBounds (AllowNewer relDeps) = removeBounds RelaxUpper relDeps
 removeLowerBounds :: AllowOlder -> DepResolverParams -> DepResolverParams
 removeLowerBounds (AllowOlder relDeps) = removeBounds RelaxLower relDeps
 
-data RelaxKind = RelaxLower | RelaxUpper
-
 -- | Common internal implementation of 'removeLowerBounds'/'removeUpperBounds'
 removeBounds :: RelaxKind -> RelaxDeps -> DepResolverParams -> DepResolverParams
 removeBounds _ rd params | not (isRelaxDeps rd) = params -- no-op optimisation
@@ -547,54 +544,6 @@ removeBounds relKind relDeps params =
         { srcpkgDescription = relaxPackageDeps relKind relDeps (srcpkgDescription srcPkg)
         }
 
--- | Relax the dependencies of this package if needed.
---
--- Helper function used by 'removeBounds'
-relaxPackageDeps
-  :: RelaxKind
-  -> RelaxDeps
-  -> 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
-  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
-  where
-    thisPkgName = packageName gpd
-    thisPkgId = packageId gpd
-    depsToRelax = Map.fromList $ mapMaybe f depsToRelax0
-
-    f :: RelaxedDep -> Maybe (RelaxDepSubject, RelaxDepMod)
-    f (RelaxedDep scope rdm p) = case scope of
-      RelaxDepScopeAll -> Just (p, rdm)
-      RelaxDepScopePackage p0
-        | p0 == thisPkgName -> Just (p, rdm)
-        | otherwise -> Nothing
-      RelaxDepScopePackageId p0
-        | p0 == thisPkgId -> Just (p, rdm)
-        | otherwise -> Nothing
-
-    relaxSome :: Dependency -> Dependency
-    relaxSome d@(Dependency depName verRange cs)
-      | Just relMod <- Map.lookup RelaxDepSubjectAll depsToRelax =
-          -- a '*'-subject acts absorbing, for consistency with
-          -- the 'Semigroup RelaxDeps' instance
-          Dependency depName (removeBound relKind relMod verRange) cs
-      | Just relMod <- Map.lookup (RelaxDepSubjectPkg depName) depsToRelax =
-          Dependency depName (removeBound relKind relMod verRange) cs
-      | otherwise = d -- no-op
-
--- | Internal helper for 'relaxPackageDeps'
-removeBound :: RelaxKind -> RelaxDepMod -> VersionRange -> VersionRange
-removeBound RelaxLower RelaxDepModNone = removeLowerBound
-removeBound RelaxUpper RelaxDepModNone = removeUpperBound
-removeBound RelaxLower RelaxDepModCaret = transformCaretLower
-removeBound RelaxUpper RelaxDepModCaret = transformCaretUpper
-
 -- | Supply defaults for packages without explicit Setup dependencies
 --
 -- Note: It's important to apply 'addDefaultSetupDepends' after

cabal-install/src/Distribution/Client/Install.hs

@@ -267,6 +267,7 @@ import Distribution.Version
   )
 
 import qualified Data.ByteString as BS
+import Distribution.Types.AllowNewer (AllowOlder(..), AllowNewer (..))
 
 -- TODO:
 

cabal-install/src/Distribution/Client/ProjectConfig.hs

@@ -221,6 +221,7 @@ import System.IO
   ( IOMode (ReadMode)
   , withBinaryFile
   )
+import Distribution.Types.AllowNewer (AllowOlder(..), AllowNewer (..))
 
 ----------------------------------------
 -- Resolving configuration to settings

cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs

@@ -35,7 +35,7 @@ import Distribution.Client.Compat.Prelude
 import Distribution.Types.Flag (FlagName, parsecFlagAssignment)
 
 import Distribution.Client.ProjectConfig.Types
-import Distribution.Client.Types.AllowNewer (AllowNewer (..), AllowOlder (..))
+import Distribution.Types.AllowNewer (AllowNewer (..), AllowOlder (..))
 import Distribution.Client.Types.Repo (LocalRepo (..), RemoteRepo (..), emptyRemoteRepo)
 import Distribution.Client.Types.RepoName (RepoName (..), unRepoName)
 import Distribution.Client.Types.SourceRepo (SourceRepoList, sourceRepositoryPackageGrammar)

cabal-install/src/Distribution/Client/ProjectConfig/Types.hs

@@ -32,7 +32,7 @@ import Distribution.Client.Dependency.Types
 import Distribution.Client.Targets
   ( UserConstraint
   )
-import Distribution.Client.Types.AllowNewer (AllowNewer (..), AllowOlder (..))
+import Distribution.Types.AllowNewer (AllowNewer (..), AllowOlder (..))
 import Distribution.Client.Types.Repo (LocalRepo, RemoteRepo)
 import Distribution.Client.Types.SourceRepo (SourceRepoList)
 import Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy (WriteGhcEnvironmentFilesPolicy)

cabal-install/src/Distribution/Client/Setup.hs

@@ -92,7 +92,7 @@ module Distribution.Client.Setup
 import Distribution.Client.Compat.Prelude hiding (get)
 import Prelude ()
 
-import Distribution.Client.Types.AllowNewer (AllowNewer (..), AllowOlder (..), RelaxDeps (..))
+import Distribution.Types.AllowNewer (AllowNewer (..), AllowOlder (..), RelaxDeps (..))
 import Distribution.Client.Types.Credentials (Password (..), Username (..))
 import Distribution.Client.Types.Repo (LocalRepo (..), RemoteRepo (..))
 import Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy
@@ -660,7 +660,9 @@ filterConfigureFlags flags cabalLibVersion
           -- Note: this is not in the wrong place. configConstraints gets
           -- repopulated in flags_1_19_1 but it needs to be set to empty for
           -- newer versions first.
-          configConstraints = []
+          configConstraints = [],
+          configAllowNewer = AllowNever mempty,
+          configAllowOlder = AllowOlder mempty
         }
 
     flags_3_11_0 =

cabal-install/src/Distribution/Client/Types.hs

@@ -21,8 +21,7 @@
 --
 -- Various common data types for the entire cabal-install system
 module Distribution.Client.Types
-  ( module Distribution.Client.Types.AllowNewer
-  , module Distribution.Client.Types.ConfiguredId
+  ( module Distribution.Client.Types.ConfiguredId
   , module Distribution.Client.Types.ConfiguredPackage
   , module Distribution.Client.Types.BuildResults
   , module Distribution.Client.Types.PackageLocation
@@ -34,7 +33,6 @@ module Distribution.Client.Types
   , module Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy
   ) where
 
-import Distribution.Client.Types.AllowNewer
 import Distribution.Client.Types.BuildResults
 import Distribution.Client.Types.ConfiguredId
 import Distribution.Client.Types.ConfiguredPackage