Commit 03615ba2 authored by Andres Löh's avatar Andres Löh

Added a --reorder-goals flag.

parent c5f1446b
......@@ -42,6 +42,7 @@ module Distribution.Client.Dependency (
addConstraints,
addPreferences,
setPreferenceDefault,
setReorderGoals,
setAvoidReinstalls,
addSourcePackages,
hideInstalledPackagesSpecificByInstalledPackageId,
......@@ -50,7 +51,8 @@ module Distribution.Client.Dependency (
) where
-- import Distribution.Client.Dependency.TopDown (topDownResolver)
import Distribution.Client.Dependency.Modular (modularResolver)
import Distribution.Client.Dependency.Modular
( modularResolver, SolverConfig(..) )
import qualified Distribution.Client.PackageIndex as PackageIndex
import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex
import qualified Distribution.Client.InstallPlan as InstallPlan
......@@ -99,6 +101,7 @@ data DepResolverParams = DepResolverParams {
depResolverPreferenceDefault :: PackagesPreferenceDefault,
depResolverInstalledPkgIndex :: InstalledPackageIndex.PackageIndex,
depResolverSourcePkgIndex :: PackageIndex.PackageIndex SourcePackage,
depResolverReorderGoals :: Bool,
depResolverAvoidReinstalls :: Bool
}
......@@ -128,6 +131,7 @@ basicDepResolverParams installedPkgIndex sourcePkgIndex =
depResolverPreferenceDefault = PreferLatestForSelected,
depResolverInstalledPkgIndex = installedPkgIndex,
depResolverSourcePkgIndex = sourcePkgIndex,
depResolverReorderGoals = False,
depResolverAvoidReinstalls = False
}
......@@ -161,6 +165,12 @@ setPreferenceDefault preferenceDefault params =
depResolverPreferenceDefault = preferenceDefault
}
setReorderGoals :: Bool -> DepResolverParams -> DepResolverParams
setReorderGoals b params =
params {
depResolverReorderGoals = b
}
setAvoidReinstalls :: Bool -> DepResolverParams -> DepResolverParams
setAvoidReinstalls b params =
params {
......@@ -276,7 +286,7 @@ standardInstallPolicy
-- * Interface to the standard resolver
-- ------------------------------------------------------------
defaultResolver :: Bool -> DependencyResolver
defaultResolver :: SolverConfig -> DependencyResolver
defaultResolver = modularResolver
-- | Run the dependency solver.
......@@ -298,7 +308,7 @@ resolveDependencies platform comp params
resolveDependencies platform comp params =
fmap (mkInstallPlan platform comp)
$ defaultResolver avoidReinstalls
$ defaultResolver (SolverConfig reorderGoals noReinstalls)
platform comp installedPkgIndex sourcePkgIndex
preferences constraints targets
where
......@@ -307,7 +317,8 @@ resolveDependencies platform comp params =
prefs defpref
installedPkgIndex
sourcePkgIndex
avoidReinstalls = dontUpgradeBasePackage
reorderGoals
noReinstalls = dontUpgradeBasePackage
. hideBrokenInstalledPackages
$ params
......@@ -383,7 +394,7 @@ resolveWithoutDependencies :: DepResolverParams
-> Either [ResolveNoDepsError] [SourcePackage]
resolveWithoutDependencies (DepResolverParams targets constraints
prefs defpref installedPkgIndex sourcePkgIndex
_avoidReinstalls) =
_reorderGoals _avoidReinstalls) =
collectEithers (map selectPackage targets)
where
selectPackage :: PackageName -> Either ResolveNoDepsError SourcePackage
......
module Distribution.Client.Dependency.Modular where
module Distribution.Client.Dependency.Modular
( modularResolver, SolverConfig(..)) where
-- Here, we try to map between the external cabal-install solver
-- interface and the internal interface that the solver actually
......@@ -23,7 +24,7 @@ import Distribution.Client.Dependency.Modular.Log
import Distribution.Client.Dependency.Modular.Package
( PN )
import Distribution.Client.Dependency.Modular.Solver
( defaultSolver )
( SolverConfig(..), solve )
import Distribution.Client.Dependency.Types
( DependencyResolver, PackageConstraint(..) )
import Distribution.Client.InstallPlan
......@@ -33,11 +34,11 @@ import Distribution.System
-- | Ties the two worlds together: classic cabal-install vs. the modular
-- solver. Performs the necessary translations before and after.
modularResolver :: Bool -> DependencyResolver
modularResolver ar (Platform arch os) cid iidx sidx pprefs pcs pns =
modularResolver :: SolverConfig -> DependencyResolver
modularResolver sc (Platform arch os) cid iidx sidx pprefs pcs pns =
fmap (uncurry postprocess) $ -- convert install plan
logToProgress $ -- convert log format into progress format
defaultSolver ar idx pprefs gcs pns
solve sc idx pprefs gcs pns
where
-- Indices have to be converted into solver-specific uniform index.
idx = convPIs os arch cid iidx sidx
......
......@@ -19,17 +19,9 @@ import Distribution.Client.Dependency.Modular.Validate
data SolverConfig = SolverConfig {
preferEasyGoalChoices :: Bool,
pStrategy :: PackagesPreferenceDefault,
avoidReinstalls :: Bool
}
defaultSolverConfig :: Bool -> SolverConfig
defaultSolverConfig ar = SolverConfig {
preferEasyGoalChoices = False,
pStrategy = PreferLatestForSelected, -- latest for goals only
avoidReinstalls = ar
}
solve :: SolverConfig -> -- solver parameters
Index -> -- all available packages as an index
(PN -> PackagePreferences) -> -- preferences
......@@ -54,12 +46,3 @@ solve sc idx userPrefs userConstraints userGoals =
prunePhase = (if avoidReinstalls sc then P.avoidReinstalls (const True) else id) .
P.requireInstalled (== PackageName "base") -- never try to install a new "base"
buildPhase = buildTree idx userGoals
-- | For cabal-install integration.
defaultSolver :: Bool ->
Index -> -- all available packages as an index
(PN -> PackagePreferences) -> -- preferences
Map PN PackageConstraint -> -- global constraints
[PN] -> -- global goals
Log Message (Assignment, RevDepMap)
defaultSolver ar = solve (defaultSolverConfig ar)
......@@ -235,7 +235,9 @@ planPackages comp configFlags configExFlags installFlags
where
resolverParams =
setAvoidReinstalls avoidReinstalls
setReorderGoals reorderGoals
. setAvoidReinstalls avoidReinstalls
. setPreferenceDefault (if upgradeDeps then PreferAllLatest
else PreferLatestForSelected)
......@@ -314,6 +316,7 @@ planPackages comp configFlags configExFlags installFlags
, packageName depid `elem` targetnames ]
reinstall = fromFlag (installReinstall installFlags)
reorderGoals = fromFlag (installReorderGoals installFlags)
avoidReinstalls = fromFlag (installAvoidReinstalls installFlags)
upgradeDeps = fromFlag (installUpgradeDeps installFlags)
onlyDeps = fromFlag (installOnlyDeps installFlags)
......
......@@ -576,6 +576,7 @@ data InstallFlags = InstallFlags {
installReinstall :: Flag Bool,
installAvoidReinstalls :: Flag Bool,
installUpgradeDeps :: Flag Bool,
installReorderGoals :: Flag Bool,
installOnly :: Flag Bool,
installOnlyDeps :: Flag Bool,
installRootCmd :: Flag String,
......@@ -594,6 +595,7 @@ defaultInstallFlags = InstallFlags {
installReinstall = Flag False,
installAvoidReinstalls = Flag False,
installUpgradeDeps = Flag False,
installReorderGoals = Flag False,
installOnly = Flag False,
installOnlyDeps = Flag False,
installRootCmd = mempty,
......@@ -690,6 +692,10 @@ installOptions showOrParseArgs =
installUpgradeDeps (\v flags -> flags { installUpgradeDeps = v })
trueArg
, option [] ["reorder-goals"]
"Experimental: Try to reorder goals according to certain heuristics. Slows things down on average, but may make backtracking faster for some packages."
installReorderGoals (\v flags -> flags { installReorderGoals = v })
trueArg
, option [] ["only-dependencies"]
"Install only the dependencies necessary to build the given packages"
......@@ -747,6 +753,7 @@ instance Monoid InstallFlags where
installReinstall = mempty,
installAvoidReinstalls = mempty,
installUpgradeDeps = mempty,
installReorderGoals = mempty,
installOnly = mempty,
installOnlyDeps = mempty,
installRootCmd = mempty,
......@@ -763,6 +770,7 @@ instance Monoid InstallFlags where
installReinstall = combine installReinstall,
installAvoidReinstalls = combine installAvoidReinstalls,
installUpgradeDeps = combine installUpgradeDeps,
installReorderGoals = combine installReorderGoals,
installOnly = combine installOnly,
installOnlyDeps = combine installOnlyDeps,
installRootCmd = combine installRootCmd,
......
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