{-# LANGUAGE ScopedTypeVariables #-}
module Distribution.Solver.Modular.Builder (
buildTree
, splits
) where
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S
import Prelude
import qualified Distribution.Solver.Modular.ConflictSet as CS
import Distribution.Solver.Modular.Dependency
import Distribution.Solver.Modular.Flag
import Distribution.Solver.Modular.Index
import Distribution.Solver.Modular.Package
import qualified Distribution.Solver.Modular.PSQ as P
import Distribution.Solver.Modular.Tree
import qualified Distribution.Solver.Modular.WeightedPSQ as W
import Distribution.Solver.Types.ComponentDeps
import Distribution.Solver.Types.PackagePath
import Distribution.Solver.Types.Settings
data Linker a = Linker {
forall a. Linker a -> a
buildState :: a,
forall a. Linker a -> LinkingState
linkingState :: LinkingState
}
data BuildState = BS {
BuildState -> Index
index :: Index,
BuildState -> RevDepMap
rdeps :: RevDepMap,
BuildState -> [OpenGoal]
open :: [OpenGoal],
BuildState -> BuildType
next :: BuildType,
BuildState -> QualifyOptions
qualifyOptions :: QualifyOptions
}
type LinkingState = M.Map (PN, I) [PackagePath]
extendOpen :: QPN -> [FlaggedDep QPN] -> BuildState -> BuildState
extendOpen :: QPN -> [FlaggedDep QPN] -> BuildState -> BuildState
extendOpen QPN
qpn' [FlaggedDep QPN]
gs s :: BuildState
s@(BS { rdeps :: BuildState -> RevDepMap
rdeps = RevDepMap
gs', open :: BuildState -> [OpenGoal]
open = [OpenGoal]
o' }) = RevDepMap -> [OpenGoal] -> [FlaggedDep QPN] -> BuildState
go RevDepMap
gs' [OpenGoal]
o' [FlaggedDep QPN]
gs
where
go :: RevDepMap -> [OpenGoal] -> [FlaggedDep QPN] -> BuildState
go :: RevDepMap -> [OpenGoal] -> [FlaggedDep QPN] -> BuildState
go RevDepMap
g [OpenGoal]
o [] = BuildState
s { rdeps :: RevDepMap
rdeps = RevDepMap
g, open :: [OpenGoal]
open = [OpenGoal]
o }
go RevDepMap
g [OpenGoal]
o ((Flagged fn :: FN QPN
fn@(FN QPN
qpn Flag
_) FInfo
fInfo [FlaggedDep QPN]
t [FlaggedDep QPN]
f) : [FlaggedDep QPN]
ngs) =
RevDepMap -> [OpenGoal] -> [FlaggedDep QPN] -> BuildState
go RevDepMap
g (FN QPN
-> FInfo
-> [FlaggedDep QPN]
-> [FlaggedDep QPN]
-> QGoalReason
-> OpenGoal
FlagGoal FN QPN
fn FInfo
fInfo [FlaggedDep QPN]
t [FlaggedDep QPN]
f (QPN -> QGoalReason
forall qpn. qpn -> GoalReason qpn
flagGR QPN
qpn) OpenGoal -> [OpenGoal] -> [OpenGoal]
forall a. a -> [a] -> [a]
: [OpenGoal]
o) [FlaggedDep QPN]
ngs
go RevDepMap
g [OpenGoal]
o ((Stanza sn :: SN QPN
sn@(SN QPN
qpn Stanza
_) [FlaggedDep QPN]
t) : [FlaggedDep QPN]
ngs) =
RevDepMap -> [OpenGoal] -> [FlaggedDep QPN] -> BuildState
go RevDepMap
g (SN QPN -> [FlaggedDep QPN] -> QGoalReason -> OpenGoal
StanzaGoal SN QPN
sn [FlaggedDep QPN]
t (QPN -> QGoalReason
forall qpn. qpn -> GoalReason qpn
flagGR QPN
qpn) OpenGoal -> [OpenGoal] -> [OpenGoal]
forall a. a -> [a] -> [a]
: [OpenGoal]
o) [FlaggedDep QPN]
ngs
go RevDepMap
g [OpenGoal]
o ((Simple (LDep DependencyReason QPN
dr (Dep (PkgComponent QPN
qpn ExposedComponent
_) CI
_)) Component
c) : [FlaggedDep QPN]
ngs)
| QPN
qpn QPN -> QPN -> Bool
forall a. Eq a => a -> a -> Bool
== QPN
qpn' =
case Component
c of
Component
ComponentSetup -> RevDepMap -> [OpenGoal] -> [FlaggedDep QPN] -> BuildState
go (([(Component, QPN)] -> [(Component, QPN)])
-> QPN -> RevDepMap -> RevDepMap
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust ((Component, QPN) -> [(Component, QPN)] -> [(Component, QPN)]
forall a. Eq a => a -> [a] -> [a]
addIfAbsent (Component
ComponentSetup, QPN
qpn')) QPN
qpn RevDepMap
g) [OpenGoal]
o [FlaggedDep QPN]
ngs
Component
_ -> RevDepMap -> [OpenGoal] -> [FlaggedDep QPN] -> BuildState
go RevDepMap
g [OpenGoal]
o [FlaggedDep QPN]
ngs
| QPN
qpn QPN -> RevDepMap -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` RevDepMap
g = RevDepMap -> [OpenGoal] -> [FlaggedDep QPN] -> BuildState
go (([(Component, QPN)] -> [(Component, QPN)])
-> QPN -> RevDepMap -> RevDepMap
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust ((Component, QPN) -> [(Component, QPN)] -> [(Component, QPN)]
forall a. Eq a => a -> [a] -> [a]
addIfAbsent (Component
c, QPN
qpn')) QPN
qpn RevDepMap
g) [OpenGoal]
o [FlaggedDep QPN]
ngs
| Bool
otherwise = RevDepMap -> [OpenGoal] -> [FlaggedDep QPN] -> BuildState
go (QPN -> [(Component, QPN)] -> RevDepMap -> RevDepMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert QPN
qpn [(Component
c, QPN
qpn')] RevDepMap
g) (QPN -> QGoalReason -> OpenGoal
PkgGoal QPN
qpn (DependencyReason QPN -> QGoalReason
forall qpn. DependencyReason qpn -> GoalReason qpn
DependencyGoal DependencyReason QPN
dr) OpenGoal -> [OpenGoal] -> [OpenGoal]
forall a. a -> [a] -> [a]
: [OpenGoal]
o) [FlaggedDep QPN]
ngs
go RevDepMap
g [OpenGoal]
o ((Simple (LDep DependencyReason QPN
_dr (Ext Extension
_ext )) Component
_) : [FlaggedDep QPN]
ngs) = RevDepMap -> [OpenGoal] -> [FlaggedDep QPN] -> BuildState
go RevDepMap
g [OpenGoal]
o [FlaggedDep QPN]
ngs
go RevDepMap
g [OpenGoal]
o ((Simple (LDep DependencyReason QPN
_dr (Lang Language
_lang))Component
_) : [FlaggedDep QPN]
ngs) = RevDepMap -> [OpenGoal] -> [FlaggedDep QPN] -> BuildState
go RevDepMap
g [OpenGoal]
o [FlaggedDep QPN]
ngs
go RevDepMap
g [OpenGoal]
o ((Simple (LDep DependencyReason QPN
_dr (Pkg PkgconfigName
_pn PkgconfigVersionRange
_vr))Component
_) : [FlaggedDep QPN]
ngs) = RevDepMap -> [OpenGoal] -> [FlaggedDep QPN] -> BuildState
go RevDepMap
g [OpenGoal]
o [FlaggedDep QPN]
ngs
addIfAbsent :: Eq a => a -> [a] -> [a]
addIfAbsent :: forall a. Eq a => a -> [a] -> [a]
addIfAbsent a
x [a]
xs = if a
x a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
xs then [a]
xs else a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
flagGR :: qpn -> GoalReason qpn
flagGR :: forall qpn. qpn -> GoalReason qpn
flagGR qpn
qpn = DependencyReason qpn -> GoalReason qpn
forall qpn. DependencyReason qpn -> GoalReason qpn
DependencyGoal (qpn -> Map Flag FlagValue -> Set Stanza -> DependencyReason qpn
forall qpn.
qpn -> Map Flag FlagValue -> Set Stanza -> DependencyReason qpn
DependencyReason qpn
qpn Map Flag FlagValue
forall k a. Map k a
M.empty Set Stanza
forall a. Set a
S.empty)
scopedExtendOpen :: QPN -> FlaggedDeps PN -> FlagInfo ->
BuildState -> BuildState
scopedExtendOpen :: QPN
-> FlaggedDeps PackageName -> FlagInfo -> BuildState -> BuildState
scopedExtendOpen QPN
qpn FlaggedDeps PackageName
fdeps FlagInfo
fdefs BuildState
s = QPN -> [FlaggedDep QPN] -> BuildState -> BuildState
extendOpen QPN
qpn [FlaggedDep QPN]
gs BuildState
s
where
qfdeps :: [FlaggedDep QPN]
qfdeps = QualifyOptions
-> QPN -> FlaggedDeps PackageName -> [FlaggedDep QPN]
qualifyDeps (BuildState -> QualifyOptions
qualifyOptions BuildState
s) QPN
qpn FlaggedDeps PackageName
fdeps
qfdefs :: [FlaggedDep QPN]
qfdefs = ((Flag, FInfo) -> FlaggedDep QPN)
-> [(Flag, FInfo)] -> [FlaggedDep QPN]
forall a b. (a -> b) -> [a] -> [b]
L.map (\ (Flag
fn, FInfo
b) -> FN QPN
-> FInfo -> [FlaggedDep QPN] -> [FlaggedDep QPN] -> FlaggedDep QPN
forall qpn.
FN qpn
-> FInfo
-> TrueFlaggedDeps qpn
-> TrueFlaggedDeps qpn
-> FlaggedDep qpn
Flagged (QPN -> Flag -> FN QPN
forall qpn. qpn -> Flag -> FN qpn
FN QPN
qpn Flag
fn) FInfo
b [] []) ([(Flag, FInfo)] -> [FlaggedDep QPN])
-> [(Flag, FInfo)] -> [FlaggedDep QPN]
forall a b. (a -> b) -> a -> b
$ FlagInfo -> [(Flag, FInfo)]
forall k a. Map k a -> [(k, a)]
M.toList FlagInfo
fdefs
gs :: [FlaggedDep QPN]
gs = [FlaggedDep QPN]
qfdefs [FlaggedDep QPN] -> [FlaggedDep QPN] -> [FlaggedDep QPN]
forall a. [a] -> [a] -> [a]
++ [FlaggedDep QPN]
qfdeps
data BuildType =
Goals
| OneGoal OpenGoal
| Instance QPN PInfo
build :: Linker BuildState -> Tree () QGoalReason
build :: Linker BuildState -> Tree () QGoalReason
build = (Linker BuildState -> TreeF () QGoalReason (Linker BuildState))
-> Linker BuildState -> Tree () QGoalReason
forall a d c. (a -> TreeF d c a) -> a -> Tree d c
ana Linker BuildState -> TreeF () QGoalReason (Linker BuildState)
go
where
go :: Linker BuildState -> TreeF () QGoalReason (Linker BuildState)
go :: Linker BuildState -> TreeF () QGoalReason (Linker BuildState)
go Linker BuildState
s = LinkingState
-> TreeF () QGoalReason BuildState
-> TreeF () QGoalReason (Linker BuildState)
forall c a. LinkingState -> TreeF () c a -> TreeF () c (Linker a)
addLinking (Linker BuildState -> LinkingState
forall a. Linker a -> LinkingState
linkingState Linker BuildState
s) (TreeF () QGoalReason BuildState
-> TreeF () QGoalReason (Linker BuildState))
-> TreeF () QGoalReason BuildState
-> TreeF () QGoalReason (Linker BuildState)
forall a b. (a -> b) -> a -> b
$ BuildState -> TreeF () QGoalReason BuildState
addChildren (Linker BuildState -> BuildState
forall a. Linker a -> a
buildState Linker BuildState
s)
addChildren :: BuildState -> TreeF () QGoalReason BuildState
addChildren :: BuildState -> TreeF () QGoalReason BuildState
addChildren bs :: BuildState
bs@(BS { rdeps :: BuildState -> RevDepMap
rdeps = RevDepMap
rdm, open :: BuildState -> [OpenGoal]
open = [OpenGoal]
gs, next :: BuildState -> BuildType
next = BuildType
Goals })
| [OpenGoal] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [OpenGoal]
gs = RevDepMap -> () -> TreeF () QGoalReason BuildState
forall d c a. RevDepMap -> d -> TreeF d c a
DoneF RevDepMap
rdm ()
| Bool
otherwise = RevDepMap
-> PSQ (Goal QPN) BuildState -> TreeF () QGoalReason BuildState
forall d c a. RevDepMap -> PSQ (Goal QPN) a -> TreeF d c a
GoalChoiceF RevDepMap
rdm (PSQ (Goal QPN) BuildState -> TreeF () QGoalReason BuildState)
-> PSQ (Goal QPN) BuildState -> TreeF () QGoalReason BuildState
forall a b. (a -> b) -> a -> b
$ [(Goal QPN, BuildState)] -> PSQ (Goal QPN) BuildState
forall k a. [(k, a)] -> PSQ k a
P.fromList
([(Goal QPN, BuildState)] -> PSQ (Goal QPN) BuildState)
-> [(Goal QPN, BuildState)] -> PSQ (Goal QPN) BuildState
forall a b. (a -> b) -> a -> b
$ ((OpenGoal, [OpenGoal]) -> (Goal QPN, BuildState))
-> [(OpenGoal, [OpenGoal])] -> [(Goal QPN, BuildState)]
forall a b. (a -> b) -> [a] -> [b]
L.map (\ (OpenGoal
g, [OpenGoal]
gs') -> (OpenGoal -> Goal QPN
close OpenGoal
g, BuildState
bs { next :: BuildType
next = OpenGoal -> BuildType
OneGoal OpenGoal
g, open :: [OpenGoal]
open = [OpenGoal]
gs' }))
([(OpenGoal, [OpenGoal])] -> [(Goal QPN, BuildState)])
-> [(OpenGoal, [OpenGoal])] -> [(Goal QPN, BuildState)]
forall a b. (a -> b) -> a -> b
$ [OpenGoal] -> [(OpenGoal, [OpenGoal])]
forall a. [a] -> [(a, [a])]
splits [OpenGoal]
gs
addChildren bs :: BuildState
bs@(BS { rdeps :: BuildState -> RevDepMap
rdeps = RevDepMap
rdm, index :: BuildState -> Index
index = Index
idx, next :: BuildState -> BuildType
next = OneGoal (PkgGoal qpn :: QPN
qpn@(Q PackagePath
_ PackageName
pn) QGoalReason
gr) }) =
case PackageName -> Index -> Maybe (Map I PInfo)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackageName
pn Index
idx of
Maybe (Map I PInfo)
Nothing -> ConflictSet -> FailReason -> TreeF () QGoalReason BuildState
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
qpn) ConflictSet -> ConflictSet -> ConflictSet
`CS.union` QPN -> QGoalReason -> ConflictSet
goalReasonToConflictSetWithConflict QPN
qpn QGoalReason
gr)
FailReason
UnknownPackage
Just Map I PInfo
pis -> QPN
-> RevDepMap
-> QGoalReason
-> WeightedPSQ [Weight] POption BuildState
-> TreeF () QGoalReason BuildState
forall d c a.
QPN
-> RevDepMap -> c -> WeightedPSQ [Weight] POption a -> TreeF d c a
PChoiceF QPN
qpn RevDepMap
rdm QGoalReason
gr ([([Weight], POption, BuildState)]
-> WeightedPSQ [Weight] POption BuildState
forall w k v. Ord w => [(w, k, v)] -> WeightedPSQ w k v
W.fromList (((I, PInfo) -> ([Weight], POption, BuildState))
-> [(I, PInfo)] -> [([Weight], POption, BuildState)]
forall a b. (a -> b) -> [a] -> [b]
L.map (\ (I
i, PInfo
info) ->
([], I -> Maybe PackagePath -> POption
POption I
i Maybe PackagePath
forall a. Maybe a
Nothing, BuildState
bs { next :: BuildType
next = QPN -> PInfo -> BuildType
Instance QPN
qpn PInfo
info }))
(Map I PInfo -> [(I, PInfo)]
forall k a. Map k a -> [(k, a)]
M.toList Map I PInfo
pis)))
addChildren bs :: BuildState
bs@(BS { rdeps :: BuildState -> RevDepMap
rdeps = RevDepMap
rdm, next :: BuildState -> BuildType
next = OneGoal (FlagGoal qfn :: FN QPN
qfn@(FN QPN
qpn Flag
_) (FInfo Bool
b FlagType
m WeakOrTrivial
w) [FlaggedDep QPN]
t [FlaggedDep QPN]
f QGoalReason
gr) }) =
FN QPN
-> RevDepMap
-> QGoalReason
-> WeakOrTrivial
-> FlagType
-> Bool
-> WeightedPSQ [Weight] Bool BuildState
-> TreeF () QGoalReason BuildState
forall d c a.
FN QPN
-> RevDepMap
-> c
-> WeakOrTrivial
-> FlagType
-> Bool
-> WeightedPSQ [Weight] Bool a
-> TreeF d c a
FChoiceF FN QPN
qfn RevDepMap
rdm QGoalReason
gr WeakOrTrivial
weak FlagType
m Bool
b ([([Weight], Bool, BuildState)]
-> WeightedPSQ [Weight] Bool BuildState
forall w k v. Ord w => [(w, k, v)] -> WeightedPSQ w k v
W.fromList
[([if Bool
b then Weight
0 else Weight
1], Bool
True, (QPN -> [FlaggedDep QPN] -> BuildState -> BuildState
extendOpen QPN
qpn [FlaggedDep QPN]
t BuildState
bs) { next :: BuildType
next = BuildType
Goals }),
([if Bool
b then Weight
1 else Weight
0], Bool
False, (QPN -> [FlaggedDep QPN] -> BuildState -> BuildState
extendOpen QPN
qpn [FlaggedDep QPN]
f BuildState
bs) { next :: BuildType
next = BuildType
Goals })])
where
trivial :: Bool
trivial = [FlaggedDep QPN] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [FlaggedDep QPN]
t Bool -> Bool -> Bool
&& [FlaggedDep QPN] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [FlaggedDep QPN]
f
weak :: WeakOrTrivial
weak = Bool -> WeakOrTrivial
WeakOrTrivial (Bool -> WeakOrTrivial) -> Bool -> WeakOrTrivial
forall a b. (a -> b) -> a -> b
$ WeakOrTrivial -> Bool
unWeakOrTrivial WeakOrTrivial
w Bool -> Bool -> Bool
|| Bool
trivial
addChildren bs :: BuildState
bs@(BS { rdeps :: BuildState -> RevDepMap
rdeps = RevDepMap
rdm, next :: BuildState -> BuildType
next = OneGoal (StanzaGoal qsn :: SN QPN
qsn@(SN QPN
qpn Stanza
_) [FlaggedDep QPN]
t QGoalReason
gr) }) =
SN QPN
-> RevDepMap
-> QGoalReason
-> WeakOrTrivial
-> WeightedPSQ [Weight] Bool BuildState
-> TreeF () QGoalReason BuildState
forall d c a.
SN QPN
-> RevDepMap
-> c
-> WeakOrTrivial
-> WeightedPSQ [Weight] Bool a
-> TreeF d c a
SChoiceF SN QPN
qsn RevDepMap
rdm QGoalReason
gr WeakOrTrivial
trivial ([([Weight], Bool, BuildState)]
-> WeightedPSQ [Weight] Bool BuildState
forall w k v. Ord w => [(w, k, v)] -> WeightedPSQ w k v
W.fromList
[([Weight
0], Bool
False, BuildState
bs { next :: BuildType
next = BuildType
Goals }),
([Weight
1], Bool
True, (QPN -> [FlaggedDep QPN] -> BuildState -> BuildState
extendOpen QPN
qpn [FlaggedDep QPN]
t BuildState
bs) { next :: BuildType
next = BuildType
Goals })])
where
trivial :: WeakOrTrivial
trivial = Bool -> WeakOrTrivial
WeakOrTrivial ([FlaggedDep QPN] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [FlaggedDep QPN]
t)
addChildren bs :: BuildState
bs@(BS { next :: BuildState -> BuildType
next = Instance QPN
qpn (PInfo FlaggedDeps PackageName
fdeps Map ExposedComponent ComponentInfo
_ FlagInfo
fdefs Maybe FailReason
_) }) =
BuildState -> TreeF () QGoalReason BuildState
addChildren ((QPN
-> FlaggedDeps PackageName -> FlagInfo -> BuildState -> BuildState
scopedExtendOpen QPN
qpn FlaggedDeps PackageName
fdeps FlagInfo
fdefs BuildState
bs)
{ next :: BuildType
next = BuildType
Goals })
addLinking :: LinkingState -> TreeF () c a -> TreeF () c (Linker a)
addLinking :: forall c a. LinkingState -> TreeF () c a -> TreeF () c (Linker a)
addLinking LinkingState
ls (PChoiceF qpn :: QPN
qpn@(Q PackagePath
pp PackageName
pn) RevDepMap
rdm c
gr WeightedPSQ [Weight] POption a
cs) =
let linkedCs :: WeightedPSQ [Weight] POption (Linker a)
linkedCs = (a -> Linker a)
-> WeightedPSQ [Weight] POption a
-> WeightedPSQ [Weight] POption (Linker a)
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 (\a
bs -> a -> LinkingState -> Linker a
forall a. a -> LinkingState -> Linker a
Linker a
bs LinkingState
ls) (WeightedPSQ [Weight] POption a
-> WeightedPSQ [Weight] POption (Linker a))
-> WeightedPSQ [Weight] POption a
-> WeightedPSQ [Weight] POption (Linker a)
forall a b. (a -> b) -> a -> b
$
[([Weight], POption, a)] -> WeightedPSQ [Weight] POption a
forall w k v. Ord w => [(w, k, v)] -> WeightedPSQ w k v
W.fromList ([([Weight], POption, a)] -> WeightedPSQ [Weight] POption a)
-> [([Weight], POption, a)] -> WeightedPSQ [Weight] POption a
forall a b. (a -> b) -> a -> b
$ (([Weight], POption, a) -> [([Weight], POption, a)])
-> [([Weight], POption, a)] -> [([Weight], POption, a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (LinkingState
-> QPN -> ([Weight], POption, a) -> [([Weight], POption, a)]
forall a w.
LinkingState -> QPN -> (w, POption, a) -> [(w, POption, a)]
linkChoices LinkingState
ls QPN
qpn) (WeightedPSQ [Weight] POption a -> [([Weight], POption, a)]
forall w k v. WeightedPSQ w k v -> [(w, k, v)]
W.toList WeightedPSQ [Weight] POption a
cs)
unlinkedCs :: WeightedPSQ [Weight] POption (Linker a)
unlinkedCs = (POption -> a -> Linker a)
-> WeightedPSQ [Weight] POption a
-> WeightedPSQ [Weight] POption (Linker a)
forall k v1 v2 w.
(k -> v1 -> v2) -> WeightedPSQ w k v1 -> WeightedPSQ w k v2
W.mapWithKey POption -> a -> Linker a
forall a. POption -> a -> Linker a
goP WeightedPSQ [Weight] POption a
cs
allCs :: WeightedPSQ [Weight] POption (Linker a)
allCs = WeightedPSQ [Weight] POption (Linker a)
unlinkedCs WeightedPSQ [Weight] POption (Linker a)
-> WeightedPSQ [Weight] POption (Linker a)
-> WeightedPSQ [Weight] POption (Linker a)
forall w k v.
Ord w =>
WeightedPSQ w k v -> WeightedPSQ w k v -> WeightedPSQ w k v
`W.union` WeightedPSQ [Weight] POption (Linker a)
linkedCs
goP :: POption -> a -> Linker a
goP :: forall a. POption -> a -> Linker a
goP (POption I
i Maybe PackagePath
Nothing) a
bs = a -> LinkingState -> Linker a
forall a. a -> LinkingState -> Linker a
Linker a
bs (LinkingState -> Linker a) -> LinkingState -> Linker a
forall a b. (a -> b) -> a -> b
$ ([PackagePath] -> [PackagePath] -> [PackagePath])
-> (PackageName, I)
-> [PackagePath]
-> LinkingState
-> LinkingState
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [PackagePath] -> [PackagePath] -> [PackagePath]
forall a. [a] -> [a] -> [a]
(++) (PackageName
pn, I
i) [PackagePath
pp] LinkingState
ls
goP POption
_ a
_ = Linker a
forall a. a
alreadyLinked
in QPN
-> RevDepMap
-> c
-> WeightedPSQ [Weight] POption (Linker a)
-> TreeF () c (Linker a)
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 (Linker a)
allCs
addLinking LinkingState
ls TreeF () c a
t = (a -> Linker a) -> TreeF () c a -> TreeF () c (Linker a)
forall a b. (a -> b) -> TreeF () c a -> TreeF () c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
bs -> a -> LinkingState -> Linker a
forall a. a -> LinkingState -> Linker a
Linker a
bs LinkingState
ls) TreeF () c a
t
linkChoices :: forall a w . LinkingState
-> QPN
-> (w, POption, a)
-> [(w, POption, a)]
linkChoices :: forall a w.
LinkingState -> QPN -> (w, POption, a) -> [(w, POption, a)]
linkChoices LinkingState
related (Q PackagePath
_pp PackageName
pn) (w
weight, POption I
i Maybe PackagePath
Nothing, a
subtree) =
(PackagePath -> (w, POption, a))
-> [PackagePath] -> [(w, POption, a)]
forall a b. (a -> b) -> [a] -> [b]
L.map PackagePath -> (w, POption, a)
aux ([PackagePath] -> (PackageName, I) -> LinkingState -> [PackagePath]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] (PackageName
pn, I
i) LinkingState
related)
where
aux :: PackagePath -> (w, POption, a)
aux :: PackagePath -> (w, POption, a)
aux PackagePath
pp = (w
weight, I -> Maybe PackagePath -> POption
POption I
i (PackagePath -> Maybe PackagePath
forall a. a -> Maybe a
Just PackagePath
pp), a
subtree)
linkChoices LinkingState
_ QPN
_ (w
_, POption I
_ (Just PackagePath
_), a
_) =
[(w, POption, a)]
forall a. a
alreadyLinked
alreadyLinked :: a
alreadyLinked :: forall a. a
alreadyLinked = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"addLinking called on tree that already contains linked nodes"
buildTree :: Index -> IndependentGoals -> [PN] -> Tree () QGoalReason
buildTree :: Index -> IndependentGoals -> [PackageName] -> Tree () QGoalReason
buildTree Index
idx (IndependentGoals Bool
ind) [PackageName]
igs =
Linker BuildState -> Tree () QGoalReason
build Linker {
buildState :: BuildState
buildState = BS {
index :: Index
index = Index
idx
, rdeps :: RevDepMap
rdeps = [(QPN, [(Component, QPN)])] -> RevDepMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((QPN -> (QPN, [(Component, QPN)]))
-> [QPN] -> [(QPN, [(Component, QPN)])]
forall a b. (a -> b) -> [a] -> [b]
L.map (\ QPN
qpn -> (QPN
qpn, [])) [QPN]
qpns)
, open :: [OpenGoal]
open = (QPN -> OpenGoal) -> [QPN] -> [OpenGoal]
forall a b. (a -> b) -> [a] -> [b]
L.map QPN -> OpenGoal
topLevelGoal [QPN]
qpns
, next :: BuildType
next = BuildType
Goals
, qualifyOptions :: QualifyOptions
qualifyOptions = Index -> QualifyOptions
defaultQualifyOptions Index
idx
}
, linkingState :: LinkingState
linkingState = LinkingState
forall k a. Map k a
M.empty
}
where
topLevelGoal :: QPN -> OpenGoal
topLevelGoal QPN
qpn = QPN -> QGoalReason -> OpenGoal
PkgGoal QPN
qpn QGoalReason
forall qpn. GoalReason qpn
UserGoal
qpns :: [QPN]
qpns | Bool
ind = (PackageName -> QPN) -> [PackageName] -> [QPN]
forall a b. (a -> b) -> [a] -> [b]
L.map PackageName -> QPN
makeIndependent [PackageName]
igs
| Bool
otherwise = (PackageName -> QPN) -> [PackageName] -> [QPN]
forall a b. (a -> b) -> [a] -> [b]
L.map (PackagePath -> PackageName -> QPN
forall a. PackagePath -> a -> Qualified a
Q (Namespace -> Qualifier -> PackagePath
PackagePath Namespace
DefaultNamespace Qualifier
QualToplevel)) [PackageName]
igs
data OpenGoal =
FlagGoal (FN QPN) FInfo (FlaggedDeps QPN) (FlaggedDeps QPN) QGoalReason
| StanzaGoal (SN QPN) (FlaggedDeps QPN) QGoalReason
| PkgGoal QPN QGoalReason
close :: OpenGoal -> Goal QPN
close :: OpenGoal -> Goal QPN
close (FlagGoal FN QPN
qfn FInfo
_ [FlaggedDep QPN]
_ [FlaggedDep QPN]
_ QGoalReason
gr) = Var QPN -> QGoalReason -> Goal QPN
forall qpn. Var qpn -> GoalReason qpn -> Goal qpn
Goal (FN QPN -> Var QPN
forall qpn. FN qpn -> Var qpn
F FN QPN
qfn) QGoalReason
gr
close (StanzaGoal SN QPN
qsn [FlaggedDep QPN]
_ QGoalReason
gr) = Var QPN -> QGoalReason -> Goal QPN
forall qpn. Var qpn -> GoalReason qpn -> Goal qpn
Goal (SN QPN -> Var QPN
forall qpn. SN qpn -> Var qpn
S SN QPN
qsn) QGoalReason
gr
close (PkgGoal QPN
qpn QGoalReason
gr) = Var QPN -> QGoalReason -> Goal QPN
forall qpn. Var qpn -> GoalReason qpn -> Goal qpn
Goal (QPN -> Var QPN
forall qpn. qpn -> Var qpn
P QPN
qpn) QGoalReason
gr
splits :: [a] -> [(a, [a])]
splits :: forall a. [a] -> [(a, [a])]
splits = ([a] -> [a]) -> [a] -> [(a, [a])]
forall a. ([a] -> [a]) -> [a] -> [(a, [a])]
go [a] -> [a]
forall a. a -> a
id
where
go :: ([a] -> [a]) -> [a] -> [(a, [a])]
go :: forall a. ([a] -> [a]) -> [a] -> [(a, [a])]
go [a] -> [a]
_ [] = []
go [a] -> [a]
f (a
x : [a]
xs) = (a
x, [a] -> [a]
f [a]
xs) (a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
: ([a] -> [a]) -> [a] -> [(a, [a])]
forall a. ([a] -> [a]) -> [a] -> [(a, [a])]
go ([a] -> [a]
f ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) [a]
xs