{-# LANGUAGE ScopedTypeVariables #-}
module Distribution.Solver.Modular.Preference
( avoidReinstalls
, deferSetupExeChoices
, deferWeakFlagChoices
, enforceManualFlags
, enforcePackageConstraints
, enforceSingleInstanceRestriction
, firstGoal
, preferBaseGoalChoice
, preferLinked
, preferPackagePreferences
, preferReallyEasyGoalChoices
, requireInstalled
, onlyConstrained
, sortGoals
, pruneAfterFirstSuccess
) where
import Prelude ()
import Distribution.Solver.Compat.Prelude
import qualified Data.List as L
import qualified Data.Map as M
import Control.Monad.Trans.Reader (Reader, runReader, ask, local)
import Distribution.PackageDescription (lookupFlagAssignment, unFlagAssignment)
import Distribution.Solver.Types.Flag
import Distribution.Solver.Types.InstalledPreference
import Distribution.Solver.Types.LabeledPackageConstraint
import Distribution.Solver.Types.OptionalStanza
import Distribution.Solver.Types.PackageConstraint
import Distribution.Solver.Types.PackagePath
import Distribution.Solver.Types.PackagePreferences
import Distribution.Solver.Types.Variable
import Distribution.Solver.Modular.Dependency
import Distribution.Solver.Modular.Flag
import Distribution.Solver.Modular.Package
import qualified Distribution.Solver.Modular.PSQ as P
import Distribution.Solver.Modular.Tree
import Distribution.Solver.Modular.Version
import qualified Distribution.Solver.Modular.ConflictSet as CS
import qualified Distribution.Solver.Modular.WeightedPSQ as W
addWeights :: [PN -> [Ver] -> POption -> Weight] -> EndoTreeTrav d c
addWeights :: forall d c. [PN -> [Ver] -> POption -> Weight] -> EndoTreeTrav d c
addWeights [PN -> [Ver] -> POption -> Weight]
fs = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
go
where
go :: TreeF d c (Tree d c) -> TreeF d c (Tree d c)
go :: forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
go (PChoiceF qpn :: QPN
qpn@(Q PackagePath
_ PN
pn) RevDepMap
rdm c
x WeightedPSQ [Weight] POption (Tree d c)
cs) =
let sortedVersions :: [Ver]
sortedVersions = (Ver -> Ver -> Ordering) -> [Ver] -> [Ver]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy ((Ver -> Ver -> Ordering) -> Ver -> Ver -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ver -> Ver -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) ([Ver] -> [Ver]) -> [Ver] -> [Ver]
forall a b. (a -> b) -> a -> b
$ (POption -> Ver) -> [POption] -> [Ver]
forall a b. (a -> b) -> [a] -> [b]
L.map POption -> Ver
version (WeightedPSQ [Weight] POption (Tree d c) -> [POption]
forall w k v. WeightedPSQ w k v -> [k]
W.keys WeightedPSQ [Weight] POption (Tree d c)
cs)
weights :: POption -> [Weight]
weights POption
k = [PN -> [Ver] -> POption -> Weight
f PN
pn [Ver]
sortedVersions POption
k | PN -> [Ver] -> POption -> Weight
f <- [PN -> [Ver] -> POption -> Weight]
fs]
elemsToWhnf :: [a] -> ()
elemsToWhnf :: forall a. [a] -> ()
elemsToWhnf = (a -> () -> ()) -> () -> [a] -> ()
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> () -> ()
forall a b. a -> b -> b
seq ()
in QPN
-> RevDepMap
-> c
-> WeightedPSQ [Weight] POption (Tree d c)
-> TreeF d c (Tree d c)
forall d c a.
QPN
-> RevDepMap -> c -> WeightedPSQ [Weight] POption a -> TreeF d c a
PChoiceF QPN
qpn RevDepMap
rdm c
x
([Ver] -> ()
forall a. [a] -> ()
elemsToWhnf [Ver]
sortedVersions ()
-> WeightedPSQ [Weight] POption (Tree d c)
-> WeightedPSQ [Weight] POption (Tree d c)
forall a b. a -> b -> b
`seq`
(POption -> [Weight] -> [Weight])
-> WeightedPSQ [Weight] POption (Tree d c)
-> WeightedPSQ [Weight] POption (Tree d c)
forall w2 k w1 v.
Ord w2 =>
(k -> w1 -> w2) -> WeightedPSQ w1 k v -> WeightedPSQ w2 k v
W.mapWeightsWithKey (\POption
k [Weight]
w -> POption -> [Weight]
weights POption
k [Weight] -> [Weight] -> [Weight]
forall a. [a] -> [a] -> [a]
++ [Weight]
w) WeightedPSQ [Weight] POption (Tree d c)
cs)
go TreeF d c (Tree d c)
x = TreeF d c (Tree d c)
x
addWeight :: (PN -> [Ver] -> POption -> Weight) -> EndoTreeTrav d c
addWeight :: forall d c. (PN -> [Ver] -> POption -> Weight) -> EndoTreeTrav d c
addWeight PN -> [Ver] -> POption -> Weight
f = [PN -> [Ver] -> POption -> Weight] -> EndoTreeTrav d c
forall d c. [PN -> [Ver] -> POption -> Weight] -> EndoTreeTrav d c
addWeights [PN -> [Ver] -> POption -> Weight
f]
version :: POption -> Ver
version :: POption -> Ver
version (POption (I Ver
v Loc
_) Maybe PackagePath
_) = Ver
v
preferLinked :: EndoTreeTrav d c
preferLinked :: forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
preferLinked = (PN -> [Ver] -> POption -> Weight) -> EndoTreeTrav d c
forall d c. (PN -> [Ver] -> POption -> Weight) -> EndoTreeTrav d c
addWeight (([Ver] -> POption -> Weight) -> PN -> [Ver] -> POption -> Weight
forall a b. a -> b -> a
const ((POption -> Weight) -> [Ver] -> POption -> Weight
forall a b. a -> b -> a
const POption -> Weight
forall {a}. Num a => POption -> a
linked))
where
linked :: POption -> a
linked (POption I
_ Maybe PackagePath
Nothing) = a
1
linked (POption I
_ (Just PackagePath
_)) = a
0
preferPackagePreferences :: (PN -> PackagePreferences) -> EndoTreeTrav d c
preferPackagePreferences :: forall d c. (PN -> PackagePreferences) -> EndoTreeTrav d c
preferPackagePreferences PN -> PackagePreferences
pcs =
(PN -> PackagePreferences) -> EndoTreeTrav d c
forall d c. (PN -> PackagePreferences) -> EndoTreeTrav d c
preferPackageStanzaPreferences PN -> PackagePreferences
pcs EndoTreeTrav d c -> EndoTreeTrav d c -> EndoTreeTrav d c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[PN -> [Ver] -> POption -> Weight] -> EndoTreeTrav d c
forall d c. [PN -> [Ver] -> POption -> Weight] -> EndoTreeTrav d c
addWeights [
\PN
pn [Ver]
_ POption
opt -> PN -> POption -> Weight
preferred PN
pn POption
opt
, \PN
pn [Ver]
vs POption
opt -> case PN -> InstalledPreference
preference PN
pn of
InstalledPreference
PreferInstalled -> POption -> Weight
installed POption
opt
InstalledPreference
PreferLatest -> [Ver] -> POption -> Weight
latest [Ver]
vs POption
opt
InstalledPreference
PreferOldest -> [Ver] -> POption -> Weight
oldest [Ver]
vs POption
opt
, \PN
pn [Ver]
vs POption
opt -> case PN -> InstalledPreference
preference PN
pn of
InstalledPreference
PreferInstalled -> [Ver] -> POption -> Weight
latest [Ver]
vs POption
opt
InstalledPreference
PreferLatest -> POption -> Weight
installed POption
opt
InstalledPreference
PreferOldest -> POption -> Weight
installed POption
opt
]
where
latest :: [Ver] -> POption -> Weight
latest :: [Ver] -> POption -> Weight
latest [Ver]
sortedVersions POption
opt =
let l :: Int
l = [Ver] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ver]
sortedVersions
index :: Int
index = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
l (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (Ver -> Bool) -> [Ver] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
L.findIndex (Ver -> Ver -> Bool
forall a. Ord a => a -> a -> Bool
<= POption -> Ver
version POption
opt) [Ver]
sortedVersions
in Int -> Weight
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index Weight -> Weight -> Weight
forall a. Fractional a => a -> a -> a
/ Int -> Weight
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l
oldest :: [Ver] -> POption -> Weight
oldest :: [Ver] -> POption -> Weight
oldest [Ver]
sortedVersions POption
opt = Weight
1 Weight -> Weight -> Weight
forall a. Num a => a -> a -> a
- [Ver] -> POption -> Weight
latest [Ver]
sortedVersions POption
opt
preference :: PN -> InstalledPreference
preference :: PN -> InstalledPreference
preference PN
pn =
let PackagePreferences [VersionRange]
_ InstalledPreference
ipref [OptionalStanza]
_ = PN -> PackagePreferences
pcs PN
pn
in InstalledPreference
ipref
preferred :: PN -> POption -> Weight
preferred :: PN -> POption -> Weight
preferred PN
pn POption
opt =
let PackagePreferences [VersionRange]
vrs InstalledPreference
_ [OptionalStanza]
_ = PN -> PackagePreferences
pcs PN
pn
in Int -> Weight
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Weight)
-> ([VersionRange] -> Int) -> [VersionRange] -> Weight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> ([VersionRange] -> Int) -> [VersionRange] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [VersionRange] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length ([VersionRange] -> Weight) -> [VersionRange] -> Weight
forall a b. (a -> b) -> a -> b
$
(VersionRange -> Bool) -> [VersionRange] -> [VersionRange]
forall a. (a -> Bool) -> [a] -> [a]
L.filter ((VersionRange -> Ver -> Bool) -> Ver -> VersionRange -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip VersionRange -> Ver -> Bool
checkVR (POption -> Ver
version POption
opt)) [VersionRange]
vrs
installed :: POption -> Weight
installed :: POption -> Weight
installed (POption (I Ver
_ (Inst PId
_)) Maybe PackagePath
_) = Weight
0
installed POption
_ = Weight
1
preferPackageStanzaPreferences :: (PN -> PackagePreferences) -> EndoTreeTrav d c
preferPackageStanzaPreferences :: forall d c. (PN -> PackagePreferences) -> EndoTreeTrav d c
preferPackageStanzaPreferences PN -> PackagePreferences
pcs = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
forall {d} {c} {a}. TreeF d c a -> TreeF d c a
go
where
go :: TreeF d c a -> TreeF d c a
go (SChoiceF qsn :: QSN
qsn@(SN (Q PackagePath
_pp PN
pn) OptionalStanza
s) RevDepMap
rdm c
gr WeakOrTrivial
_tr WeightedPSQ [Weight] Bool a
ts)
| PN -> OptionalStanza -> Bool
enableStanzaPref PN
pn OptionalStanza
s =
let ts' :: WeightedPSQ [Weight] Bool a
ts' = (Bool -> [Weight] -> [Weight])
-> WeightedPSQ [Weight] Bool a -> WeightedPSQ [Weight] Bool a
forall w2 k w1 v.
Ord w2 =>
(k -> w1 -> w2) -> WeightedPSQ w1 k v -> WeightedPSQ w2 k v
W.mapWeightsWithKey (\Bool
k [Weight]
w -> Bool -> Weight
forall {a}. Num a => Bool -> a
weight Bool
k Weight -> [Weight] -> [Weight]
forall a. a -> [a] -> [a]
: [Weight]
w) WeightedPSQ [Weight] Bool a
ts
weight :: Bool -> a
weight Bool
k = if Bool
k then a
0 else a
1
in QSN
-> RevDepMap
-> c
-> WeakOrTrivial
-> WeightedPSQ [Weight] Bool a
-> TreeF d c a
forall d c a.
QSN
-> RevDepMap
-> c
-> WeakOrTrivial
-> WeightedPSQ [Weight] Bool a
-> TreeF d c a
SChoiceF QSN
qsn RevDepMap
rdm c
gr (Bool -> WeakOrTrivial
WeakOrTrivial Bool
True) WeightedPSQ [Weight] Bool a
ts'
go TreeF d c a
x = TreeF d c a
x
enableStanzaPref :: PN -> OptionalStanza -> Bool
enableStanzaPref :: PN -> OptionalStanza -> Bool
enableStanzaPref PN
pn OptionalStanza
s =
let PackagePreferences [VersionRange]
_ InstalledPreference
_ [OptionalStanza]
spref = PN -> PackagePreferences
pcs PN
pn
in OptionalStanza
s OptionalStanza -> [OptionalStanza] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [OptionalStanza]
spref
processPackageConstraintP :: forall d c. QPN
-> ConflictSet
-> I
-> LabeledPackageConstraint
-> Tree d c
-> Tree d c
processPackageConstraintP :: forall d c.
QPN
-> ConflictSet
-> I
-> LabeledPackageConstraint
-> Tree d c
-> Tree d c
processPackageConstraintP QPN
qpn ConflictSet
c I
i (LabeledPackageConstraint (PackageConstraint ConstraintScope
scope PackageProperty
prop) ConstraintSource
src) Tree d c
r =
if ConstraintScope -> QPN -> Bool
constraintScopeMatches ConstraintScope
scope QPN
qpn
then I -> PackageProperty -> Tree d c
go I
i PackageProperty
prop
else Tree d c
r
where
go :: I -> PackageProperty -> Tree d c
go :: I -> PackageProperty -> Tree d c
go (I Ver
v Loc
_) (PackagePropertyVersion VersionRange
vr)
| VersionRange -> Ver -> Bool
checkVR VersionRange
vr Ver
v = Tree d c
r
| Bool
otherwise = ConflictSet -> FailReason -> Tree d c
forall d c. ConflictSet -> FailReason -> Tree d c
Fail ConflictSet
c (VersionRange -> ConstraintSource -> FailReason
GlobalConstraintVersion VersionRange
vr ConstraintSource
src)
go I
_ PackageProperty
PackagePropertyInstalled
| I -> Bool
instI I
i = Tree d c
r
| Bool
otherwise = ConflictSet -> FailReason -> Tree d c
forall d c. ConflictSet -> FailReason -> Tree d c
Fail ConflictSet
c (ConstraintSource -> FailReason
GlobalConstraintInstalled ConstraintSource
src)
go I
_ PackageProperty
PackagePropertySource
| Bool -> Bool
not (I -> Bool
instI I
i) = Tree d c
r
| Bool
otherwise = ConflictSet -> FailReason -> Tree d c
forall d c. ConflictSet -> FailReason -> Tree d c
Fail ConflictSet
c (ConstraintSource -> FailReason
GlobalConstraintSource ConstraintSource
src)
go I
_ PackageProperty
_ = Tree d c
r
processPackageConstraintF :: forall d c. QPN
-> Flag
-> ConflictSet
-> Bool
-> LabeledPackageConstraint
-> Tree d c
-> Tree d c
processPackageConstraintF :: forall d c.
QPN
-> Flag
-> ConflictSet
-> Bool
-> LabeledPackageConstraint
-> Tree d c
-> Tree d c
processPackageConstraintF QPN
qpn Flag
f ConflictSet
c Bool
b' (LabeledPackageConstraint (PackageConstraint ConstraintScope
scope PackageProperty
prop) ConstraintSource
src) Tree d c
r =
if ConstraintScope -> QPN -> Bool
constraintScopeMatches ConstraintScope
scope QPN
qpn
then PackageProperty -> Tree d c
go PackageProperty
prop
else Tree d c
r
where
go :: PackageProperty -> Tree d c
go :: PackageProperty -> Tree d c
go (PackagePropertyFlags FlagAssignment
fa) =
case Flag -> FlagAssignment -> Maybe Bool
lookupFlagAssignment Flag
f FlagAssignment
fa of
Maybe Bool
Nothing -> Tree d c
r
Just Bool
b | Bool
b Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
b' -> Tree d c
r
| Bool
otherwise -> ConflictSet -> FailReason -> Tree d c
forall d c. ConflictSet -> FailReason -> Tree d c
Fail ConflictSet
c (ConstraintSource -> FailReason
GlobalConstraintFlag ConstraintSource
src)
go PackageProperty
_ = Tree d c
r
processPackageConstraintS :: forall d c. QPN
-> OptionalStanza
-> ConflictSet
-> Bool
-> LabeledPackageConstraint
-> Tree d c
-> Tree d c
processPackageConstraintS :: forall d c.
QPN
-> OptionalStanza
-> ConflictSet
-> Bool
-> LabeledPackageConstraint
-> Tree d c
-> Tree d c
processPackageConstraintS QPN
qpn OptionalStanza
s ConflictSet
c Bool
b' (LabeledPackageConstraint (PackageConstraint ConstraintScope
scope PackageProperty
prop) ConstraintSource
src) Tree d c
r =
if ConstraintScope -> QPN -> Bool
constraintScopeMatches ConstraintScope
scope QPN
qpn
then PackageProperty -> Tree d c
go PackageProperty
prop
else Tree d c
r
where
go :: PackageProperty -> Tree d c
go :: PackageProperty -> Tree d c
go (PackagePropertyStanzas [OptionalStanza]
ss) =
if Bool -> Bool
not Bool
b' Bool -> Bool -> Bool
&& OptionalStanza
s OptionalStanza -> [OptionalStanza] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [OptionalStanza]
ss then ConflictSet -> FailReason -> Tree d c
forall d c. ConflictSet -> FailReason -> Tree d c
Fail ConflictSet
c (ConstraintSource -> FailReason
GlobalConstraintFlag ConstraintSource
src)
else Tree d c
r
go PackageProperty
_ = Tree d c
r
enforcePackageConstraints :: M.Map PN [LabeledPackageConstraint]
-> EndoTreeTrav d c
enforcePackageConstraints :: forall d c. Map PN [LabeledPackageConstraint] -> EndoTreeTrav d c
enforcePackageConstraints Map PN [LabeledPackageConstraint]
pcs = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
forall {d} {c} {d} {c}.
TreeF d c (Tree d c) -> TreeF d c (Tree d c)
go
where
go :: TreeF d c (Tree d c) -> TreeF d c (Tree d c)
go (PChoiceF qpn :: QPN
qpn@(Q PackagePath
_ PN
pn) RevDepMap
rdm c
gr WeightedPSQ [Weight] POption (Tree d c)
ts) =
let c :: ConflictSet
c = Var QPN -> ConflictSet
varToConflictSet (QPN -> Var QPN
forall qpn. qpn -> Var qpn
P QPN
qpn)
g :: POption -> Tree d c -> Tree d c
g = \ (POption I
i Maybe PackagePath
_) -> ((Tree d c -> Tree d c)
-> LabeledPackageConstraint -> Tree d c -> Tree d c)
-> (Tree d c -> Tree d c)
-> [LabeledPackageConstraint]
-> Tree d c
-> Tree d c
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ Tree d c -> Tree d c
h LabeledPackageConstraint
pc -> Tree d c -> Tree d c
h (Tree d c -> Tree d c)
-> (Tree d c -> Tree d c) -> Tree d c -> Tree d c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QPN
-> ConflictSet
-> I
-> LabeledPackageConstraint
-> Tree d c
-> Tree d c
forall d c.
QPN
-> ConflictSet
-> I
-> LabeledPackageConstraint
-> Tree d c
-> Tree d c
processPackageConstraintP QPN
qpn ConflictSet
c I
i LabeledPackageConstraint
pc)
Tree d c -> Tree d c
forall a. a -> a
id
([LabeledPackageConstraint]
-> PN
-> Map PN [LabeledPackageConstraint]
-> [LabeledPackageConstraint]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] PN
pn Map PN [LabeledPackageConstraint]
pcs)
in QPN
-> RevDepMap
-> c
-> WeightedPSQ [Weight] POption (Tree d c)
-> TreeF d c (Tree d c)
forall d c a.
QPN
-> RevDepMap -> c -> WeightedPSQ [Weight] POption a -> TreeF d c a
PChoiceF QPN
qpn RevDepMap
rdm c
gr ((POption -> Tree d c -> Tree d c)
-> WeightedPSQ [Weight] POption (Tree d c)
-> WeightedPSQ [Weight] POption (Tree d c)
forall k v1 v2 w.
(k -> v1 -> v2) -> WeightedPSQ w k v1 -> WeightedPSQ w k v2
W.mapWithKey POption -> Tree d c -> Tree d c
forall {d} {c}. POption -> Tree d c -> Tree d c
g WeightedPSQ [Weight] POption (Tree d c)
ts)
go (FChoiceF qfn :: QFN
qfn@(FN qpn :: QPN
qpn@(Q PackagePath
_ PN
pn) Flag
f) RevDepMap
rdm c
gr WeakOrTrivial
tr FlagType
m Bool
d WeightedPSQ [Weight] Bool (Tree d c)
ts) =
let c :: ConflictSet
c = Var QPN -> ConflictSet
varToConflictSet (QFN -> Var QPN
forall qpn. FN qpn -> Var qpn
F QFN
qfn)
g :: Bool -> Tree d c -> Tree d c
g = \ Bool
b -> ((Tree d c -> Tree d c)
-> LabeledPackageConstraint -> Tree d c -> Tree d c)
-> (Tree d c -> Tree d c)
-> [LabeledPackageConstraint]
-> Tree d c
-> Tree d c
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ Tree d c -> Tree d c
h LabeledPackageConstraint
pc -> Tree d c -> Tree d c
h (Tree d c -> Tree d c)
-> (Tree d c -> Tree d c) -> Tree d c -> Tree d c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QPN
-> Flag
-> ConflictSet
-> Bool
-> LabeledPackageConstraint
-> Tree d c
-> Tree d c
forall d c.
QPN
-> Flag
-> ConflictSet
-> Bool
-> LabeledPackageConstraint
-> Tree d c
-> Tree d c
processPackageConstraintF QPN
qpn Flag
f ConflictSet
c Bool
b LabeledPackageConstraint
pc)
Tree d c -> Tree d c
forall a. a -> a
id
([LabeledPackageConstraint]
-> PN
-> Map PN [LabeledPackageConstraint]
-> [LabeledPackageConstraint]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] PN
pn Map PN [LabeledPackageConstraint]
pcs)
in QFN
-> RevDepMap
-> c
-> WeakOrTrivial
-> FlagType
-> Bool
-> WeightedPSQ [Weight] Bool (Tree d c)
-> TreeF d c (Tree d c)
forall d c a.
QFN
-> RevDepMap
-> c
-> WeakOrTrivial
-> FlagType
-> Bool
-> WeightedPSQ [Weight] Bool a
-> TreeF d c a
FChoiceF QFN
qfn RevDepMap
rdm c
gr WeakOrTrivial
tr FlagType
m Bool
d ((Bool -> Tree d c -> Tree d c)
-> WeightedPSQ [Weight] Bool (Tree d c)
-> WeightedPSQ [Weight] Bool (Tree d c)
forall k v1 v2 w.
(k -> v1 -> v2) -> WeightedPSQ w k v1 -> WeightedPSQ w k v2
W.mapWithKey Bool -> Tree d c -> Tree d c
forall {d} {c}. Bool -> Tree d c -> Tree d c
g WeightedPSQ [Weight] Bool (Tree d c)
ts)
go (SChoiceF qsn :: QSN
qsn@(SN qpn :: QPN
qpn@(Q PackagePath
_ PN
pn) OptionalStanza
f) RevDepMap
rdm c
gr WeakOrTrivial
tr WeightedPSQ [Weight] Bool (Tree d c)
ts) =
let c :: ConflictSet
c = Var QPN -> ConflictSet
varToConflictSet (QSN -> Var QPN
forall qpn. SN qpn -> Var qpn
S QSN
qsn)
g :: Bool -> Tree d c -> Tree d c
g = \ Bool
b -> ((Tree d c -> Tree d c)
-> LabeledPackageConstraint -> Tree d c -> Tree d c)
-> (Tree d c -> Tree d c)
-> [LabeledPackageConstraint]
-> Tree d c
-> Tree d c
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ Tree d c -> Tree d c
h LabeledPackageConstraint
pc -> Tree d c -> Tree d c
h (Tree d c -> Tree d c)
-> (Tree d c -> Tree d c) -> Tree d c -> Tree d c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QPN
-> OptionalStanza
-> ConflictSet
-> Bool
-> LabeledPackageConstraint
-> Tree d c
-> Tree d c
forall d c.
QPN
-> OptionalStanza
-> ConflictSet
-> Bool
-> LabeledPackageConstraint
-> Tree d c
-> Tree d c
processPackageConstraintS QPN
qpn OptionalStanza
f ConflictSet
c Bool
b LabeledPackageConstraint
pc)
Tree d c -> Tree d c
forall a. a -> a
id
([LabeledPackageConstraint]
-> PN
-> Map PN [LabeledPackageConstraint]
-> [LabeledPackageConstraint]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] PN
pn Map PN [LabeledPackageConstraint]
pcs)
in QSN
-> RevDepMap
-> c
-> WeakOrTrivial
-> WeightedPSQ [Weight] Bool (Tree d c)
-> TreeF d c (Tree d c)
forall d c a.
QSN
-> RevDepMap
-> c
-> WeakOrTrivial
-> WeightedPSQ [Weight] Bool a
-> TreeF d c a
SChoiceF QSN
qsn RevDepMap
rdm c
gr WeakOrTrivial
tr ((Bool -> Tree d c -> Tree d c)
-> WeightedPSQ [Weight] Bool (Tree d c)
-> WeightedPSQ [Weight] Bool (Tree d c)
forall k v1 v2 w.
(k -> v1 -> v2) -> WeightedPSQ w k v1 -> WeightedPSQ w k v2
W.mapWithKey Bool -> Tree d c -> Tree d c
forall {d} {c}. Bool -> Tree d c -> Tree d c
g WeightedPSQ [Weight] Bool (Tree d c)
ts)
go TreeF d c (Tree d c)
x = TreeF d c (Tree d c)
x
enforceManualFlags :: M.Map PN [LabeledPackageConstraint] -> EndoTreeTrav d c
enforceManualFlags :: forall d c. Map PN [LabeledPackageConstraint] -> EndoTreeTrav d c
enforceManualFlags Map PN [LabeledPackageConstraint]
pcs = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
forall {d} {c} {d} {c}.
TreeF d c (Tree d c) -> TreeF d c (Tree d c)
go
where
go :: TreeF d c (Tree d c) -> TreeF d c (Tree d c)
go (FChoiceF qfn :: QFN
qfn@(FN (Q PackagePath
_ PN
pn) Flag
fn) RevDepMap
rdm c
gr WeakOrTrivial
tr FlagType
Manual Bool
d WeightedPSQ [Weight] Bool (Tree d c)
ts) =
QFN
-> RevDepMap
-> c
-> WeakOrTrivial
-> FlagType
-> Bool
-> WeightedPSQ [Weight] Bool (Tree d c)
-> TreeF d c (Tree d c)
forall d c a.
QFN
-> RevDepMap
-> c
-> WeakOrTrivial
-> FlagType
-> Bool
-> WeightedPSQ [Weight] Bool a
-> TreeF d c a
FChoiceF QFN
qfn RevDepMap
rdm c
gr WeakOrTrivial
tr FlagType
Manual Bool
d (WeightedPSQ [Weight] Bool (Tree d c) -> TreeF d c (Tree d c))
-> WeightedPSQ [Weight] Bool (Tree d c) -> TreeF d c (Tree d c)
forall a b. (a -> b) -> a -> b
$
let
flagConstraintValues :: [Bool]
flagConstraintValues :: [Bool]
flagConstraintValues =
[ Bool
flagVal
| let lpcs :: [LabeledPackageConstraint]
lpcs = [LabeledPackageConstraint]
-> PN
-> Map PN [LabeledPackageConstraint]
-> [LabeledPackageConstraint]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] PN
pn Map PN [LabeledPackageConstraint]
pcs
, (LabeledPackageConstraint (PackageConstraint ConstraintScope
_ (PackagePropertyFlags FlagAssignment
fa)) ConstraintSource
_) <- [LabeledPackageConstraint]
lpcs
, (Flag
fn', Bool
flagVal) <- FlagAssignment -> [(Flag, Bool)]
unFlagAssignment FlagAssignment
fa
, Flag
fn' Flag -> Flag -> Bool
forall a. Eq a => a -> a -> Bool
== Flag
fn ]
restrictToggling :: Eq a => a -> [a] -> a -> Tree d c -> Tree d c
restrictToggling :: forall a d c. Eq a => a -> [a] -> a -> Tree d c -> Tree d c
restrictToggling a
flagDefault [a]
constraintVals a
flagVal Tree d c
r =
if a
flagVal a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
constraintVals Bool -> Bool -> Bool
|| a
flagVal a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
flagDefault
then Tree d c
r
else ConflictSet -> FailReason -> Tree d c
forall d c. ConflictSet -> FailReason -> Tree d c
Fail (Var QPN -> ConflictSet
varToConflictSet (QFN -> Var QPN
forall qpn. FN qpn -> Var qpn
F QFN
qfn)) FailReason
ManualFlag
in (Bool -> Tree d c -> Tree d c)
-> WeightedPSQ [Weight] Bool (Tree d c)
-> WeightedPSQ [Weight] Bool (Tree d c)
forall k v1 v2 w.
(k -> v1 -> v2) -> WeightedPSQ w k v1 -> WeightedPSQ w k v2
W.mapWithKey (Bool -> [Bool] -> Bool -> Tree d c -> Tree d c
forall a d c. Eq a => a -> [a] -> a -> Tree d c -> Tree d c
restrictToggling Bool
d [Bool]
flagConstraintValues) WeightedPSQ [Weight] Bool (Tree d c)
ts
go TreeF d c (Tree d c)
x = TreeF d c (Tree d c)
x
requireInstalled :: (PN -> Bool) -> EndoTreeTrav d c
requireInstalled :: forall d c. (PN -> Bool) -> EndoTreeTrav d c
requireInstalled PN -> Bool
p = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
forall {d} {c} {d} {c}.
TreeF d c (Tree d c) -> TreeF d c (Tree d c)
go
where
go :: TreeF d c (Tree d c) -> TreeF d c (Tree d c)
go (PChoiceF v :: QPN
v@(Q PackagePath
_ PN
pn) RevDepMap
rdm c
gr WeightedPSQ [Weight] POption (Tree d c)
cs)
| PN -> Bool
p PN
pn = QPN
-> RevDepMap
-> c
-> WeightedPSQ [Weight] POption (Tree d c)
-> TreeF d c (Tree d c)
forall d c a.
QPN
-> RevDepMap -> c -> WeightedPSQ [Weight] POption a -> TreeF d c a
PChoiceF QPN
v RevDepMap
rdm c
gr ((POption -> Tree d c -> Tree d c)
-> WeightedPSQ [Weight] POption (Tree d c)
-> WeightedPSQ [Weight] POption (Tree d c)
forall k v1 v2 w.
(k -> v1 -> v2) -> WeightedPSQ w k v1 -> WeightedPSQ w k v2
W.mapWithKey POption -> Tree d c -> Tree d c
forall {d} {c}. POption -> Tree d c -> Tree d c
installed WeightedPSQ [Weight] POption (Tree d c)
cs)
| Bool
otherwise = QPN
-> RevDepMap
-> c
-> WeightedPSQ [Weight] POption (Tree d c)
-> TreeF d c (Tree d c)
forall d c a.
QPN
-> RevDepMap -> c -> WeightedPSQ [Weight] POption a -> TreeF d c a
PChoiceF QPN
v RevDepMap
rdm c
gr WeightedPSQ [Weight] POption (Tree d c)
cs
where
installed :: POption -> Tree d c -> Tree d c
installed (POption (I Ver
_ (Inst PId
_)) Maybe PackagePath
_) Tree d c
x = Tree d c
x
installed POption
_ Tree d c
_ = ConflictSet -> FailReason -> Tree d c
forall d c. ConflictSet -> FailReason -> Tree d c
Fail (Var QPN -> ConflictSet
varToConflictSet (QPN -> Var QPN
forall qpn. qpn -> Var qpn
P QPN
v)) FailReason
CannotInstall
go TreeF d c (Tree d c)
x = TreeF d c (Tree d c)
x
avoidReinstalls :: (PN -> Bool) -> EndoTreeTrav d c
avoidReinstalls :: forall d c. (PN -> Bool) -> EndoTreeTrav d c
avoidReinstalls PN -> Bool
p = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
forall {d} {c} {d} {c}.
TreeF d c (Tree d c) -> TreeF d c (Tree d c)
go
where
go :: TreeF d c (Tree d c) -> TreeF d c (Tree d c)
go (PChoiceF qpn :: QPN
qpn@(Q PackagePath
_ PN
pn) RevDepMap
rdm c
gr WeightedPSQ [Weight] POption (Tree d c)
cs)
| PN -> Bool
p PN
pn = QPN
-> RevDepMap
-> c
-> WeightedPSQ [Weight] POption (Tree d c)
-> TreeF d c (Tree d c)
forall d c a.
QPN
-> RevDepMap -> c -> WeightedPSQ [Weight] POption a -> TreeF d c a
PChoiceF QPN
qpn RevDepMap
rdm c
gr WeightedPSQ [Weight] POption (Tree d c)
disableReinstalls
| Bool
otherwise = QPN
-> RevDepMap
-> c
-> WeightedPSQ [Weight] POption (Tree d c)
-> TreeF d c (Tree d c)
forall d c a.
QPN
-> RevDepMap -> c -> WeightedPSQ [Weight] POption a -> TreeF d c a
PChoiceF QPN
qpn RevDepMap
rdm c
gr WeightedPSQ [Weight] POption (Tree d c)
cs
where
disableReinstalls :: WeightedPSQ [Weight] POption (Tree d c)
disableReinstalls =
let installed :: [Ver]
installed = [ Ver
v | ([Weight]
_, POption (I Ver
v (Inst PId
_)) Maybe PackagePath
_, Tree d c
_) <- WeightedPSQ [Weight] POption (Tree d c)
-> [([Weight], POption, Tree d c)]
forall w k v. WeightedPSQ w k v -> [(w, k, v)]
W.toList WeightedPSQ [Weight] POption (Tree d c)
cs ]
in (POption -> Tree d c -> Tree d c)
-> WeightedPSQ [Weight] POption (Tree d c)
-> WeightedPSQ [Weight] POption (Tree d c)
forall k v1 v2 w.
(k -> v1 -> v2) -> WeightedPSQ w k v1 -> WeightedPSQ w k v2
W.mapWithKey ([Ver] -> POption -> Tree d c -> Tree d c
forall {t :: * -> *} {d} {c}.
Foldable t =>
t Ver -> POption -> Tree d c -> Tree d c
notReinstall [Ver]
installed) WeightedPSQ [Weight] POption (Tree d c)
cs
notReinstall :: t Ver -> POption -> Tree d c -> Tree d c
notReinstall t Ver
vs (POption (I Ver
v Loc
InRepo) Maybe PackagePath
_) Tree d c
_ | Ver
v Ver -> t Ver -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Ver
vs =
ConflictSet -> FailReason -> Tree d c
forall d c. ConflictSet -> FailReason -> Tree d c
Fail (Var QPN -> ConflictSet
varToConflictSet (QPN -> Var QPN
forall qpn. qpn -> Var qpn
P QPN
qpn)) FailReason
CannotReinstall
notReinstall t Ver
_ POption
_ Tree d c
x =
Tree d c
x
go TreeF d c (Tree d c)
x = TreeF d c (Tree d c)
x
onlyConstrained :: (PN -> Bool) -> EndoTreeTrav d QGoalReason
onlyConstrained :: forall d. (PN -> Bool) -> EndoTreeTrav d QGoalReason
onlyConstrained PN -> Bool
p = TreeF d QGoalReason (Tree d QGoalReason)
-> TreeF d QGoalReason (Tree d QGoalReason)
forall {d} {a}. TreeF d QGoalReason a -> TreeF d QGoalReason a
go
where
go :: TreeF d QGoalReason a -> TreeF d QGoalReason a
go (PChoiceF v :: QPN
v@(Q PackagePath
_ PN
pn) RevDepMap
_ QGoalReason
gr WeightedPSQ [Weight] POption a
_) | Bool -> Bool
not (PN -> Bool
p PN
pn)
= ConflictSet -> FailReason -> TreeF d QGoalReason a
forall d c a. ConflictSet -> FailReason -> TreeF d c a
FailF
(Var QPN -> ConflictSet
varToConflictSet (QPN -> Var QPN
forall qpn. qpn -> Var qpn
P QPN
v) ConflictSet -> ConflictSet -> ConflictSet
`CS.union` QPN -> QGoalReason -> ConflictSet
goalReasonToConflictSetWithConflict QPN
v QGoalReason
gr)
FailReason
NotExplicit
go TreeF d QGoalReason a
x
= TreeF d QGoalReason a
x
sortGoals :: (Variable QPN -> Variable QPN -> Ordering) -> EndoTreeTrav d c
sortGoals :: forall d c.
(Variable QPN -> Variable QPN -> Ordering) -> EndoTreeTrav d c
sortGoals Variable QPN -> Variable QPN -> Ordering
variableOrder = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
forall {d} {c} {a}. TreeF d c a -> TreeF d c a
go
where
go :: TreeF d c a -> TreeF d c a
go (GoalChoiceF RevDepMap
rdm PSQ (Goal QPN) a
xs) = RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
forall d c a. RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
GoalChoiceF RevDepMap
rdm ((Goal QPN -> Goal QPN -> Ordering)
-> PSQ (Goal QPN) a -> PSQ (Goal QPN) a
forall k a. (k -> k -> Ordering) -> PSQ k a -> PSQ k a
P.sortByKeys Goal QPN -> Goal QPN -> Ordering
goalOrder PSQ (Goal QPN) a
xs)
go TreeF d c a
x = TreeF d c a
x
goalOrder :: Goal QPN -> Goal QPN -> Ordering
goalOrder :: Goal QPN -> Goal QPN -> Ordering
goalOrder = Variable QPN -> Variable QPN -> Ordering
variableOrder (Variable QPN -> Variable QPN -> Ordering)
-> (Goal QPN -> Variable QPN) -> Goal QPN -> Goal QPN -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Var QPN -> Variable QPN
varToVariable (Var QPN -> Variable QPN)
-> (Goal QPN -> Var QPN) -> Goal QPN -> Variable QPN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Goal QPN -> Var QPN
forall a. Goal a -> Var a
goalToVar)
varToVariable :: Var QPN -> Variable QPN
varToVariable :: Var QPN -> Variable QPN
varToVariable (P QPN
qpn) = QPN -> Variable QPN
forall qpn. qpn -> Variable qpn
PackageVar QPN
qpn
varToVariable (F (FN QPN
qpn Flag
fn)) = QPN -> Flag -> Variable QPN
forall qpn. qpn -> Flag -> Variable qpn
FlagVar QPN
qpn Flag
fn
varToVariable (S (SN QPN
qpn OptionalStanza
stanza)) = QPN -> OptionalStanza -> Variable QPN
forall qpn. qpn -> OptionalStanza -> Variable qpn
StanzaVar QPN
qpn OptionalStanza
stanza
pruneAfterFirstSuccess :: EndoTreeTrav d c
pruneAfterFirstSuccess :: forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
pruneAfterFirstSuccess = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
forall {d} {c} {d} {c}.
TreeF d c (Tree d c) -> TreeF d c (Tree d c)
go
where
go :: TreeF d c (Tree d c) -> TreeF d c (Tree d c)
go (PChoiceF QPN
qpn RevDepMap
rdm c
gr WeightedPSQ [Weight] POption (Tree d c)
ts) = QPN
-> RevDepMap
-> c
-> WeightedPSQ [Weight] POption (Tree d c)
-> TreeF d c (Tree d c)
forall d c a.
QPN
-> RevDepMap -> c -> WeightedPSQ [Weight] POption a -> TreeF d c a
PChoiceF QPN
qpn RevDepMap
rdm c
gr ((Tree d c -> Bool)
-> WeightedPSQ [Weight] POption (Tree d c)
-> WeightedPSQ [Weight] POption (Tree d c)
forall w k v. (v -> Bool) -> WeightedPSQ w k v -> WeightedPSQ w k v
W.takeUntil Tree d c -> Bool
forall d c. Tree d c -> Bool
active WeightedPSQ [Weight] POption (Tree d c)
ts)
go (FChoiceF QFN
qfn RevDepMap
rdm c
gr WeakOrTrivial
w FlagType
m Bool
d WeightedPSQ [Weight] Bool (Tree d c)
ts) = QFN
-> RevDepMap
-> c
-> WeakOrTrivial
-> FlagType
-> Bool
-> WeightedPSQ [Weight] Bool (Tree d c)
-> TreeF d c (Tree d c)
forall d c a.
QFN
-> RevDepMap
-> c
-> WeakOrTrivial
-> FlagType
-> Bool
-> WeightedPSQ [Weight] Bool a
-> TreeF d c a
FChoiceF QFN
qfn RevDepMap
rdm c
gr WeakOrTrivial
w FlagType
m Bool
d ((Tree d c -> Bool)
-> WeightedPSQ [Weight] Bool (Tree d c)
-> WeightedPSQ [Weight] Bool (Tree d c)
forall w k v. (v -> Bool) -> WeightedPSQ w k v -> WeightedPSQ w k v
W.takeUntil Tree d c -> Bool
forall d c. Tree d c -> Bool
active WeightedPSQ [Weight] Bool (Tree d c)
ts)
go (SChoiceF QSN
qsn RevDepMap
rdm c
gr WeakOrTrivial
w WeightedPSQ [Weight] Bool (Tree d c)
ts) = QSN
-> RevDepMap
-> c
-> WeakOrTrivial
-> WeightedPSQ [Weight] Bool (Tree d c)
-> TreeF d c (Tree d c)
forall d c a.
QSN
-> RevDepMap
-> c
-> WeakOrTrivial
-> WeightedPSQ [Weight] Bool a
-> TreeF d c a
SChoiceF QSN
qsn RevDepMap
rdm c
gr WeakOrTrivial
w ((Tree d c -> Bool)
-> WeightedPSQ [Weight] Bool (Tree d c)
-> WeightedPSQ [Weight] Bool (Tree d c)
forall w k v. (v -> Bool) -> WeightedPSQ w k v -> WeightedPSQ w k v
W.takeUntil Tree d c -> Bool
forall d c. Tree d c -> Bool
active WeightedPSQ [Weight] Bool (Tree d c)
ts)
go TreeF d c (Tree d c)
x = TreeF d c (Tree d c)
x
firstGoal :: EndoTreeTrav d c
firstGoal :: forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
firstGoal = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
forall {d} {c} {a}. TreeF d c a -> TreeF d c a
go
where
go :: TreeF d c a -> TreeF d c a
go (GoalChoiceF RevDepMap
rdm PSQ (Goal QPN) a
xs) = RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
forall d c a. RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
GoalChoiceF RevDepMap
rdm (PSQ (Goal QPN) a -> PSQ (Goal QPN) a
forall k a. PSQ k a -> PSQ k a
P.firstOnly PSQ (Goal QPN) a
xs)
go TreeF d c a
x = TreeF d c a
x
preferBaseGoalChoice :: EndoTreeTrav d c
preferBaseGoalChoice :: forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
preferBaseGoalChoice = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
forall {d} {c} {a}. TreeF d c a -> TreeF d c a
go
where
go :: TreeF d c a -> TreeF d c a
go (GoalChoiceF RevDepMap
rdm PSQ (Goal QPN) a
xs) = RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
forall d c a. RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
GoalChoiceF RevDepMap
rdm ((Goal QPN -> Bool) -> PSQ (Goal QPN) a -> PSQ (Goal QPN) a
forall k a. (k -> Bool) -> PSQ k a -> PSQ k a
P.filterIfAnyByKeys Goal QPN -> Bool
isBase PSQ (Goal QPN) a
xs)
go TreeF d c a
x = TreeF d c a
x
isBase :: Goal QPN -> Bool
isBase :: Goal QPN -> Bool
isBase (Goal (P (Q PackagePath
_pp PN
pn)) QGoalReason
_) = PN -> String
unPN PN
pn String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"base"
isBase Goal QPN
_ = Bool
False
deferSetupExeChoices :: EndoTreeTrav d c
deferSetupExeChoices :: forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
deferSetupExeChoices = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
forall {d} {c} {a}. TreeF d c a -> TreeF d c a
go
where
go :: TreeF d c a -> TreeF d c a
go (GoalChoiceF RevDepMap
rdm PSQ (Goal QPN) a
xs) = RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
forall d c a. RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
GoalChoiceF RevDepMap
rdm ((Goal QPN -> Bool) -> PSQ (Goal QPN) a -> PSQ (Goal QPN) a
forall k a. (k -> Bool) -> PSQ k a -> PSQ k a
P.preferByKeys Goal QPN -> Bool
noSetupOrExe PSQ (Goal QPN) a
xs)
go TreeF d c a
x = TreeF d c a
x
noSetupOrExe :: Goal QPN -> Bool
noSetupOrExe :: Goal QPN -> Bool
noSetupOrExe (Goal (P (Q (PackagePath Namespace
_ns (QualSetup PN
_)) PN
_)) QGoalReason
_) = Bool
False
noSetupOrExe (Goal (P (Q (PackagePath Namespace
_ns (QualExe PN
_ PN
_)) PN
_)) QGoalReason
_) = Bool
False
noSetupOrExe Goal QPN
_ = Bool
True
deferWeakFlagChoices :: EndoTreeTrav d c
deferWeakFlagChoices :: forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
deferWeakFlagChoices = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
forall {d} {c} {d} {c}.
TreeF d c (Tree d c) -> TreeF d c (Tree d c)
go
where
go :: TreeF d c (Tree d c) -> TreeF d c (Tree d c)
go (GoalChoiceF RevDepMap
rdm PSQ (Goal QPN) (Tree d c)
xs) = RevDepMap -> PSQ (Goal QPN) (Tree d c) -> TreeF d c (Tree d c)
forall d c a. RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
GoalChoiceF RevDepMap
rdm ((Tree d c -> Bool)
-> PSQ (Goal QPN) (Tree d c) -> PSQ (Goal QPN) (Tree d c)
forall a k. (a -> Bool) -> PSQ k a -> PSQ k a
P.prefer Tree d c -> Bool
forall d c. Tree d c -> Bool
noWeakFlag ((Tree d c -> Bool)
-> PSQ (Goal QPN) (Tree d c) -> PSQ (Goal QPN) (Tree d c)
forall a k. (a -> Bool) -> PSQ k a -> PSQ k a
P.prefer Tree d c -> Bool
forall d c. Tree d c -> Bool
noWeakStanza PSQ (Goal QPN) (Tree d c)
xs))
go TreeF d c (Tree d c)
x = TreeF d c (Tree d c)
x
noWeakStanza :: Tree d c -> Bool
noWeakStanza :: forall d c. Tree d c -> Bool
noWeakStanza (SChoice QSN
_ RevDepMap
_ c
_ (WeakOrTrivial Bool
True) WeightedPSQ [Weight] Bool (Tree d c)
_) = Bool
False
noWeakStanza Tree d c
_ = Bool
True
noWeakFlag :: Tree d c -> Bool
noWeakFlag :: forall d c. Tree d c -> Bool
noWeakFlag (FChoice QFN
_ RevDepMap
_ c
_ (WeakOrTrivial Bool
True) FlagType
_ Bool
_ WeightedPSQ [Weight] Bool (Tree d c)
_) = Bool
False
noWeakFlag Tree d c
_ = Bool
True
preferReallyEasyGoalChoices :: EndoTreeTrav d c
preferReallyEasyGoalChoices :: forall d c. TreeF d c (Tree d c) -> TreeF d c (Tree d c)
preferReallyEasyGoalChoices = TreeF d c (Tree d c) -> TreeF d c (Tree d c)
forall {d} {c} {d} {c}.
TreeF d c (Tree d c) -> TreeF d c (Tree d c)
go
where
go :: TreeF d c (Tree d c) -> TreeF d c (Tree d c)
go (GoalChoiceF RevDepMap
rdm PSQ (Goal QPN) (Tree d c)
xs) = RevDepMap -> PSQ (Goal QPN) (Tree d c) -> TreeF d c (Tree d c)
forall d c a. RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
GoalChoiceF RevDepMap
rdm ((Tree d c -> Bool)
-> PSQ (Goal QPN) (Tree d c) -> PSQ (Goal QPN) (Tree d c)
forall a k. (a -> Bool) -> PSQ k a -> PSQ k a
P.filterIfAny Tree d c -> Bool
forall d c. Tree d c -> Bool
zeroOrOneChoices PSQ (Goal QPN) (Tree d c)
xs)
go TreeF d c (Tree d c)
x = TreeF d c (Tree d c)
x
type EnforceSIR = Reader (Map (PI PN) QPN)
enforceSingleInstanceRestriction :: Tree d c -> Tree d c
enforceSingleInstanceRestriction :: forall d c. Tree d c -> Tree d c
enforceSingleInstanceRestriction = (Reader (Map (PI PN) QPN) (Tree d c) -> Map (PI PN) QPN -> Tree d c
forall r a. Reader r a -> r -> a
`runReader` Map (PI PN) QPN
forall k a. Map k a
M.empty) (Reader (Map (PI PN) QPN) (Tree d c) -> Tree d c)
-> (Tree d c -> Reader (Map (PI PN) QPN) (Tree d c))
-> Tree d c
-> Tree d c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree d c -> Reader (Map (PI PN) QPN) (Tree d c)
forall d c. Tree d c -> EnforceSIR (Tree d c)
go
where
go :: Tree d c -> EnforceSIR (Tree d c)
go :: forall d c. Tree d c -> EnforceSIR (Tree d c)
go (PChoice QPN
qpn RevDepMap
rdm c
gr WeightedPSQ [Weight] POption (Tree d c)
cs) =
QPN
-> RevDepMap
-> c
-> WeightedPSQ [Weight] POption (Tree d c)
-> Tree d c
forall d c.
QPN
-> RevDepMap
-> c
-> WeightedPSQ [Weight] POption (Tree d c)
-> Tree d c
PChoice QPN
qpn RevDepMap
rdm c
gr (WeightedPSQ [Weight] POption (Tree d c) -> Tree d c)
-> ReaderT
(Map (PI PN) QPN)
Identity
(WeightedPSQ [Weight] POption (Tree d c))
-> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WeightedPSQ
[Weight] POption (ReaderT (Map (PI PN) QPN) Identity (Tree d c))
-> ReaderT
(Map (PI PN) QPN)
Identity
(WeightedPSQ [Weight] POption (Tree d c))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
WeightedPSQ [Weight] POption (f a)
-> f (WeightedPSQ [Weight] POption a)
sequenceA ((POption
-> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
-> ReaderT (Map (PI PN) QPN) Identity (Tree d c))
-> WeightedPSQ
[Weight] POption (ReaderT (Map (PI PN) QPN) Identity (Tree d c))
-> WeightedPSQ
[Weight] POption (ReaderT (Map (PI PN) QPN) Identity (Tree d c))
forall k v1 v2 w.
(k -> v1 -> v2) -> WeightedPSQ w k v1 -> WeightedPSQ w k v2
W.mapWithKey (QPN
-> POption
-> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
-> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
forall d c.
QPN -> POption -> EnforceSIR (Tree d c) -> EnforceSIR (Tree d c)
goP QPN
qpn) ((Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c))
-> WeightedPSQ [Weight] POption (Tree d c)
-> WeightedPSQ
[Weight] POption (ReaderT (Map (PI PN) QPN) Identity (Tree d c))
forall a b.
(a -> b)
-> WeightedPSQ [Weight] POption a -> WeightedPSQ [Weight] POption b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
forall d c. Tree d c -> EnforceSIR (Tree d c)
go WeightedPSQ [Weight] POption (Tree d c)
cs))
go (FChoice QFN
qfn RevDepMap
rdm c
y WeakOrTrivial
t FlagType
m Bool
d WeightedPSQ [Weight] Bool (Tree d c)
ts) =
QFN
-> RevDepMap
-> c
-> WeakOrTrivial
-> FlagType
-> Bool
-> WeightedPSQ [Weight] Bool (Tree d c)
-> Tree d c
forall d c.
QFN
-> RevDepMap
-> c
-> WeakOrTrivial
-> FlagType
-> Bool
-> WeightedPSQ [Weight] Bool (Tree d c)
-> Tree d c
FChoice QFN
qfn RevDepMap
rdm c
y WeakOrTrivial
t FlagType
m Bool
d (WeightedPSQ [Weight] Bool (Tree d c) -> Tree d c)
-> ReaderT
(Map (PI PN) QPN) Identity (WeightedPSQ [Weight] Bool (Tree d c))
-> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c))
-> WeightedPSQ [Weight] Bool (Tree d c)
-> ReaderT
(Map (PI PN) QPN) Identity (WeightedPSQ [Weight] Bool (Tree d c))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> WeightedPSQ [Weight] Bool a -> f (WeightedPSQ [Weight] Bool b)
traverse Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
forall d c. Tree d c -> EnforceSIR (Tree d c)
go WeightedPSQ [Weight] Bool (Tree d c)
ts
go (SChoice QSN
qsn RevDepMap
rdm c
y WeakOrTrivial
t WeightedPSQ [Weight] Bool (Tree d c)
ts) =
QSN
-> RevDepMap
-> c
-> WeakOrTrivial
-> WeightedPSQ [Weight] Bool (Tree d c)
-> Tree d c
forall d c.
QSN
-> RevDepMap
-> c
-> WeakOrTrivial
-> WeightedPSQ [Weight] Bool (Tree d c)
-> Tree d c
SChoice QSN
qsn RevDepMap
rdm c
y WeakOrTrivial
t (WeightedPSQ [Weight] Bool (Tree d c) -> Tree d c)
-> ReaderT
(Map (PI PN) QPN) Identity (WeightedPSQ [Weight] Bool (Tree d c))
-> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c))
-> WeightedPSQ [Weight] Bool (Tree d c)
-> ReaderT
(Map (PI PN) QPN) Identity (WeightedPSQ [Weight] Bool (Tree d c))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> WeightedPSQ [Weight] Bool a -> f (WeightedPSQ [Weight] Bool b)
traverse Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
forall d c. Tree d c -> EnforceSIR (Tree d c)
go WeightedPSQ [Weight] Bool (Tree d c)
ts
go (GoalChoice RevDepMap
rdm PSQ (Goal QPN) (Tree d c)
ts) =
RevDepMap -> PSQ (Goal QPN) (Tree d c) -> Tree d c
forall d c. RevDepMap -> PSQ (Goal QPN) (Tree d c) -> Tree d c
GoalChoice RevDepMap
rdm (PSQ (Goal QPN) (Tree d c) -> Tree d c)
-> ReaderT (Map (PI PN) QPN) Identity (PSQ (Goal QPN) (Tree d c))
-> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c))
-> PSQ (Goal QPN) (Tree d c)
-> ReaderT (Map (PI PN) QPN) Identity (PSQ (Goal QPN) (Tree d c))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PSQ (Goal QPN) a -> f (PSQ (Goal QPN) b)
traverse Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
forall d c. Tree d c -> EnforceSIR (Tree d c)
go PSQ (Goal QPN) (Tree d c)
ts
go x :: Tree d c
x@(Fail ConflictSet
_ FailReason
_) = Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
forall a. a -> ReaderT (Map (PI PN) QPN) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Tree d c
x
go x :: Tree d c
x@(Done RevDepMap
_ d
_) = Tree d c -> ReaderT (Map (PI PN) QPN) Identity (Tree d c)
forall a. a -> ReaderT (Map (PI PN) QPN) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Tree d c
x
goP :: QPN -> POption -> EnforceSIR (Tree d c) -> EnforceSIR (Tree d c)
goP :: forall d c.
QPN -> POption -> EnforceSIR (Tree d c) -> EnforceSIR (Tree d c)
goP qpn :: QPN
qpn@(Q PackagePath
_ PN
pn) (POption I
i Maybe PackagePath
linkedTo) EnforceSIR (Tree d c)
r = do
let inst :: PI PN
inst = PN -> I -> PI PN
forall qpn. qpn -> I -> PI qpn
PI PN
pn I
i
Map (PI PN) QPN
env <- ReaderT (Map (PI PN) QPN) Identity (Map (PI PN) QPN)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
case (Maybe PackagePath
linkedTo, PI PN -> Map (PI PN) QPN -> Maybe QPN
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PI PN
inst Map (PI PN) QPN
env) of
(Just PackagePath
_, Maybe QPN
_) ->
EnforceSIR (Tree d c)
r
(Maybe PackagePath
Nothing, Maybe QPN
Nothing) ->
(Map (PI PN) QPN -> Map (PI PN) QPN)
-> EnforceSIR (Tree d c) -> EnforceSIR (Tree d c)
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (PI PN -> QPN -> Map (PI PN) QPN -> Map (PI PN) QPN
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert PI PN
inst QPN
qpn) EnforceSIR (Tree d c)
r
(Maybe PackagePath
Nothing, Just QPN
qpn') -> do
Tree d c -> EnforceSIR (Tree d c)
forall a. a -> ReaderT (Map (PI PN) QPN) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tree d c -> EnforceSIR (Tree d c))
-> Tree d c -> EnforceSIR (Tree d c)
forall a b. (a -> b) -> a -> b
$ ConflictSet -> FailReason -> Tree d c
forall d c. ConflictSet -> FailReason -> Tree d c
Fail (ConflictSet -> ConflictSet -> ConflictSet
CS.union (Var QPN -> ConflictSet
varToConflictSet (QPN -> Var QPN
forall qpn. qpn -> Var qpn
P QPN
qpn)) (Var QPN -> ConflictSet
varToConflictSet (QPN -> Var QPN
forall qpn. qpn -> Var qpn
P QPN
qpn'))) FailReason
MultipleInstances