Commit 5eeae079 authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

Support 'Setup.hs configure --allow-newer'.

parent ac039772
......@@ -48,6 +48,7 @@ module Distribution.Simple.Configure (configure,
ConfigStateFileError(..),
tryGetConfigStateFile,
platformDefines,
relaxPackageDeps,
)
where
......@@ -787,6 +788,19 @@ dependencySatisfiable
isInternalDep = not . null
$ PackageIndex.lookupDependency internalPackageSet d
-- | Relax the dependencies of this package if needed
relaxPackageDeps :: AllowNewer -> GenericPackageDescription
-> GenericPackageDescription
relaxPackageDeps AllowNewerNone = id
relaxPackageDeps AllowNewerAll =
transformAllBuildDepends $ \(Dependency pkgName verRange) ->
Dependency pkgName (removeUpperBound verRange)
relaxPackageDeps (AllowNewerSome pkgNames) =
transformAllBuildDepends $ \d@(Dependency pkgName verRange) ->
if pkgName `elem` pkgNames
then Dependency pkgName (removeUpperBound verRange)
else d
-- | Finalize a generic package description. The workhorse is
-- 'finalizePackageDescription' but there's a bit of other nattering
-- about necessary.
......@@ -813,8 +827,15 @@ configureFinalizedPackage verbosity cfg
flaggedBenchmarks = map (\(n, bm) ->
(n, mapTreeData enableBenchmark bm))
(condBenchmarks pkg_descr0)
pkg_descr0'' = pkg_descr0 { condTestSuites = flaggedTests
, condBenchmarks = flaggedBenchmarks }
pkg_descr0''' =
-- Ignore '--allow-newer' when we're given '--exact-configuration'.
if fromFlagOrDefault False (configExactConfiguration cfg)
then pkg_descr0
else relaxPackageDeps
(fromFlagOrDefault AllowNewerNone $ configAllowNewer cfg)
pkg_descr0
pkg_descr0'' = pkg_descr0''' { condTestSuites = flaggedTests
, condBenchmarks = flaggedBenchmarks }
(pkg_descr0', flags) <-
case finalizePackageDescription
......
......@@ -96,12 +96,12 @@ import qualified Distribution.PackageDescription as PD
, GenericPackageDescription(..)
, Flag(flagName), FlagName(..) )
import Distribution.PackageDescription.Configuration
( finalizePackageDescription, transformAllBuildDepends )
( finalizePackageDescription )
import Distribution.Client.PackageUtils
( externalBuildDepends )
import Distribution.Version
( VersionRange, anyVersion, thisVersion, withinRange
, removeUpperBound, simplifyVersionRange )
, simplifyVersionRange )
import Distribution.Compiler
( CompilerInfo(..) )
import Distribution.System
......@@ -110,6 +110,8 @@ import Distribution.Client.Utils
( duplicates, duplicatesBy, mergeBy, MergeResult(..) )
import Distribution.Simple.Utils
( comparing, warn, info )
import Distribution.Simple.Configure
( relaxPackageDeps )
import Distribution.Simple.Setup
( AllowNewer(..) )
import Distribution.Text
......@@ -363,35 +365,17 @@ hideBrokenInstalledPackages params =
-- 'addSourcePackages' won't have upper bounds in dependencies relaxed.
--
removeUpperBounds :: AllowNewer -> DepResolverParams -> DepResolverParams
removeUpperBounds allowNewer params =
removeUpperBounds AllowNewerNone params = params
removeUpperBounds allowNewer params =
params {
depResolverSourcePkgIndex = sourcePkgIndex'
}
where
sourcePkgIndex = depResolverSourcePkgIndex params
sourcePkgIndex' = case allowNewer of
AllowNewerNone -> sourcePkgIndex
AllowNewerAll -> fmap relaxAllPackageDeps sourcePkgIndex
AllowNewerSome pkgs -> fmap (relaxSomePackageDeps pkgs) sourcePkgIndex
relaxAllPackageDeps :: SourcePackage -> SourcePackage
relaxAllPackageDeps = onAllBuildDepends doRelax
where
doRelax (Dependency pkgName verRange) =
Dependency pkgName (removeUpperBound verRange)
sourcePkgIndex' = fmap relaxDeps $ depResolverSourcePkgIndex params
relaxSomePackageDeps :: [PackageName] -> SourcePackage -> SourcePackage
relaxSomePackageDeps pkgNames = onAllBuildDepends doRelax
where
doRelax d@(Dependency pkgName verRange)
| pkgName `elem` pkgNames = Dependency pkgName
(removeUpperBound verRange)
| otherwise = d
onAllBuildDepends :: (Dependency -> Dependency)
-> SourcePackage -> SourcePackage
onAllBuildDepends f srcPkg = srcPkg {
packageDescription = transformAllBuildDepends f
relaxDeps :: SourcePackage -> SourcePackage
relaxDeps srcPkg = srcPkg {
packageDescription = relaxPackageDeps allowNewer
(packageDescription srcPkg)
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment