Commit 3dcddea4 authored by Andres Löh's avatar Andres Löh

Configurable strong/weak flags.

This adds a mechanism in the modular solver to store whether a flag
is "strong" or "weak". A weak flag is deferred during solving, a strong
flag is not.

By default, flags are now weak unless they're manual. This is a change
in behaviour, but I think it's probably the better default, because many
automatic flags are used to figure out what's on the system rather than
to impose hard constraints.

There's a new flag --strong-flags that restores the old behaviour. I do
not think such a global flag is particularly useful, but it may be
of interest to compare build plans between the new and old behaviour.

With these preparations, it's easy to make the distinction between
strong and weak flags more sophisticated. We can either add more
heuristics as to when flags should be treated as strong or weak, or we
can add syntax to .cabal files that allows package authors to specify
explicitly how they intend a flag to behave.

This is related to various cabal-install issues, e.g. #1831, #1864,
and #1877.
parent 91abc4f9
......@@ -50,6 +50,7 @@ module Distribution.Client.Dependency (
setIndependentGoals,
setAvoidReinstalls,
setShadowPkgs,
setStrongFlags,
setMaxBackjumps,
addSourcePackages,
hideInstalledPackagesSpecificByInstalledPackageId,
......@@ -126,6 +127,7 @@ data DepResolverParams = DepResolverParams {
depResolverIndependentGoals :: Bool,
depResolverAvoidReinstalls :: Bool,
depResolverShadowPkgs :: Bool,
depResolverStrongFlags :: Bool,
depResolverMaxBackjumps :: Maybe Int
}
......@@ -176,6 +178,7 @@ basicDepResolverParams installedPkgIndex sourcePkgIndex =
depResolverIndependentGoals = False,
depResolverAvoidReinstalls = False,
depResolverShadowPkgs = False,
depResolverStrongFlags = False,
depResolverMaxBackjumps = Nothing
}
......@@ -233,6 +236,12 @@ setShadowPkgs b params =
depResolverShadowPkgs = b
}
setStrongFlags :: Bool -> DepResolverParams -> DepResolverParams
setStrongFlags b params =
params {
depResolverStrongFlags = b
}
setMaxBackjumps :: Maybe Int -> DepResolverParams -> DepResolverParams
setMaxBackjumps n params =
params {
......@@ -509,7 +518,7 @@ resolveDependencies platform comp solver params =
Step (debugDepResolverParams finalparams)
$ fmap (mkInstallPlan platform comp)
$ runSolver solver (SolverConfig reorderGoals indGoals noReinstalls
shadowing maxBkjumps)
shadowing strFlags maxBkjumps)
platform comp installedPkgIndex sourcePkgIndex
preferences constraints targets
where
......@@ -523,6 +532,7 @@ resolveDependencies platform comp solver params =
indGoals
noReinstalls
shadowing
strFlags
maxBkjumps) = dontUpgradeNonUpgradeablePackages
-- TODO:
-- The modular solver can properly deal with broken
......@@ -605,7 +615,7 @@ resolveWithoutDependencies :: DepResolverParams
resolveWithoutDependencies (DepResolverParams targets constraints
prefs defpref installedPkgIndex sourcePkgIndex
_reorderGoals _indGoals _avoidReinstalls
_shadowing _maxBjumps) =
_shadowing _strFlags _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 (shadowPkgs sc) iidx sidx
idx = convPIs os arch cid (shadowPkgs sc) (strongFlags sc) iidx sidx
-- Constraints have to be converted into a finite map indexed by PN.
gcs = M.fromListWith (++) (map (\ pc -> (pcName pc, [pc])) pcs)
......
......@@ -105,8 +105,8 @@ build = ana go
-- that is indicated by the flag default.
--
-- TODO: Should we include the flag default in the tree?
go bs@(BS { scope = sc, next = OneGoal (OpenGoal (Flagged qfn@(FN (PI qpn _) _) (FInfo b m) t f) gr) }) =
FChoiceF qfn (gr, sc) trivial m (P.fromList (reorder b
go bs@(BS { scope = sc, next = OneGoal (OpenGoal (Flagged qfn@(FN (PI qpn _) _) (FInfo b m w) t f) gr) }) =
FChoiceF qfn (gr, sc) (w || trivial) m (P.fromList (reorder b
[(True, (extendOpen qpn (L.map (flip OpenGoal (FDependency qfn True : gr)) t) bs) { next = Goals }),
(False, (extendOpen qpn (L.map (flip OpenGoal (FDependency qfn False : gr)) f) bs) { next = Goals })]))
where
......
......@@ -25,9 +25,10 @@ type Flag = FlagName
unFlag :: Flag -> String
unFlag (FlagName fn) = fn
-- | Flag info. Default value, and whether the flag is manual.
-- Manual flags can only be set explicitly.
data FInfo = FInfo { fdefault :: Bool, fmanual :: Bool }
-- | Flag info. Default value, whether the flag is manual, and
-- whether the flag is weak. Manual flags can only be set explicitly.
-- Weak flags are typically deferred by the solver.
data FInfo = FInfo { fdefault :: Bool, fmanual :: Bool, fweak :: Bool }
deriving (Eq, Ord, Show)
-- | Flag defaults.
......
......@@ -32,10 +32,10 @@ import Distribution.Client.Dependency.Modular.Version
-- resolving these situations. However, the right thing to do is to
-- fix the problem there, so for now, shadowing is only activated if
-- explicitly requested.
convPIs :: OS -> Arch -> CompilerId -> Bool ->
convPIs :: OS -> Arch -> CompilerId -> Bool -> Bool ->
SI.PackageIndex -> CI.PackageIndex SourcePackage -> Index
convPIs os arch cid sip iidx sidx =
mkIndex (convIPI' sip iidx ++ convSPI' os arch cid sidx)
convPIs os arch cid sip strfl iidx sidx =
mkIndex (convIPI' sip iidx ++ convSPI' os arch cid strfl sidx)
-- | Convert a Cabal installed package index to the simpler,
-- more uniform index format of the solver.
......@@ -82,19 +82,19 @@ convIPId pn' idx ipid =
-- | Convert a cabal-install source package index to the simpler,
-- more uniform index format of the solver.
convSPI' :: OS -> Arch -> CompilerId ->
convSPI' :: OS -> Arch -> CompilerId -> Bool ->
CI.PackageIndex SourcePackage -> [(PN, I, PInfo)]
convSPI' os arch cid = L.map (convSP os arch cid) . CI.allPackages
convSPI' os arch cid strfl = L.map (convSP os arch cid strfl) . CI.allPackages
convSPI :: OS -> Arch -> CompilerId ->
convSPI :: OS -> Arch -> CompilerId -> Bool ->
CI.PackageIndex SourcePackage -> Index
convSPI os arch cid = mkIndex . convSPI' os arch cid
convSPI os arch cid strfl = mkIndex . convSPI' os arch cid strfl
-- | Convert a single source package into the solver-specific format.
convSP :: OS -> Arch -> CompilerId -> SourcePackage -> (PN, I, PInfo)
convSP os arch cid (SourcePackage (PackageIdentifier pn pv) gpd _ _pl) =
convSP :: OS -> Arch -> CompilerId -> Bool -> SourcePackage -> (PN, I, PInfo)
convSP os arch cid strfl (SourcePackage (PackageIdentifier pn pv) gpd _ _pl) =
let i = I pv InRepo
in (pn, i, convGPD os arch cid (PI pn i) gpd)
in (pn, i, convGPD os arch cid strfl (PI pn i) gpd)
-- We do not use 'flattenPackageDescription' or 'finalizePackageDescription'
-- from 'Distribution.PackageDescription.Configuration' here, because we
......@@ -104,12 +104,12 @@ convSP os arch cid (SourcePackage (PackageIdentifier pn pv) gpd _ _pl) =
--
-- TODO: We currently just take all dependencies from all specified library,
-- executable and test components. This does not quite seem fair.
convGPD :: OS -> Arch -> CompilerId ->
convGPD :: OS -> Arch -> CompilerId -> Bool ->
PI PN -> GenericPackageDescription -> PInfo
convGPD os arch cid pi
convGPD os arch cid strfl pi
(GenericPackageDescription _ flags libs exes tests benchs) =
let
fds = flagInfo flags
fds = flagInfo strfl flags
in
PInfo
(maybe [] (convCondTree os arch cid pi fds (const True) ) libs ++
......@@ -126,9 +126,10 @@ prefix :: (FlaggedDeps qpn -> FlaggedDep qpn) -> [FlaggedDeps qpn] -> FlaggedDep
prefix _ [] = []
prefix f fds = [f (concat fds)]
-- | Convert flag information.
flagInfo :: [PD.Flag] -> FlagInfo
flagInfo = M.fromList . L.map (\ (MkFlag fn _ b m) -> (fn, FInfo b m))
-- | Convert flag information. Automatic flags are now considered weak
-- unless strong flags have been selected explicitly.
flagInfo :: Bool -> [PD.Flag] -> FlagInfo
flagInfo strfl = M.fromList . L.map (\ (MkFlag fn _ b m) -> (fn, FInfo b m (not (strfl || m))))
-- | Convert condition trees to flagged dependencies.
convCondTree :: OS -> Arch -> CompilerId -> PI PN -> FlagInfo ->
......
......@@ -241,25 +241,19 @@ preferEasyGoalChoices = trav go
go (GoalChoiceF xs) = GoalChoiceF (P.sortBy (comparing choices) xs)
go x = x
-- | Transformation that tries to avoid making flag choices early.
deferFlagChoices :: (Bool -> Bool) -> Tree a -> Tree a
deferFlagChoices f = trav go
-- | Transformation that tries to avoid making weak flag choices early.
-- Weak flags are trivial flags (not influencing dependencies) or such
-- flags that are explicitly declared to be weak in the index.
deferWeakFlagChoices :: Tree a -> Tree a
deferWeakFlagChoices = trav go
where
go (GoalChoiceF xs) = GoalChoiceF (P.sortBy defer xs)
go x = x
defer :: Tree a -> Tree a -> Ordering
defer (FChoice _ _ b _ _) _ | f b = GT
defer _ (FChoice _ _ b _ _) | f b = LT
defer _ _ = EQ
-- | Avoid trivial flag choices early in the process.
deferTrivialFlagChoices :: Tree a -> Tree a
deferTrivialFlagChoices = deferFlagChoices id
-- | Avoid all flag choices as long as possible.
deferAllFlagChoices :: Tree a -> Tree a
deferAllFlagChoices = deferFlagChoices (const True)
defer (FChoice _ _ True _ _) _ = GT
defer _ (FChoice _ _ True _ _) = LT
defer _ _ = EQ
-- | Variant of 'preferEasyGoalChoices'.
--
......
......@@ -21,6 +21,7 @@ data SolverConfig = SolverConfig {
independentGoals :: Bool,
avoidReinstalls :: Bool,
shadowPkgs :: Bool,
strongFlags :: Bool,
maxBackjumps :: Maybe Int
}
......@@ -40,10 +41,11 @@ solve sc idx userPrefs userConstraints userGoals =
where
explorePhase = exploreTreeLog . backjump
heuristicsPhase = P.firstGoal . -- after doing goal-choice heuristics, commit to the first choice (saves space)
P.deferAllFlagChoices .
P.deferWeakFlagChoices .
P.preferBaseGoalChoice .
if preferEasyGoalChoices sc
then P.preferBaseGoalChoice . P.lpreferEasyGoalChoices
else P.preferBaseGoalChoice
then P.lpreferEasyGoalChoices
else id
preferencesPhase = P.preferPackagePreferences userPrefs
validationPhase = P.enforceManualFlags . -- can only be done after user constraints
P.enforcePackageConstraints userConstraints .
......
......@@ -15,7 +15,7 @@ import Distribution.Client.Dependency.Modular.Version
-- | Type of the search tree. Inlining the choice nodes for now.
data Tree a =
PChoice QPN a (PSQ I (Tree a))
| FChoice QFN a Bool Bool (PSQ Bool (Tree a)) -- Bool indicates whether it's trivial, second Bool whether it's manual
| FChoice QFN a Bool Bool (PSQ Bool (Tree a)) -- Bool indicates whether it's weak/trivial, second Bool whether it's manual
| SChoice QSN a Bool (PSQ Bool (Tree a)) -- Bool indicates whether it's trivial
| GoalChoice (PSQ OpenGoal (Tree a)) -- PSQ should never be empty
| Done RevDepMap
......@@ -24,6 +24,11 @@ data Tree a =
-- Above, a choice is called trivial if it clearly does not matter. The
-- special case of triviality we actually consider is if there are no new
-- dependencies introduced by this node.
--
-- A (flag) choice is called weak if we do want to defer it. This is the
-- case for flags that should be implied by what's currently installed on
-- the system, as opposed to flags that are used to explicitly enable or
-- disable some functionality.
instance Functor Tree where
fmap f (PChoice qpn i xs) = PChoice qpn (f i) (fmap (fmap f) xs)
......
......@@ -154,6 +154,8 @@ planPackages verbosity comp platform fetchFlags
. setShadowPkgs shadowPkgs
. setStrongFlags strongFlags
-- 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
......@@ -168,6 +170,7 @@ planPackages verbosity comp platform fetchFlags
reorderGoals = fromFlag (fetchReorderGoals fetchFlags)
independentGoals = fromFlag (fetchIndependentGoals fetchFlags)
shadowPkgs = fromFlag (fetchShadowPkgs fetchFlags)
strongFlags = fromFlag (fetchStrongFlags fetchFlags)
maxBackjumps = fromFlag (fetchMaxBackjumps fetchFlags)
......
......@@ -156,6 +156,8 @@ planPackages verbosity comp platform mSandboxPkgInfo freezeFlags
. setShadowPkgs shadowPkgs
. setStrongFlags strongFlags
. maybe id applySandboxInstallPolicy mSandboxPkgInfo
$ standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers
......@@ -165,6 +167,7 @@ planPackages verbosity comp platform mSandboxPkgInfo freezeFlags
reorderGoals = fromFlag (freezeReorderGoals freezeFlags)
independentGoals = fromFlag (freezeIndependentGoals freezeFlags)
shadowPkgs = fromFlag (freezeShadowPkgs freezeFlags)
strongFlags = fromFlag (freezeStrongFlags freezeFlags)
maxBackjumps = fromFlag (freezeMaxBackjumps freezeFlags)
......
......@@ -334,6 +334,8 @@ planPackages comp platform mSandboxPkgInfo solver
. setShadowPkgs shadowPkgs
. setStrongFlags strongFlags
. setPreferenceDefault (if upgradeDeps then PreferAllLatest
else PreferLatestForSelected)
......@@ -379,6 +381,7 @@ planPackages comp platform mSandboxPkgInfo solver
independentGoals = fromFlag (installIndependentGoals installFlags)
avoidReinstalls = fromFlag (installAvoidReinstalls installFlags)
shadowPkgs = fromFlag (installShadowPkgs installFlags)
strongFlags = fromFlag (installStrongFlags installFlags)
maxBackjumps = fromFlag (installMaxBackjumps installFlags)
upgradeDeps = fromFlag (installUpgradeDeps installFlags)
onlyDeps = fromFlag (installOnlyDeps installFlags)
......
......@@ -484,6 +484,7 @@ data FetchFlags = FetchFlags {
fetchReorderGoals :: Flag Bool,
fetchIndependentGoals :: Flag Bool,
fetchShadowPkgs :: Flag Bool,
fetchStrongFlags :: Flag Bool,
fetchVerbosity :: Flag Verbosity
}
......@@ -497,6 +498,7 @@ defaultFetchFlags = FetchFlags {
fetchReorderGoals = Flag False,
fetchIndependentGoals = Flag False,
fetchShadowPkgs = Flag False,
fetchStrongFlags = Flag False,
fetchVerbosity = toFlag normal
}
......@@ -538,6 +540,7 @@ fetchCommand = CommandUI {
fetchReorderGoals (\v flags -> flags { fetchReorderGoals = v })
fetchIndependentGoals (\v flags -> flags { fetchIndependentGoals = v })
fetchShadowPkgs (\v flags -> flags { fetchShadowPkgs = v })
fetchStrongFlags (\v flags -> flags { fetchStrongFlags = v })
}
......@@ -552,6 +555,7 @@ data FreezeFlags = FreezeFlags {
freezeReorderGoals :: Flag Bool,
freezeIndependentGoals :: Flag Bool,
freezeShadowPkgs :: Flag Bool,
freezeStrongFlags :: Flag Bool,
freezeVerbosity :: Flag Verbosity
}
......@@ -563,6 +567,7 @@ defaultFreezeFlags = FreezeFlags {
freezeReorderGoals = Flag False,
freezeIndependentGoals = Flag False,
freezeShadowPkgs = Flag False,
freezeStrongFlags = Flag False,
freezeVerbosity = toFlag normal
}
......@@ -589,6 +594,7 @@ freezeCommand = CommandUI {
freezeReorderGoals (\v flags -> flags { freezeReorderGoals = v })
freezeIndependentGoals (\v flags -> flags { freezeIndependentGoals = v })
freezeShadowPkgs (\v flags -> flags { freezeShadowPkgs = v })
freezeStrongFlags (\v flags -> flags { freezeStrongFlags = v })
}
......@@ -922,6 +928,7 @@ data InstallFlags = InstallFlags {
installReorderGoals :: Flag Bool,
installIndependentGoals :: Flag Bool,
installShadowPkgs :: Flag Bool,
installStrongFlags :: Flag Bool,
installReinstall :: Flag Bool,
installAvoidReinstalls :: Flag Bool,
installOverrideReinstall :: Flag Bool,
......@@ -947,6 +954,7 @@ defaultInstallFlags = InstallFlags {
installReorderGoals = Flag False,
installIndependentGoals= Flag False,
installShadowPkgs = Flag False,
installStrongFlags = Flag False,
installReinstall = Flag False,
installAvoidReinstalls = Flag False,
installOverrideReinstall = Flag False,
......@@ -1073,7 +1081,8 @@ installOptions showOrParseArgs =
installMaxBackjumps (\v flags -> flags { installMaxBackjumps = v })
installReorderGoals (\v flags -> flags { installReorderGoals = v })
installIndependentGoals (\v flags -> flags { installIndependentGoals = v })
installShadowPkgs (\v flags -> flags { installShadowPkgs = v }) ++
installShadowPkgs (\v flags -> flags { installShadowPkgs = v })
installStrongFlags (\v flags -> flags { installStrongFlags = v }) ++
[ option [] ["reinstall"]
"Install even if it means installing the same version again."
......@@ -1170,6 +1179,7 @@ instance Monoid InstallFlags where
installReorderGoals = mempty,
installIndependentGoals= mempty,
installShadowPkgs = mempty,
installStrongFlags = mempty,
installOnly = mempty,
installOnlyDeps = mempty,
installRootCmd = mempty,
......@@ -1193,6 +1203,7 @@ instance Monoid InstallFlags where
installReorderGoals = combine installReorderGoals,
installIndependentGoals= combine installIndependentGoals,
installShadowPkgs = combine installShadowPkgs,
installStrongFlags = combine installStrongFlags,
installOnly = combine installOnly,
installOnlyDeps = combine installOnlyDeps,
installRootCmd = combine installRootCmd,
......@@ -1679,8 +1690,9 @@ optionSolverFlags :: ShowOrParseArgs
-> (flags -> Flag Bool ) -> (Flag Bool -> 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 showOrParseArgs getmbj setmbj getrg setrg _getig _setig getsip setsip =
optionSolverFlags showOrParseArgs getmbj setmbj getrg setrg _getig _setig getsip setsip getstrfl setstrfl =
[ 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
......@@ -1701,7 +1713,11 @@ optionSolverFlags showOrParseArgs getmbj setmbj getrg setrg _getig _setig getsip
, option [] ["shadow-installed-packages"]
"If multiple package instances of the same version are installed, treat all but one as shadowed."
getsip setsip
trueArg
(yesNoOpt showOrParseArgs)
, option [] ["strong-flags"]
"Do not defer flag choices (this used to be the default in cabal-install <= 1.20)."
getstrfl setstrfl
(yesNoOpt showOrParseArgs)
]
......
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