Skip to content

Commit

Permalink
cabal-install: Use AllowNewer from Cabal
Browse files Browse the repository at this point in the history
  • Loading branch information
maralorn committed Jun 13, 2023
1 parent 86350b7 commit cc251c0
Show file tree
Hide file tree
Showing 16 changed files with 26 additions and 315 deletions.
1 change: 0 additions & 1 deletion cabal-install/cabal-install.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
8 changes: 5 additions & 3 deletions cabal-install/src/Distribution/Client/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..))
Expand Down
1 change: 1 addition & 0 deletions cabal-install/src/Distribution/Client/Configure.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
63 changes: 6 additions & 57 deletions cabal-install/src/Distribution/Client/Dependency.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
)
Expand Down Expand Up @@ -163,6 +161,7 @@ import Data.List
)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Distribution.AllowNewer (RelaxKind (..), relaxPackageDeps)

-- ------------------------------------------------------------

Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
1 change: 1 addition & 0 deletions cabal-install/src/Distribution/Client/Install.hs
Original file line number Diff line number Diff line change
Expand Up @@ -267,6 +267,7 @@ import Distribution.Version
)

import qualified Data.ByteString as BS
import Distribution.Types.AllowNewer (AllowOlder(..), AllowNewer (..))

-- TODO:

Expand Down
1 change: 1 addition & 0 deletions cabal-install/src/Distribution/Client/ProjectConfig.hs
Original file line number Diff line number Diff line change
Expand Up @@ -221,6 +221,7 @@ import System.IO
( IOMode (ReadMode)
, withBinaryFile
)
import Distribution.Types.AllowNewer (AllowOlder(..), AllowNewer (..))

----------------------------------------
-- Resolving configuration to settings
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
6 changes: 4 additions & 2 deletions cabal-install/src/Distribution/Client/Setup.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 =
Expand Down
4 changes: 1 addition & 3 deletions cabal-install/src/Distribution/Client/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
Loading

0 comments on commit cc251c0

Please sign in to comment.