diff --git a/cabal-install/Distribution/Client/Dependency.hs b/cabal-install/Distribution/Client/Dependency.hs
index 97c96ff36b2fde892ddaa7c729832e29e8a092c6..eb3ae61be50491f7b4ef26943af4b13599afba51 100644
--- a/cabal-install/Distribution/Client/Dependency.hs
+++ b/cabal-install/Distribution/Client/Dependency.hs
@@ -50,6 +50,7 @@ module Distribution.Client.Dependency (
setIndependentGoals,
setAvoidReinstalls,
setShadowPkgs,
+ setStrongFlags,
setMaxBackjumps,
addSourcePackages,
hideInstalledPackagesSpecificByInstalledPackageId,
@@ -119,6 +120,7 @@ data DepResolverParams = DepResolverParams {
depResolverIndependentGoals :: Bool,
depResolverAvoidReinstalls :: Bool,
depResolverShadowPkgs :: Bool,
+ depResolverStrongFlags :: Bool,
depResolverMaxBackjumps :: Maybe Int
}
@@ -152,6 +154,7 @@ basicDepResolverParams installedPkgIndex sourcePkgIndex =
depResolverIndependentGoals = False,
depResolverAvoidReinstalls = False,
depResolverShadowPkgs = False,
+ depResolverStrongFlags = False,
depResolverMaxBackjumps = Nothing
}
@@ -209,6 +212,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 {
@@ -399,7 +408,7 @@ resolveDependencies platform comp solver params =
fmap (mkInstallPlan platform comp)
$ runSolver solver (SolverConfig reorderGoals indGoals noReinstalls
- shadowing maxBkjumps)
+ shadowing strFlags maxBkjumps)
platform comp installedPkgIndex sourcePkgIndex
preferences constraints targets
where
@@ -412,7 +421,8 @@ resolveDependencies platform comp solver params =
indGoals
noReinstalls
shadowing
- maxBkjumps = dontUpgradeBasePackage
+ strFlags
+ maxBkjumps = dontUpgradeNonUpgradeablePackages
-- TODO:
-- The modular solver can properly deal with broken
-- packages and won't select them. So the
@@ -495,7 +505,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
diff --git a/cabal-install/Distribution/Client/Dependency/Modular.hs b/cabal-install/Distribution/Client/Dependency/Modular.hs
index c88fa0bd550c4e6b0933f08b2555f8e7c5dc2cba..01f01c43d01e676858d52c40646370bac40a96a0 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular.hs
@@ -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)
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Builder.hs b/cabal-install/Distribution/Client/Dependency/Modular/Builder.hs
index f52951d544f19e393166eb375752008d52060f44..c62ba10aa893eb89801968c6aeca964d3927002d 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Builder.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Builder.hs
@@ -127,8 +127,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
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Flag.hs b/cabal-install/Distribution/Client/Dependency/Modular/Flag.hs
index 72340bfaaea5a0ef64ae226c63368ffb6d966d79..6b4a217b7c2aecd5b609fef2c524db12f2cfc2b8 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Flag.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Flag.hs
@@ -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.
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs b/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs
index ad23859ab9e3259834849b34933fcbd9c0c72ab8..ff4426af9e43de14bb8c80f2dbb9c3028d78c60c 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs
@@ -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 ->
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Preference.hs b/cabal-install/Distribution/Client/Dependency/Modular/Preference.hs
index 6b8f676608149852248cecc1a79a03869512d0ad..6ae30f6239d8589d5f9ea7c7b74f25079a2828d6 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Preference.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Preference.hs
@@ -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'.
--
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Solver.hs b/cabal-install/Distribution/Client/Dependency/Modular/Solver.hs
index 77fc6c07f9405787e544a83df566491bd807b732..0501a6a6ef0ed9ffa8be966f1448f2c0ac27d1e9 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Solver.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Solver.hs
@@ -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 .
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Tree.hs b/cabal-install/Distribution/Client/Dependency/Modular/Tree.hs
index dd250fc3e756ddefadfd4d00d3cacc2717a7e4a2..6b67791661b2f2562f5f25e5628a64c5db838c8d 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Tree.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Tree.hs
@@ -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)
diff --git a/cabal-install/Distribution/Client/Fetch.hs b/cabal-install/Distribution/Client/Fetch.hs
index 0573598b2e51fe039e21e819f2445f428a30144a..33cd94a495a571a6da95b1bfbd9e8da317305423 100644
--- a/cabal-install/Distribution/Client/Fetch.hs
+++ b/cabal-install/Distribution/Client/Fetch.hs
@@ -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)
diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs
index 2bbf7d4c28daf354a8388cf21a98d55c8bb9111c..c7328daa544cea64739a6ab847084463ab666e43 100644
--- a/cabal-install/Distribution/Client/Install.hs
+++ b/cabal-install/Distribution/Client/Install.hs
@@ -319,6 +319,8 @@ planPackages comp platform mSandboxPkgInfo solver
. setShadowPkgs shadowPkgs
+ . setStrongFlags strongFlags
+
. setPreferenceDefault (if upgradeDeps then PreferAllLatest
else PreferLatestForSelected)
@@ -362,6 +364,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)
diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs
index 7c8035e222cbd426ccb6378ef5c1d1c3c580491d..2238a14080bdb1d40819c5b50e98629616683461 100644
--- a/cabal-install/Distribution/Client/Setup.hs
+++ b/cabal-install/Distribution/Client/Setup.hs
@@ -437,6 +437,7 @@ data FetchFlags = FetchFlags {
fetchReorderGoals :: Flag Bool,
fetchIndependentGoals :: Flag Bool,
fetchShadowPkgs :: Flag Bool,
+ fetchStrongFlags :: Flag Bool,
fetchVerbosity :: Flag Verbosity
}
@@ -450,6 +451,7 @@ defaultFetchFlags = FetchFlags {
fetchReorderGoals = Flag False,
fetchIndependentGoals = Flag False,
fetchShadowPkgs = Flag False,
+ fetchStrongFlags = Flag False,
fetchVerbosity = toFlag normal
}
@@ -491,6 +493,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 })
}
@@ -784,6 +787,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,
@@ -808,6 +812,7 @@ defaultInstallFlags = InstallFlags {
installReorderGoals = Flag False,
installIndependentGoals= Flag False,
installShadowPkgs = Flag False,
+ installStrongFlags = Flag False,
installReinstall = Flag False,
installAvoidReinstalls = Flag False,
installOverrideReinstall = Flag False,
@@ -909,7 +914,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."
@@ -1004,6 +1010,7 @@ instance Monoid InstallFlags where
installReorderGoals = mempty,
installIndependentGoals= mempty,
installShadowPkgs = mempty,
+ installStrongFlags = mempty,
installOnly = mempty,
installOnlyDeps = mempty,
installRootCmd = mempty,
@@ -1026,6 +1033,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,
@@ -1479,8 +1487,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
@@ -1501,7 +1510,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)
]