module Distribution.Solver.Modular.Assignment
( Assignment(..)
, PAssignment
, FAssignment
, SAssignment
, toCPs
) where
import Prelude ()
import Distribution.Solver.Compat.Prelude hiding (pi)
import qualified Data.Array as A
import qualified Data.List as L
import qualified Data.Map as M
import Data.Maybe (fromJust)
import Distribution.PackageDescription (FlagAssignment, mkFlagAssignment)
import Distribution.Solver.Types.ComponentDeps (ComponentDeps, Component)
import qualified Distribution.Solver.Types.ComponentDeps as CD
import Distribution.Solver.Types.OptionalStanza
import Distribution.Solver.Types.PackagePath
import Distribution.Solver.Modular.Configured
import Distribution.Solver.Modular.Dependency
import Distribution.Solver.Modular.Flag
import Distribution.Solver.Modular.LabeledGraph
import Distribution.Solver.Modular.Package
type PAssignment = Map QPN I
type FAssignment = Map QFN Bool
type SAssignment = Map QSN Bool
data Assignment = A PAssignment FAssignment SAssignment
deriving (Vertex -> Assignment -> ShowS
[Assignment] -> ShowS
Assignment -> String
(Vertex -> Assignment -> ShowS)
-> (Assignment -> String)
-> ([Assignment] -> ShowS)
-> Show Assignment
forall a.
(Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Vertex -> Assignment -> ShowS
showsPrec :: Vertex -> Assignment -> ShowS
$cshow :: Assignment -> String
show :: Assignment -> String
$cshowList :: [Assignment] -> ShowS
showList :: [Assignment] -> ShowS
Show, Assignment -> Assignment -> Bool
(Assignment -> Assignment -> Bool)
-> (Assignment -> Assignment -> Bool) -> Eq Assignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Assignment -> Assignment -> Bool
== :: Assignment -> Assignment -> Bool
$c/= :: Assignment -> Assignment -> Bool
/= :: Assignment -> Assignment -> Bool
Eq)
toCPs :: Assignment -> RevDepMap -> [CP QPN]
toCPs :: Assignment -> RevDepMap -> [CP QPN]
toCPs (A PAssignment
pa FAssignment
fa SAssignment
sa) RevDepMap
rdm =
let
g :: Graph Component
vm :: Vertex -> ((), QPN, [(Component, QPN)])
cvm :: QPN -> Maybe Vertex
(Graph Component
g, Vertex -> ((), QPN, [(Component, QPN)])
vm, QPN -> Maybe Vertex
cvm) = [((), QPN, [(Component, QPN)])]
-> (Graph Component, Vertex -> ((), QPN, [(Component, QPN)]),
QPN -> Maybe Vertex)
forall key node edge.
Ord key =>
[(node, key, [(edge, key)])]
-> (Graph edge, Vertex -> (node, key, [(edge, key)]),
key -> Maybe Vertex)
graphFromEdges (((QPN, [(Component, QPN)]) -> ((), QPN, [(Component, QPN)]))
-> [(QPN, [(Component, QPN)])] -> [((), QPN, [(Component, QPN)])]
forall a b. (a -> b) -> [a] -> [b]
L.map (\ (QPN
x, [(Component, QPN)]
xs) -> ((), QPN
x, [(Component, QPN)] -> [(Component, QPN)]
forall a. Eq a => [a] -> [a]
nub [(Component, QPN)]
xs))
(RevDepMap -> [(QPN, [(Component, QPN)])]
forall k a. Map k a -> [(k, a)]
M.toList RevDepMap
rdm))
tg :: Graph Component
tg :: Graph Component
tg = Graph Component -> Graph Component
forall e. Graph e -> Graph e
transposeG Graph Component
g
ps :: [PI QPN]
ps :: [PI QPN]
ps = (Vertex -> PI QPN) -> [Vertex] -> [PI QPN]
forall a b. (a -> b) -> [a] -> [b]
L.map ((\ (()
_, QPN
x, [(Component, QPN)]
_) -> QPN -> I -> PI QPN
forall qpn. qpn -> I -> PI qpn
PI QPN
x (PAssignment
pa PAssignment -> QPN -> I
forall k a. Ord k => Map k a -> k -> a
M.! QPN
x)) (((), QPN, [(Component, QPN)]) -> PI QPN)
-> (Vertex -> ((), QPN, [(Component, QPN)])) -> Vertex -> PI QPN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex -> ((), QPN, [(Component, QPN)])
vm) ([Vertex] -> [PI QPN]) -> [Vertex] -> [PI QPN]
forall a b. (a -> b) -> a -> b
$
Graph Component -> [Vertex]
forall e. Graph e -> [Vertex]
topSort Graph Component
g
fapp :: Map QPN FlagAssignment
fapp :: Map QPN FlagAssignment
fapp = (FlagAssignment -> FlagAssignment -> FlagAssignment)
-> [(QPN, FlagAssignment)] -> Map QPN FlagAssignment
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith FlagAssignment -> FlagAssignment -> FlagAssignment
forall a. Monoid a => a -> a -> a
mappend ([(QPN, FlagAssignment)] -> Map QPN FlagAssignment)
-> [(QPN, FlagAssignment)] -> Map QPN FlagAssignment
forall a b. (a -> b) -> a -> b
$
((FN QPN, Bool) -> (QPN, FlagAssignment))
-> [(FN QPN, Bool)] -> [(QPN, FlagAssignment)]
forall a b. (a -> b) -> [a] -> [b]
L.map (\ ((FN QPN
qpn Flag
fn), Bool
b) -> (QPN
qpn, [(Flag, Bool)] -> FlagAssignment
mkFlagAssignment [(Flag
fn, Bool
b)])) ([(FN QPN, Bool)] -> [(QPN, FlagAssignment)])
-> [(FN QPN, Bool)] -> [(QPN, FlagAssignment)]
forall a b. (a -> b) -> a -> b
$
FAssignment -> [(FN QPN, Bool)]
forall k a. Map k a -> [(k, a)]
M.toList (FAssignment -> [(FN QPN, Bool)])
-> FAssignment -> [(FN QPN, Bool)]
forall a b. (a -> b) -> a -> b
$
FAssignment
fa
sapp :: Map QPN OptionalStanzaSet
sapp :: Map QPN OptionalStanzaSet
sapp = (OptionalStanzaSet -> OptionalStanzaSet -> OptionalStanzaSet)
-> [(QPN, OptionalStanzaSet)] -> Map QPN OptionalStanzaSet
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith OptionalStanzaSet -> OptionalStanzaSet -> OptionalStanzaSet
forall a. Monoid a => a -> a -> a
mappend
([(QPN, OptionalStanzaSet)] -> Map QPN OptionalStanzaSet)
-> [(QPN, OptionalStanzaSet)] -> Map QPN OptionalStanzaSet
forall a b. (a -> b) -> a -> b
$ ((SN QPN, Bool) -> (QPN, OptionalStanzaSet))
-> [(SN QPN, Bool)] -> [(QPN, OptionalStanzaSet)]
forall a b. (a -> b) -> [a] -> [b]
L.map (\ ((SN QPN
qpn Stanza
sn), Bool
b) -> (QPN
qpn, if Bool
b then Stanza -> OptionalStanzaSet
optStanzaSetSingleton Stanza
sn else OptionalStanzaSet
forall a. Monoid a => a
mempty))
([(SN QPN, Bool)] -> [(QPN, OptionalStanzaSet)])
-> [(SN QPN, Bool)] -> [(QPN, OptionalStanzaSet)]
forall a b. (a -> b) -> a -> b
$ SAssignment -> [(SN QPN, Bool)]
forall k a. Map k a -> [(k, a)]
M.toList SAssignment
sa
depp :: QPN -> [(Component, PI QPN)]
depp :: QPN -> [(Component, PI QPN)]
depp QPN
qpn = let v :: Vertex
v :: Vertex
v = Maybe Vertex -> Vertex
forall a. HasCallStack => Maybe a -> a
fromJust (QPN -> Maybe Vertex
cvm QPN
qpn)
dvs :: [(Component, Vertex)]
dvs :: [(Component, Vertex)]
dvs = Graph Component
tg Graph Component -> Vertex -> [(Component, Vertex)]
forall i e. Ix i => Array i e -> i -> e
A.! Vertex
v
in ((Component, Vertex) -> (Component, PI QPN))
-> [(Component, Vertex)] -> [(Component, PI QPN)]
forall a b. (a -> b) -> [a] -> [b]
L.map (\ (Component
comp, Vertex
dv) -> case Vertex -> ((), QPN, [(Component, QPN)])
vm Vertex
dv of (()
_, QPN
x, [(Component, QPN)]
_) -> (Component
comp, QPN -> I -> PI QPN
forall qpn. qpn -> I -> PI qpn
PI QPN
x (PAssignment
pa PAssignment -> QPN -> I
forall k a. Ord k => Map k a -> k -> a
M.! QPN
x))) [(Component, Vertex)]
dvs
depp' :: QPN -> ComponentDeps [PI QPN]
depp' :: QPN -> ComponentDeps [PI QPN]
depp' = [ComponentDep [PI QPN]] -> ComponentDeps [PI QPN]
forall a. Monoid a => [ComponentDep a] -> ComponentDeps a
CD.fromList ([ComponentDep [PI QPN]] -> ComponentDeps [PI QPN])
-> (QPN -> [ComponentDep [PI QPN]])
-> QPN
-> ComponentDeps [PI QPN]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Component, PI QPN) -> ComponentDep [PI QPN])
-> [(Component, PI QPN)] -> [ComponentDep [PI QPN]]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(Component
comp, PI QPN
d) -> (Component
comp, [PI QPN
d])) ([(Component, PI QPN)] -> [ComponentDep [PI QPN]])
-> (QPN -> [(Component, PI QPN)]) -> QPN -> [ComponentDep [PI QPN]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QPN -> [(Component, PI QPN)]
depp
in
(PI QPN -> CP QPN) -> [PI QPN] -> [CP QPN]
forall a b. (a -> b) -> [a] -> [b]
L.map (\ pi :: PI QPN
pi@(PI QPN
qpn I
_) -> PI QPN
-> FlagAssignment
-> OptionalStanzaSet
-> ComponentDeps [PI QPN]
-> CP QPN
forall qpn.
PI qpn
-> FlagAssignment
-> OptionalStanzaSet
-> ComponentDeps [PI qpn]
-> CP qpn
CP PI QPN
pi
(FlagAssignment -> QPN -> Map QPN FlagAssignment -> FlagAssignment
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault FlagAssignment
forall a. Monoid a => a
mempty QPN
qpn Map QPN FlagAssignment
fapp)
(OptionalStanzaSet
-> QPN -> Map QPN OptionalStanzaSet -> OptionalStanzaSet
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault OptionalStanzaSet
forall a. Monoid a => a
mempty QPN
qpn Map QPN OptionalStanzaSet
sapp)
(QPN -> ComponentDeps [PI QPN]
depp' QPN
qpn))
[PI QPN]
ps