Commit 3722566d authored by Andres Löh's avatar Andres Löh

Added flag --independent-goals (not yet functioning correctly)

parent fbfdeaf5
......@@ -43,6 +43,7 @@ module Distribution.Client.Dependency (
addPreferences,
setPreferenceDefault,
setReorderGoals,
setIndependentGoals,
setAvoidReinstalls,
setMaxBackjumps,
addSourcePackages,
......@@ -103,6 +104,7 @@ data DepResolverParams = DepResolverParams {
depResolverInstalledPkgIndex :: InstalledPackageIndex.PackageIndex,
depResolverSourcePkgIndex :: PackageIndex.PackageIndex SourcePackage,
depResolverReorderGoals :: Bool,
depResolverIndependentGoals :: Bool,
depResolverAvoidReinstalls :: Bool,
depResolverMaxBackjumps :: Maybe Int
}
......@@ -134,6 +136,7 @@ basicDepResolverParams installedPkgIndex sourcePkgIndex =
depResolverInstalledPkgIndex = installedPkgIndex,
depResolverSourcePkgIndex = sourcePkgIndex,
depResolverReorderGoals = False,
depResolverIndependentGoals = False,
depResolverAvoidReinstalls = False,
depResolverMaxBackjumps = Nothing
}
......@@ -174,6 +177,12 @@ setReorderGoals b params =
depResolverReorderGoals = b
}
setIndependentGoals :: Bool -> DepResolverParams -> DepResolverParams
setIndependentGoals b params =
params {
depResolverIndependentGoals = b
}
setAvoidReinstalls :: Bool -> DepResolverParams -> DepResolverParams
setAvoidReinstalls b params =
params {
......@@ -317,7 +326,7 @@ resolveDependencies platform comp params
resolveDependencies platform comp params =
fmap (mkInstallPlan platform comp)
$ defaultResolver (SolverConfig reorderGoals noReinstalls maxBkjumps)
$ defaultResolver (SolverConfig reorderGoals indGoals noReinstalls maxBkjumps)
platform comp installedPkgIndex sourcePkgIndex
preferences constraints targets
where
......@@ -327,6 +336,7 @@ resolveDependencies platform comp params =
installedPkgIndex
sourcePkgIndex
reorderGoals
indGoals
noReinstalls
maxBkjumps = dontUpgradeBasePackage
. hideBrokenInstalledPackages
......@@ -404,7 +414,7 @@ resolveWithoutDependencies :: DepResolverParams
-> Either [ResolveNoDepsError] [SourcePackage]
resolveWithoutDependencies (DepResolverParams targets constraints
prefs defpref installedPkgIndex sourcePkgIndex
_reorderGoals _avoidReinstalls _maxBackjumps) =
_reorderGoals _indGoals _avoidReinstalls _maxBjumps) =
collectEithers (map selectPackage targets)
where
selectPackage :: PackageName -> Either ResolveNoDepsError SourcePackage
......
......@@ -5,7 +5,6 @@ module Distribution.Client.Dependency.Modular.Builder where
import Control.Monad.Reader hiding (sequence, mapM)
import Data.List as L
import Data.Map as M
import Data.Set as S
import Prelude hiding (sequence, mapM)
import Distribution.Client.Dependency.Modular.Dependency
......@@ -111,11 +110,13 @@ build = ana go
-- | Interface to the tree builder. Just takes an index and a list of package names,
-- and computes the initial state and then the tree from there.
buildTree :: Index -> [PN] -> Tree (QGoalReasons, Scope)
buildTree idx igs =
build (BS idx emptyScope
buildTree :: Index -> Bool -> [PN] -> Tree (QGoalReasons, Scope)
buildTree idx ind igs =
build (BS idx sc
(M.fromList (L.map (\ qpn -> (qpn, [])) qpns))
(P.fromList (L.map (\ qpn -> (OpenGoal (Simple (Dep qpn (Constrained []))) [UserGoal], ())) qpns))
Goals)
where
qpns = L.map (qualify emptyScope) igs
sc | ind = makeIndependent igs
| otherwise = emptyScope
qpns = L.map (qualify sc) igs
......@@ -95,6 +95,11 @@ type Scope = Map PN PP
emptyScope :: Scope
emptyScope = M.empty
-- | Create artificial parents for each of the package names, making
-- them all independent.
makeIndependent :: [PN] -> Scope
makeIndependent ps = L.foldl (\ sc (n, p) -> M.insert p [PackageName (show n)] sc) emptyScope (zip ([0..] :: [Int]) ps)
qualify :: Scope -> PN -> QPN
qualify sc pn = Q (findWithDefault [] pn sc) pn
......
......@@ -19,6 +19,7 @@ import Distribution.Client.Dependency.Modular.Validate
data SolverConfig = SolverConfig {
preferEasyGoalChoices :: Bool,
independentGoals :: Bool,
avoidReinstalls :: Bool,
maxBackjumps :: Maybe Int
}
......@@ -46,4 +47,4 @@ solve sc idx userPrefs userConstraints userGoals =
validateTree idx
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
buildPhase = buildTree idx (independentGoals sc) userGoals
......@@ -238,6 +238,8 @@ planPackages comp configFlags configExFlags installFlags
setMaxBackjumps (if maxBackjumps < 0 then Nothing
else Just maxBackjumps)
. setIndependentGoals independentGoals
. setReorderGoals reorderGoals
. setAvoidReinstalls avoidReinstalls
......@@ -318,12 +320,13 @@ planPackages comp configFlags configExFlags installFlags
, depid <- depids
, packageName depid `elem` targetnames ]
reinstall = fromFlag (installReinstall installFlags)
reorderGoals = fromFlag (installReorderGoals installFlags)
avoidReinstalls = fromFlag (installAvoidReinstalls installFlags)
maxBackjumps = fromFlag (installMaxBackjumps installFlags)
upgradeDeps = fromFlag (installUpgradeDeps installFlags)
onlyDeps = fromFlag (installOnlyDeps installFlags)
reinstall = fromFlag (installReinstall installFlags)
reorderGoals = fromFlag (installReorderGoals installFlags)
independentGoals = fromFlag (installIndependentGoals installFlags)
avoidReinstalls = fromFlag (installAvoidReinstalls installFlags)
maxBackjumps = fromFlag (installMaxBackjumps installFlags)
upgradeDeps = fromFlag (installUpgradeDeps installFlags)
onlyDeps = fromFlag (installOnlyDeps installFlags)
-- ------------------------------------------------------------
-- * Informational messages
......
......@@ -570,22 +570,23 @@ instance Monoid InfoFlags where
-- | Install takes the same flags as configure along with a few extras.
--
data InstallFlags = InstallFlags {
installDocumentation :: Flag Bool,
installHaddockIndex :: Flag PathTemplate,
installDryRun :: Flag Bool,
installReinstall :: Flag Bool,
installAvoidReinstalls :: Flag Bool,
installMaxBackjumps :: Flag Int,
installUpgradeDeps :: Flag Bool,
installReorderGoals :: Flag Bool,
installOnly :: Flag Bool,
installOnlyDeps :: Flag Bool,
installRootCmd :: Flag String,
installSummaryFile :: [PathTemplate],
installLogFile :: Flag PathTemplate,
installBuildReports :: Flag ReportLevel,
installSymlinkBinDir :: Flag FilePath,
installOneShot :: Flag Bool
installDocumentation :: Flag Bool,
installHaddockIndex :: Flag PathTemplate,
installDryRun :: Flag Bool,
installReinstall :: Flag Bool,
installAvoidReinstalls :: Flag Bool,
installMaxBackjumps :: Flag Int,
installUpgradeDeps :: Flag Bool,
installReorderGoals :: Flag Bool,
installIndependentGoals :: Flag Bool,
installOnly :: Flag Bool,
installOnlyDeps :: Flag Bool,
installRootCmd :: Flag String,
installSummaryFile :: [PathTemplate],
installLogFile :: Flag PathTemplate,
installBuildReports :: Flag ReportLevel,
installSymlinkBinDir :: Flag FilePath,
installOneShot :: Flag Bool
}
defaultInstallFlags :: InstallFlags
......@@ -598,6 +599,7 @@ defaultInstallFlags = InstallFlags {
installMaxBackjumps = Flag defaultMaxBackjumps,
installUpgradeDeps = Flag False,
installReorderGoals = Flag False,
installIndependentGoals= Flag False,
installOnly = Flag False,
installOnlyDeps = Flag False,
installRootCmd = mempty,
......@@ -702,10 +704,15 @@ installOptions showOrParseArgs =
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."
"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 [] ["independent-goals"]
"Treat several goals on the command line as independent. If several goals depend on the same package, different versions can be chosen."
installIndependentGoals (\v flags -> flags { installIndependentGoals = v })
trueArg
, option [] ["only-dependencies"]
"Install only the dependencies necessary to build the given packages"
installOnlyDeps (\v flags -> flags { installOnlyDeps = v })
......@@ -764,6 +771,7 @@ instance Monoid InstallFlags where
installMaxBackjumps = mempty,
installUpgradeDeps = mempty,
installReorderGoals = mempty,
installIndependentGoals= mempty,
installOnly = mempty,
installOnlyDeps = mempty,
installRootCmd = mempty,
......@@ -782,6 +790,7 @@ instance Monoid InstallFlags where
installMaxBackjumps = combine installMaxBackjumps,
installUpgradeDeps = combine installUpgradeDeps,
installReorderGoals = combine installReorderGoals,
installIndependentGoals= combine installIndependentGoals,
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