    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) -- from Cabal

    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

    -- | A (partial) package assignment. Qualified package names
    -- are associated with instances.
    type PAssignment    = Map QPN I

    type FAssignment    = Map QFN Bool
    type SAssignment    = Map QSN Bool

    -- | A (partial) assignment of variables.
    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)

    -- | Delivers an ordered list of fully configured packages.
    --
    -- TODO: This function is (sort of) ok. However, there's an open bug
    -- w.r.t. unqualification. There might be several different instances
    -- of one package version chosen by the solver, which will lead to
    -- clashes.
    toCPs :: Assignment -> RevDepMap -> [CP QPN]
    toCPs :: Assignment -> RevDepMap -> [CP QPN]
    toCPs (A PAssignment
    pa FAssignment
    fa SAssignment
    sa) RevDepMap
    rdm =
      let
        -- get hold of the graph
        g   :: Graph Component
        vm  :: Vertex -> ((), QPN, [(Component, QPN)])
        cvm :: QPN -> Maybe Vertex
        -- Note that the RevDepMap contains duplicate dependencies. Therefore the nub.
        (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
        -- Topsort the dependency graph, yielding a list of pkgs in the right order.
        -- The graph will still contain all the installed packages, and it might
        -- contain duplicates, because several variables might actually resolve to
        -- the same package in the presence of qualified package names.
        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
        -- Determine the flags per package, by walking over and regrouping the
        -- complete flag assignment by package.
        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
        -- Stanzas per package.
        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
        -- Dependencies per package.
        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) -- TODO: why this is safe?
                       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
        -- Translated to PackageDeps
        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