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

adding a solver flag for shadowing of installed packages

parent 7db70840
......@@ -46,6 +46,7 @@ module Distribution.Client.Dependency (
setReorderGoals,
setIndependentGoals,
setAvoidReinstalls,
setShadowPkgs,
setMaxBackjumps,
addSourcePackages,
hideInstalledPackagesSpecificByInstalledPackageId,
......@@ -111,6 +112,7 @@ data DepResolverParams = DepResolverParams {
depResolverReorderGoals :: Bool,
depResolverIndependentGoals :: Bool,
depResolverAvoidReinstalls :: Bool,
depResolverShadowPkgs :: Bool,
depResolverMaxBackjumps :: Maybe Int
}
......@@ -143,6 +145,7 @@ basicDepResolverParams installedPkgIndex sourcePkgIndex =
depResolverReorderGoals = False,
depResolverIndependentGoals = False,
depResolverAvoidReinstalls = False,
depResolverShadowPkgs = False,
depResolverMaxBackjumps = Nothing
}
......@@ -194,6 +197,12 @@ setAvoidReinstalls b params =
depResolverAvoidReinstalls = b
}
setShadowPkgs :: Bool -> DepResolverParams -> DepResolverParams
setShadowPkgs b params =
params {
depResolverShadowPkgs = b
}
setMaxBackjumps :: Maybe Int -> DepResolverParams -> DepResolverParams
setMaxBackjumps n params =
params {
......@@ -344,7 +353,7 @@ resolveDependencies platform comp _solver params
resolveDependencies platform comp solver params =
fmap (mkInstallPlan platform comp)
$ runSolver solver (SolverConfig reorderGoals indGoals noReinstalls maxBkjumps)
$ runSolver solver (SolverConfig reorderGoals indGoals noReinstalls shadowing maxBkjumps)
platform comp installedPkgIndex sourcePkgIndex
preferences constraints targets
where
......@@ -356,6 +365,7 @@ resolveDependencies platform comp solver params =
reorderGoals
indGoals
noReinstalls
shadowing
maxBkjumps = dontUpgradeBasePackage
. hideBrokenInstalledPackages
$ params
......@@ -432,7 +442,7 @@ resolveWithoutDependencies :: DepResolverParams
-> Either [ResolveNoDepsError] [SourcePackage]
resolveWithoutDependencies (DepResolverParams targets constraints
prefs defpref installedPkgIndex sourcePkgIndex
_reorderGoals _indGoals _avoidReinstalls _maxBjumps) =
_reorderGoals _indGoals _avoidReinstalls _shadowing _maxBjumps) =
collectEithers (map selectPackage targets)
where
selectPackage :: PackageName -> Either ResolveNoDepsError SourcePackage
......
......@@ -41,7 +41,7 @@ modularResolver sc (Platform arch os) cid iidx sidx pprefs pcs 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
idx = convPIs os arch cid (shadowPkgs sc) iidx sidx
-- Constraints have to be converted into a finite map indexed by PN.
gcs = M.fromListWith (++) (map (\ pc -> (pcName pc, [pc])) pcs)
......
......@@ -31,17 +31,17 @@ import Distribution.Client.Dependency.Modular.Version
-- packages if there are several installed packages of the same version.
-- There are currently some shortcomings in both GHC and Cabal in
-- resolving these situations. However, the right thing to do is to
-- fix the problem there, so for now, shadowing is disabled here --
-- although it's easy enough to activate.
convPIs :: OS -> Arch -> CompilerId ->
-- fix the problem there, so for now, shadowing is only activated if
-- explicitly requested.
convPIs :: OS -> Arch -> CompilerId -> Bool ->
SI.PackageIndex -> CI.PackageIndex SourcePackage -> Index
convPIs os arch cid iidx sidx =
mkIndex (convIPI' iidx ++ convSPI' os arch cid sidx)
convPIs os arch cid sip iidx sidx =
mkIndex (convIPI' sip iidx ++ convSPI' os arch cid sidx)
-- | Convert a Cabal installed package index to the simpler,
-- more uniform index format of the solver.
convIPI' :: SI.PackageIndex -> [(PN, I, PInfo)]
convIPI' idx = combine (convIP idx) . versioned . SI.allPackagesByName $ idx
convIPI' :: Bool -> SI.PackageIndex -> [(PN, I, PInfo)]
convIPI' sip idx = combine (convIP idx) . versioned . SI.allPackagesByName $ idx
where
-- group installed packages by version
versioned = L.map (groupBy (equating packageVersion))
......@@ -49,12 +49,12 @@ convIPI' idx = combine (convIP idx) . versioned . SI.allPackagesByName $ idx
-- the same version
combine f pkgs = [ g (f p) | pbn <- pkgs, pbv <- pbn,
(g, p) <- zip (id : repeat shadow) pbv ]
-- shadowing is recorded in the package info -- currently disabled
shadow = id
-- shadow (pn, i, PInfo fdeps fds encs _) = (pn, i, PInfo fdeps fds encs (Just Shadowed))
-- shadowing is recorded in the package info
shadow (pn, i, PInfo fdeps fds encs _) | sip = (pn, i, PInfo fdeps fds encs (Just Shadowed))
shadow x = x
convIPI :: SI.PackageIndex -> Index
convIPI = mkIndex . convIPI'
convIPI :: Bool -> SI.PackageIndex -> Index
convIPI sip = mkIndex . convIPI' sip
-- | Convert a single installed package into the solver-specific format.
convIP :: SI.PackageIndex -> InstalledPackageInfo -> (PN, I, PInfo)
......
......@@ -20,6 +20,7 @@ data SolverConfig = SolverConfig {
preferEasyGoalChoices :: Bool,
independentGoals :: Bool,
avoidReinstalls :: Bool,
shadowPkgs :: Bool,
maxBackjumps :: Maybe Int
}
......
......@@ -149,6 +149,8 @@ planPackages verbosity comp fetchFlags
. setReorderGoals reorderGoals
. setShadowPkgs shadowPkgs
-- Reinstall the targets given on the command line so that the dep
-- resolver will decide that they need fetching, even if they're
-- already installed. Since we want to get the source packages of
......@@ -162,6 +164,7 @@ planPackages verbosity comp fetchFlags
reorderGoals = fromFlag (fetchReorderGoals fetchFlags)
independentGoals = fromFlag (fetchIndependentGoals fetchFlags)
shadowPkgs = fromFlag (fetchShadowPkgs fetchFlags)
maxBackjumps = fromFlag (fetchMaxBackjumps fetchFlags)
......
......@@ -252,6 +252,8 @@ planPackages comp solver configFlags configExFlags installFlags
. setAvoidReinstalls avoidReinstalls
. setShadowPkgs shadowPkgs
. setPreferenceDefault (if upgradeDeps then PreferAllLatest
else PreferLatestForSelected)
......@@ -318,6 +320,7 @@ planPackages comp solver configFlags configExFlags installFlags
reorderGoals = fromFlag (installReorderGoals installFlags)
independentGoals = fromFlag (installIndependentGoals installFlags)
avoidReinstalls = fromFlag (installAvoidReinstalls installFlags)
shadowPkgs = fromFlag (installShadowPkgs installFlags)
maxBackjumps = fromFlag (installMaxBackjumps installFlags)
upgradeDeps = fromFlag (installUpgradeDeps installFlags)
onlyDeps = fromFlag (installOnlyDeps installFlags)
......
......@@ -310,6 +310,7 @@ data FetchFlags = FetchFlags {
fetchMaxBackjumps :: Flag Int,
fetchReorderGoals :: Flag Bool,
fetchIndependentGoals :: Flag Bool,
fetchShadowPkgs :: Flag Bool,
fetchVerbosity :: Flag Verbosity
}
......@@ -322,6 +323,7 @@ defaultFetchFlags = FetchFlags {
fetchMaxBackjumps = Flag defaultMaxBackjumps,
fetchReorderGoals = Flag False,
fetchIndependentGoals = Flag False,
fetchShadowPkgs = Flag False,
fetchVerbosity = toFlag normal
}
......@@ -361,6 +363,7 @@ fetchCommand = CommandUI {
optionSolverFlags fetchMaxBackjumps (\v flags -> flags { fetchMaxBackjumps = v })
fetchReorderGoals (\v flags -> flags { fetchReorderGoals = v })
fetchIndependentGoals (\v flags -> flags { fetchIndependentGoals = v })
fetchShadowPkgs (\v flags -> flags { fetchShadowPkgs = v })
}
......@@ -599,6 +602,7 @@ data InstallFlags = InstallFlags {
installMaxBackjumps :: Flag Int,
installReorderGoals :: Flag Bool,
installIndependentGoals :: Flag Bool,
installShadowPkgs :: Flag Bool,
installReinstall :: Flag Bool,
installAvoidReinstalls :: Flag Bool,
installOverrideReinstall :: Flag Bool,
......@@ -621,6 +625,7 @@ defaultInstallFlags = InstallFlags {
installMaxBackjumps = Flag defaultMaxBackjumps,
installReorderGoals = Flag False,
installIndependentGoals= Flag False,
installShadowPkgs = Flag False,
installReinstall = Flag False,
installAvoidReinstalls = Flag False,
installOverrideReinstall = Flag False,
......@@ -718,7 +723,8 @@ installOptions showOrParseArgs =
optionSolverFlags installMaxBackjumps (\v flags -> flags { installMaxBackjumps = v })
installReorderGoals (\v flags -> flags { installReorderGoals = v })
installIndependentGoals (\v flags -> flags { installIndependentGoals = v }) ++
installIndependentGoals (\v flags -> flags { installIndependentGoals = v })
installShadowPkgs (\v flags -> flags { installShadowPkgs = v }) ++
[ option [] ["reinstall"]
"Install even if it means installing the same version again."
......@@ -800,6 +806,7 @@ instance Monoid InstallFlags where
installUpgradeDeps = mempty,
installReorderGoals = mempty,
installIndependentGoals= mempty,
installShadowPkgs = mempty,
installOnly = mempty,
installOnlyDeps = mempty,
installRootCmd = mempty,
......@@ -820,6 +827,7 @@ instance Monoid InstallFlags where
installUpgradeDeps = combine installUpgradeDeps,
installReorderGoals = combine installReorderGoals,
installIndependentGoals= combine installIndependentGoals,
installShadowPkgs = combine installShadowPkgs,
installOnly = combine installOnly,
installOnlyDeps = combine installOnlyDeps,
installRootCmd = combine installRootCmd,
......@@ -1122,10 +1130,11 @@ optionSolver get set =
(flagToList . fmap display))
optionSolverFlags :: (flags -> Flag Int ) -> (Flag Int -> flags -> flags)
-> (flags -> Flag Bool ) -> (Flag Bool -> flags -> flags)
-> (flags -> Flag Bool ) -> (Flag Bool -> flags -> flags)
-> (flags -> Flag Bool ) -> (Flag Bool -> flags -> flags)
-> [OptionField flags]
optionSolverFlags getmbj setmbj getrg setrg getig setig =
optionSolverFlags getmbj setmbj getrg setrg getig setig getsip setsip =
[ 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.")
getmbj setmbj
......@@ -1136,11 +1145,14 @@ optionSolverFlags getmbj setmbj getrg setrg getig setig =
"Try to reorder goals according to certain heuristics. Slows things down on average, but may make backtracking faster for some packages."
getrg setrg
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."
getig setig
trueArg
, option [] ["shadow-installed-packages"]
"If multiple package instances of the same version are installed, treat all but one as shadowed."
getsip setsip
trueArg
]
......
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