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
forall a.
(Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Assignment] -> ShowS
$cshowList :: [Assignment] -> ShowS
show :: Assignment -> String
$cshow :: Assignment -> String
showsPrec :: Vertex -> Assignment -> ShowS
$cshowsPrec :: Vertex -> Assignment -> ShowS
Show, Assignment -> Assignment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Assignment -> Assignment -> Bool
$c/= :: Assignment -> Assignment -> Bool
== :: Assignment -> Assignment -> Bool
$c== :: 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) = forall key node edge.
Ord key =>
[(node, key, [(edge, key)])]
-> (Graph edge, Vertex -> (node, key, [(edge, key)]),
key -> Maybe Vertex)
graphFromEdges (forall a b. (a -> b) -> [a] -> [b]
L.map (\ (QPN
x, [(Component, QPN)]
xs) -> ((), QPN
x, forall a. Eq a => [a] -> [a]
nub [(Component, QPN)]
xs))
(forall k a. Map k a -> [(k, a)]
M.toList RevDepMap
rdm))
tg :: Graph Component
tg :: Graph Component
tg = forall e. Graph e -> Graph e
transposeG Graph Component
g
ps :: [PI QPN]
ps :: [PI QPN]
ps = forall a b. (a -> b) -> [a] -> [b]
L.map ((\ (()
_, QPN
x, [(Component, QPN)]
_) -> forall qpn. qpn -> I -> PI qpn
PI QPN
x (PAssignment
pa forall k a. Ord k => Map k a -> k -> a
M.! QPN
x)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex -> ((), QPN, [(Component, QPN)])
vm) forall a b. (a -> b) -> a -> b
$
forall e. Graph e -> [Vertex]
topSort Graph Component
g
fapp :: Map QPN FlagAssignment
fapp :: Map QPN FlagAssignment
fapp = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. Monoid a => a -> a -> a
mappend forall a b. (a -> b) -> a -> b
$
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)])) forall a b. (a -> b) -> a -> b
$
forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$
FAssignment
fa
sapp :: Map QPN OptionalStanzaSet
sapp :: Map QPN OptionalStanzaSet
sapp = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. Monoid a => a -> a -> a
mappend
forall a b. (a -> b) -> a -> b
$ 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 forall a. Monoid a => a
mempty))
forall a b. (a -> b) -> a -> b
$ 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 = forall a. HasCallStack => Maybe a -> a
fromJust (QPN -> Maybe Vertex
cvm QPN
qpn)
dvs :: [(Component, Vertex)]
dvs :: [(Component, Vertex)]
dvs = Graph Component
tg forall i e. Ix i => Array i e -> i -> e
A.! Vertex
v
in 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, forall qpn. qpn -> I -> PI qpn
PI QPN
x (PAssignment
pa 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' = forall a. Monoid a => [ComponentDep a] -> ComponentDeps a
CD.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
L.map (\(Component
comp, PI QPN
d) -> (Component
comp, [PI QPN
d])) forall b c a. (b -> c) -> (a -> b) -> a -> c
. QPN -> [(Component, PI QPN)]
depp
in
forall a b. (a -> b) -> [a] -> [b]
L.map (\ pi :: PI QPN
pi@(PI QPN
qpn I
_) -> forall qpn.
PI qpn
-> FlagAssignment
-> OptionalStanzaSet
-> ComponentDeps [PI qpn]
-> CP qpn
CP PI QPN
pi
(forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault forall a. Monoid a => a
mempty QPN
qpn Map QPN FlagAssignment
fapp)
(forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault forall a. Monoid a => a
mempty QPN
qpn Map QPN OptionalStanzaSet
sapp)
(QPN -> ComponentDeps [PI QPN]
depp' QPN
qpn))
[PI QPN]
ps