Commit ebef7cd0 authored by Andres Löh's avatar Andres Löh

make max backjumps configurable

parent 749e33b9
......@@ -44,6 +44,7 @@ module Distribution.Client.Dependency (
setPreferenceDefault,
setReorderGoals,
setAvoidReinstalls,
setMaxBackjumps,
addSourcePackages,
hideInstalledPackagesSpecificByInstalledPackageId,
hideInstalledPackagesSpecificBySourcePackageId,
......@@ -102,7 +103,8 @@ data DepResolverParams = DepResolverParams {
depResolverInstalledPkgIndex :: InstalledPackageIndex.PackageIndex,
depResolverSourcePkgIndex :: PackageIndex.PackageIndex SourcePackage,
depResolverReorderGoals :: Bool,
depResolverAvoidReinstalls :: Bool
depResolverAvoidReinstalls :: Bool,
depResolverMaxBackjumps :: Maybe Int
}
......@@ -132,7 +134,8 @@ basicDepResolverParams installedPkgIndex sourcePkgIndex =
depResolverInstalledPkgIndex = installedPkgIndex,
depResolverSourcePkgIndex = sourcePkgIndex,
depResolverReorderGoals = False,
depResolverAvoidReinstalls = False
depResolverAvoidReinstalls = False,
depResolverMaxBackjumps = Nothing
}
addTargets :: [PackageName]
......@@ -177,6 +180,12 @@ setAvoidReinstalls b params =
depResolverAvoidReinstalls = b
}
setMaxBackjumps :: Maybe Int -> DepResolverParams -> DepResolverParams
setMaxBackjumps n params =
params {
depResolverMaxBackjumps = n
}
dontUpgradeBasePackage :: DepResolverParams -> DepResolverParams
dontUpgradeBasePackage params =
addConstraints extraConstraints params
......@@ -308,7 +317,7 @@ resolveDependencies platform comp params
resolveDependencies platform comp params =
fmap (mkInstallPlan platform comp)
$ defaultResolver (SolverConfig reorderGoals noReinstalls)
$ defaultResolver (SolverConfig reorderGoals noReinstalls maxBkjumps)
platform comp installedPkgIndex sourcePkgIndex
preferences constraints targets
where
......@@ -318,7 +327,8 @@ resolveDependencies platform comp params =
installedPkgIndex
sourcePkgIndex
reorderGoals
noReinstalls = dontUpgradeBasePackage
noReinstalls
maxBkjumps = dontUpgradeBasePackage
. hideBrokenInstalledPackages
$ params
......@@ -394,7 +404,7 @@ resolveWithoutDependencies :: DepResolverParams
-> Either [ResolveNoDepsError] [SourcePackage]
resolveWithoutDependencies (DepResolverParams targets constraints
prefs defpref installedPkgIndex sourcePkgIndex
_reorderGoals _avoidReinstalls) =
_reorderGoals _avoidReinstalls _maxBackjumps) =
collectEithers (map selectPackage targets)
where
selectPackage :: PackageName -> Either ResolveNoDepsError SourcePackage
......
......@@ -36,8 +36,8 @@ import Distribution.System
-- solver. Performs the necessary translations before and after.
modularResolver :: SolverConfig -> DependencyResolver
modularResolver sc (Platform arch os) cid iidx sidx pprefs pcs pns =
fmap (uncurry postprocess) $ -- convert install plan
logToProgress (Just 100) $ -- convert log format into progress format, TODO: make backjump max configurable
fmap (uncurry postprocess) $ -- convert install plan
logToProgress (maxBackjumps sc) $ -- convert log format into progress format
solve sc idx pprefs gcs pns
where
-- Indices have to be converted into solver-specific uniform index.
......
......@@ -19,7 +19,8 @@ import Distribution.Client.Dependency.Modular.Validate
data SolverConfig = SolverConfig {
preferEasyGoalChoices :: Bool,
avoidReinstalls :: Bool
avoidReinstalls :: Bool,
maxBackjumps :: Maybe Int
}
solve :: SolverConfig -> -- solver parameters
......
......@@ -235,7 +235,10 @@ planPackages comp configFlags configExFlags installFlags
where
resolverParams =
setReorderGoals reorderGoals
setMaxBackjumps (if maxBackjumps < 0 then Nothing
else Just maxBackjumps)
. setReorderGoals reorderGoals
. setAvoidReinstalls avoidReinstalls
......@@ -318,6 +321,7 @@ planPackages comp configFlags configExFlags installFlags
reinstall = fromFlag (installReinstall installFlags)
reorderGoals = fromFlag (installReorderGoals installFlags)
avoidReinstalls = fromFlag (installAvoidReinstalls installFlags)
maxBackjumps = fromFlag (installMaxBackjumps installFlags)
upgradeDeps = fromFlag (installUpgradeDeps installFlags)
onlyDeps = fromFlag (installOnlyDeps installFlags)
......
......@@ -65,7 +65,7 @@ import Distribution.Text
import Distribution.ReadE
( ReadE(..), readP_to_E, succeedReadE )
import qualified Distribution.Compat.ReadP as Parse
( ReadP, readP_to_S, char, munch1, pfail, (+++) )
( ReadP, readP_to_S, readS_to_P, char, munch1, pfail, (+++) )
import Distribution.Verbosity
( Verbosity, normal )
import Distribution.Simple.Utils
......@@ -575,6 +575,7 @@ data InstallFlags = InstallFlags {
installDryRun :: Flag Bool,
installReinstall :: Flag Bool,
installAvoidReinstalls :: Flag Bool,
installMaxBackjumps :: Flag Int,
installUpgradeDeps :: Flag Bool,
installReorderGoals :: Flag Bool,
installOnly :: Flag Bool,
......@@ -594,6 +595,7 @@ defaultInstallFlags = InstallFlags {
installDryRun = Flag False,
installReinstall = Flag False,
installAvoidReinstalls = Flag False,
installMaxBackjumps = Flag defaultMaxBackjumps,
installUpgradeDeps = Flag False,
installReorderGoals = Flag False,
installOnly = Flag False,
......@@ -608,7 +610,7 @@ defaultInstallFlags = InstallFlags {
where
docIndexFile = toPathTemplate ("$datadir" </> "doc" </> "index.html")
installCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
installCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags)
installCommand = CommandUI {
commandName = "install",
commandSynopsis = "Installs a list of packages.",
......@@ -687,6 +689,13 @@ installOptions showOrParseArgs =
installAvoidReinstalls (\v flags -> flags { installAvoidReinstalls = v })
trueArg
, option [] ["max-backjumps"]
("Maximum number of backjumps allowed while solving (default: " ++ show defaultMaxBackjumps ++ "). Use a negative number to enable unlimited backtracking. Use 0 to disable backtracking completely.")
installMaxBackjumps (\v flags -> flags { installMaxBackjumps = v })
(reqArg "NUM" (readP_to_E ("Cannot parse number: "++)
(fmap toFlag (Parse.readS_to_P reads)))
(map show . flagToList))
, option [] ["upgrade-dependencies"]
"Pick the latest version for all dependencies, rather than trying to pick an installed version."
installUpgradeDeps (\v flags -> flags { installUpgradeDeps = v })
......@@ -752,6 +761,7 @@ instance Monoid InstallFlags where
installDryRun = mempty,
installReinstall = mempty,
installAvoidReinstalls = mempty,
installMaxBackjumps = mempty,
installUpgradeDeps = mempty,
installReorderGoals = mempty,
installOnly = mempty,
......@@ -769,6 +779,7 @@ instance Monoid InstallFlags where
installDryRun = combine installDryRun,
installReinstall = combine installReinstall,
installAvoidReinstalls = combine installAvoidReinstalls,
installMaxBackjumps = combine installMaxBackjumps,
installUpgradeDeps = combine installUpgradeDeps,
installReorderGoals = combine installReorderGoals,
installOnly = combine installOnly,
......
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