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

adding a command-line flag to avoid reinstalls

parent d5d2b78f
......@@ -42,6 +42,7 @@ module Distribution.Client.Dependency (
addConstraints,
addPreferences,
setPreferenceDefault,
setAvoidReinstalls,
addSourcePackages,
hideInstalledPackagesSpecificByInstalledPackageId,
hideInstalledPackagesSpecificBySourcePackageId,
......@@ -97,7 +98,8 @@ data DepResolverParams = DepResolverParams {
depResolverPreferences :: [PackagePreference],
depResolverPreferenceDefault :: PackagesPreferenceDefault,
depResolverInstalledPkgIndex :: InstalledPackageIndex.PackageIndex,
depResolverSourcePkgIndex :: PackageIndex.PackageIndex SourcePackage
depResolverSourcePkgIndex :: PackageIndex.PackageIndex SourcePackage,
depResolverAvoidReinstalls :: Bool
}
......@@ -125,7 +127,8 @@ basicDepResolverParams installedPkgIndex sourcePkgIndex =
depResolverPreferences = [],
depResolverPreferenceDefault = PreferLatestForSelected,
depResolverInstalledPkgIndex = installedPkgIndex,
depResolverSourcePkgIndex = sourcePkgIndex
depResolverSourcePkgIndex = sourcePkgIndex,
depResolverAvoidReinstalls = False
}
addTargets :: [PackageName]
......@@ -158,6 +161,12 @@ setPreferenceDefault preferenceDefault params =
depResolverPreferenceDefault = preferenceDefault
}
setAvoidReinstalls :: Bool -> DepResolverParams -> DepResolverParams
setAvoidReinstalls b params =
params {
depResolverAvoidReinstalls = b
}
dontUpgradeBasePackage :: DepResolverParams -> DepResolverParams
dontUpgradeBasePackage params =
addConstraints extraConstraints params
......@@ -267,7 +276,7 @@ standardInstallPolicy
-- * Interface to the standard resolver
-- ------------------------------------------------------------
defaultResolver :: DependencyResolver
defaultResolver :: Bool -> DependencyResolver
defaultResolver = modularResolver
-- | Run the dependency solver.
......@@ -289,16 +298,18 @@ resolveDependencies platform comp params
resolveDependencies platform comp params =
fmap (mkInstallPlan platform comp)
$ defaultResolver platform comp installedPkgIndex sourcePkgIndex
$ defaultResolver avoidReinstalls
platform comp installedPkgIndex sourcePkgIndex
preferences constraints targets
where
DepResolverParams
targets constraints
prefs defpref
installedPkgIndex
sourcePkgIndex = dontUpgradeBasePackage
. hideBrokenInstalledPackages
$ params
sourcePkgIndex
avoidReinstalls = dontUpgradeBasePackage
. hideBrokenInstalledPackages
$ params
preferences = interpretPackagesPreference
(Set.fromList targets) defpref prefs
......@@ -371,7 +382,8 @@ interpretPackagesPreference selected defaultPref prefs =
resolveWithoutDependencies :: DepResolverParams
-> Either [ResolveNoDepsError] [SourcePackage]
resolveWithoutDependencies (DepResolverParams targets constraints
prefs defpref installedPkgIndex sourcePkgIndex) =
prefs defpref installedPkgIndex sourcePkgIndex
_avoidReinstalls) =
collectEithers (map selectPackage targets)
where
selectPackage :: PackageName -> Either ResolveNoDepsError SourcePackage
......
......@@ -33,11 +33,11 @@ import Distribution.System
-- | Ties the two worlds together: classic cabal-install vs. the modular
-- solver. Performs the necessary translations before and after.
modularResolver :: DependencyResolver
modularResolver (Platform arch os) cid iidx sidx pprefs pcs pns =
modularResolver :: Bool -> DependencyResolver
modularResolver ar (Platform arch os) cid iidx sidx pprefs pcs pns =
fmap (uncurry postprocess) $ -- convert install plan
logToProgress $ -- convert log format into progress format
defaultSolver idx pprefs gcs pns
defaultSolver ar idx pprefs gcs pns
where
-- Indices have to be converted into solver-specific uniform index.
idx = convPIs os arch cid iidx sidx
......
......@@ -23,11 +23,11 @@ data SolverConfig = SolverConfig {
avoidReinstalls :: Bool
}
defaultSolverConfig :: SolverConfig
defaultSolverConfig = SolverConfig {
defaultSolverConfig :: Bool -> SolverConfig
defaultSolverConfig ar = SolverConfig {
preferEasyGoalChoices = True,
pStrategy = PreferLatestForSelected, -- latest for goals only
avoidReinstalls = False
avoidReinstalls = ar
}
solve :: SolverConfig -> -- solver parameters
......@@ -56,9 +56,10 @@ solve sc idx userPrefs userConstraints userGoals =
buildPhase = buildTree idx userGoals
-- | For cabal-install integration.
defaultSolver :: Index -> -- all available packages as an index
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 = solve defaultSolverConfig
defaultSolver ar = solve (defaultSolverConfig ar)
......@@ -235,7 +235,9 @@ planPackages comp configFlags configExFlags installFlags
where
resolverParams =
setPreferenceDefault (if upgradeDeps then PreferAllLatest
setAvoidReinstalls avoidReinstalls
. setPreferenceDefault (if upgradeDeps then PreferAllLatest
else PreferLatestForSelected)
. addPreferences
......@@ -311,9 +313,10 @@ planPackages comp configFlags configExFlags installFlags
, depid <- depids
, packageName depid `elem` targetnames ]
reinstall = fromFlag (installReinstall installFlags)
upgradeDeps = fromFlag (installUpgradeDeps installFlags)
onlyDeps = fromFlag (installOnlyDeps installFlags)
reinstall = fromFlag (installReinstall installFlags)
avoidReinstalls = fromFlag (installAvoidReinstalls installFlags)
upgradeDeps = fromFlag (installUpgradeDeps installFlags)
onlyDeps = fromFlag (installOnlyDeps installFlags)
-- ------------------------------------------------------------
-- * Informational messages
......
......@@ -570,36 +570,38 @@ 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,
installUpgradeDeps :: 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,
installUpgradeDeps :: 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
defaultInstallFlags = InstallFlags {
installDocumentation= Flag False,
installHaddockIndex = Flag docIndexFile,
installDryRun = Flag False,
installReinstall = Flag False,
installUpgradeDeps = Flag False,
installOnly = Flag False,
installOnlyDeps = Flag False,
installRootCmd = mempty,
installSummaryFile = mempty,
installLogFile = mempty,
installBuildReports = Flag NoReports,
installSymlinkBinDir= mempty,
installOneShot = Flag False
installDocumentation = Flag False,
installHaddockIndex = Flag docIndexFile,
installDryRun = Flag False,
installReinstall = Flag False,
installAvoidReinstalls = Flag False,
installUpgradeDeps = Flag False,
installOnly = Flag False,
installOnlyDeps = Flag False,
installRootCmd = mempty,
installSummaryFile = mempty,
installLogFile = mempty,
installBuildReports = Flag NoReports,
installSymlinkBinDir = mempty,
installOneShot = Flag False
}
where
docIndexFile = toPathTemplate ("$datadir" </> "doc" </> "index.html")
......@@ -678,6 +680,11 @@ installOptions showOrParseArgs =
installReinstall (\v flags -> flags { installReinstall = v })
trueArg
, option [] ["avoid-reinstalls"]
"Do not select versions that would destructively overwrite installed packages."
installAvoidReinstalls (\v flags -> flags { installAvoidReinstalls = v })
trueArg
, option [] ["upgrade-dependencies"]
"Pick the latest version for all dependencies, rather than trying to pick an installed version."
installUpgradeDeps (\v flags -> flags { installUpgradeDeps = v })
......@@ -734,34 +741,36 @@ installOptions showOrParseArgs =
instance Monoid InstallFlags where
mempty = InstallFlags {
installDocumentation= mempty,
installHaddockIndex = mempty,
installDryRun = mempty,
installReinstall = mempty,
installUpgradeDeps = mempty,
installOnly = mempty,
installOnlyDeps = mempty,
installRootCmd = mempty,
installSummaryFile = mempty,
installLogFile = mempty,
installBuildReports = mempty,
installSymlinkBinDir= mempty,
installOneShot = mempty
installDocumentation = mempty,
installHaddockIndex = mempty,
installDryRun = mempty,
installReinstall = mempty,
installAvoidReinstalls = mempty,
installUpgradeDeps = mempty,
installOnly = mempty,
installOnlyDeps = mempty,
installRootCmd = mempty,
installSummaryFile = mempty,
installLogFile = mempty,
installBuildReports = mempty,
installSymlinkBinDir = mempty,
installOneShot = mempty
}
mappend a b = InstallFlags {
installDocumentation= combine installDocumentation,
installHaddockIndex = combine installHaddockIndex,
installDryRun = combine installDryRun,
installReinstall = combine installReinstall,
installUpgradeDeps = combine installUpgradeDeps,
installOnly = combine installOnly,
installOnlyDeps = combine installOnlyDeps,
installRootCmd = combine installRootCmd,
installSummaryFile = combine installSummaryFile,
installLogFile = combine installLogFile,
installBuildReports = combine installBuildReports,
installSymlinkBinDir= combine installSymlinkBinDir,
installOneShot = combine installOneShot
installDocumentation = combine installDocumentation,
installHaddockIndex = combine installHaddockIndex,
installDryRun = combine installDryRun,
installReinstall = combine installReinstall,
installAvoidReinstalls = combine installAvoidReinstalls,
installUpgradeDeps = combine installUpgradeDeps,
installOnly = combine installOnly,
installOnlyDeps = combine installOnlyDeps,
installRootCmd = combine installRootCmd,
installSummaryFile = combine installSummaryFile,
installLogFile = combine installLogFile,
installBuildReports = combine installBuildReports,
installSymlinkBinDir = combine installSymlinkBinDir,
installOneShot = combine installOneShot
}
where combine field = field a `mappend` field b
......
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