    {-# LANGUAGE ScopedTypeVariables #-}
    {-# OPTIONS -fno-warn-missing-signatures #-}
    module Debian.Apt.Dependencies
    {-
        ( solve
        , State
        , binaryDepends
        , search
        , bj'
        , bt
        , CSP(..)
        ) -} where

    import Control.Arrow (second)
    import qualified Data.ByteString.Char8 as C
    import Data.List as List (find, union)
    import Data.Tree (Tree(rootLabel, Node))
    import Debian.Apt.Package (PackageNameMap, packageNameMap, lookupPackageByRel)
    import Debian.Control.ByteString (ControlFunctions(stripWS, lookupP, parseControlFromFile),
                                      Field'(Field, Comment), Control'(Control), Paragraph, Control)
    import Debian.Relation (BinPkgName(..))
    import Debian.Relation.ByteString (ParseRelations(..), Relation(..), OrRelation, AndRelation, Relations, checkVersionReq)
    import Debian.Version (DebianVersion, parseDebianVersion, prettyDebianVersion)
    import Debian.Version.ByteString ()
    import Text.PrettyPrint (render)

    -- * Basic CSP Types and Functions

    data Status
        = Remaining AndRelation
        | MissingDep Relation
        | Complete
          deriving (Status -> Status -> Bool
    (Status -> Status -> Bool)
    -> (Status -> Status -> Bool) -> Eq Status
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Status -> Status -> Bool
    == :: Status -> Status -> Bool
    $c/= :: Status -> Status -> Bool
    /= :: Status -> Status -> Bool
    Eq)

    type State a = (Status, [a])

    complete :: State a -> Bool
    complete :: forall a. State a -> Bool
    complete (Status
    Complete, [a]
    _) = Bool
    True
    complete (Status, [a])
    _ = Bool
    False

    data CSP a
        = CSP { forall a. CSP a -> PackageNameMap a
    pnm :: PackageNameMap a
              , forall a. CSP a -> AndRelation
    relations :: Relations
              , forall a. CSP a -> a -> AndRelation
    depFunction :: (a -> Relations)
              , forall a. CSP a -> a -> AndRelation
    conflicts :: a -> Relations
              , forall a. CSP a -> a -> (BinPkgName, DebianVersion)
    packageVersion :: a -> (BinPkgName, DebianVersion)
              }

    -- * Test CSP

    -- |TODO addProvides -- see DQL.Exec
    controlCSP :: Control -> Relations -> (Paragraph -> Relations) -> CSP Paragraph
    controlCSP :: Control
    -> AndRelation -> (Paragraph -> AndRelation) -> CSP Paragraph
    controlCSP (Control [Paragraph]
    paragraphs) AndRelation
    rels Paragraph -> AndRelation
    depF' =
        CSP { pnm :: PackageNameMap Paragraph
    pnm = (Paragraph -> BinPkgName)
    -> [Paragraph] -> PackageNameMap Paragraph
    forall a. (a -> BinPkgName) -> [a] -> PackageNameMap a
    packageNameMap Paragraph -> BinPkgName
    getName [Paragraph]
    paragraphs
            , relations :: AndRelation
    relations = AndRelation
    rels
            , depFunction :: Paragraph -> AndRelation
    depFunction = Paragraph -> AndRelation
    depF'
            , conflicts :: Paragraph -> AndRelation
    conflicts = Paragraph -> AndRelation
    conflicts'
            , packageVersion :: Paragraph -> (BinPkgName, DebianVersion)
    packageVersion = Paragraph -> (BinPkgName, DebianVersion)
    packageVersionParagraph
            }
        where
          getName :: Paragraph -> BinPkgName
          getName :: Paragraph -> BinPkgName
    getName Paragraph
    p = case String -> Paragraph -> Maybe (Field' ByteString)
    forall a.
    ControlFunctions a =>
    String -> Paragraph' a -> Maybe (Field' a)
    lookupP String
    "Package" Paragraph
    p of
                        Maybe (Field' ByteString)
    Nothing -> String -> BinPkgName
    forall a. HasCallStack => String -> a
    error String
    "Missing Package field"
                        Just (Field (ByteString
    _,ByteString
    n)) -> String -> BinPkgName
    BinPkgName (ByteString -> String
    C.unpack (ByteString -> ByteString
    forall a. ControlFunctions a => a -> a
    stripWS ByteString
    n))
                        Just (Comment ByteString
    _) -> String -> BinPkgName
    forall a. HasCallStack => String -> a
    error String
    "controlCSP"
          conflicts' :: Paragraph -> Relations
          conflicts' :: Paragraph -> AndRelation
    conflicts' Paragraph
    p =
              case String -> Paragraph -> Maybe (Field' ByteString)
    forall a.
    ControlFunctions a =>
    String -> Paragraph' a -> Maybe (Field' a)
    lookupP String
    "Conflicts" Paragraph
    p of
                Maybe (Field' ByteString)
    Nothing -> []
                Just (Field (ByteString
    _, ByteString
    c)) -> (ParseError -> AndRelation)
    -> (AndRelation -> AndRelation)
    -> Either ParseError AndRelation
    -> AndRelation
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (String -> AndRelation
    forall a. HasCallStack => String -> a
    error (String -> AndRelation)
    -> (ParseError -> String) -> ParseError -> AndRelation
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseError -> String
    forall a. Show a => a -> String
    show) AndRelation -> AndRelation
    forall a. a -> a
    id (ByteString -> Either ParseError AndRelation
    forall a. ParseRelations a => a -> Either ParseError AndRelation
    parseRelations ByteString
    c)
                Just (Comment ByteString
    _) -> String -> AndRelation
    forall a. HasCallStack => String -> a
    error String
    "controlCSP"

    testCSP :: FilePath -> (Paragraph -> Relations) -> String -> (CSP Paragraph -> IO a) -> IO a
    testCSP :: forall a.
    String
    -> (Paragraph -> AndRelation)
    -> String
    -> (CSP Paragraph -> IO a)
    -> IO a
    testCSP String
    controlFile Paragraph -> AndRelation
    depf String
    relationStr CSP Paragraph -> IO a
    cspf =
        do c' <- String -> IO (Either ParseError Control)
    forall a.
    ControlFunctions a =>
    String -> IO (Either ParseError (Control' a))
    parseControlFromFile String
    controlFile
           case c' of
             Left ParseError
    e -> String -> IO a
    forall a. HasCallStack => String -> a
    error (ParseError -> String
    forall a. Show a => a -> String
    show ParseError
    e)
             Right control :: Control
    control@(Control [Paragraph]
    _) ->
                 case String -> Either ParseError AndRelation
    forall a. ParseRelations a => a -> Either ParseError AndRelation
    parseRelations String
    relationStr of
                   Left ParseError
    e -> String -> IO a
    forall a. HasCallStack => String -> a
    error (ParseError -> String
    forall a. Show a => a -> String
    show ParseError
    e)
                   Right AndRelation
    r ->
                         CSP Paragraph -> IO a
    cspf (Control
    -> AndRelation -> (Paragraph -> AndRelation) -> CSP Paragraph
    controlCSP Control
    control AndRelation
    r Paragraph -> AndRelation
    depf)

    depF :: Paragraph -> Relations
    depF :: Paragraph -> AndRelation
    depF Paragraph
    p =
        let preDepends :: AndRelation
    preDepends =
                case String -> Paragraph -> Maybe (Field' ByteString)
    forall a.
    ControlFunctions a =>
    String -> Paragraph' a -> Maybe (Field' a)
    lookupP String
    "Pre-Depends" Paragraph
    p of
                  Maybe (Field' ByteString)
    Nothing -> []
                  Just (Field (ByteString
    _,ByteString
    pd)) ->
                      (ParseError -> AndRelation)
    -> (AndRelation -> AndRelation)
    -> Either ParseError AndRelation
    -> AndRelation
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (String -> AndRelation
    forall a. HasCallStack => String -> a
    error (String -> AndRelation)
    -> (ParseError -> String) -> ParseError -> AndRelation
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseError -> String
    forall a. Show a => a -> String
    show) AndRelation -> AndRelation
    forall a. a -> a
    id (ByteString -> Either ParseError AndRelation
    forall a. ParseRelations a => a -> Either ParseError AndRelation
    parseRelations ByteString
    pd)
                  Just (Comment ByteString
    _) -> String -> AndRelation
    forall a. HasCallStack => String -> a
    error String
    "depF"
            depends :: AndRelation
    depends =
                case String -> Paragraph -> Maybe (Field' ByteString)
    forall a.
    ControlFunctions a =>
    String -> Paragraph' a -> Maybe (Field' a)
    lookupP String
    "Depends" Paragraph
    p of
                  Maybe (Field' ByteString)
    Nothing -> []
                  Just (Field (ByteString
    _,ByteString
    pd)) ->
                      (ParseError -> AndRelation)
    -> (AndRelation -> AndRelation)
    -> Either ParseError AndRelation
    -> AndRelation
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (String -> AndRelation
    forall a. HasCallStack => String -> a
    error (String -> AndRelation)
    -> (ParseError -> String) -> ParseError -> AndRelation
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseError -> String
    forall a. Show a => a -> String
    show) AndRelation -> AndRelation
    forall a. a -> a
    id (ByteString -> Either ParseError AndRelation
    forall a. ParseRelations a => a -> Either ParseError AndRelation
    parseRelations ByteString
    pd)
                  Just (Comment ByteString
    _) -> String -> AndRelation
    forall a. HasCallStack => String -> a
    error String
    "depF"
        in
          AndRelation
    preDepends AndRelation -> AndRelation -> AndRelation
    forall a. [a] -> [a] -> [a]
    ++ AndRelation
    depends

    test :: String -> String -> Labeler Paragraph -> IO ()
    test String
    controlFP String
    rel Labeler Paragraph
    labeler =
        String
    -> (Paragraph -> AndRelation)
    -> String
    -> (CSP Paragraph -> IO ())
    -> IO ()
    forall a.
    String
    -> (Paragraph -> AndRelation)
    -> String
    -> (CSP Paragraph -> IO a)
    -> IO a
    testCSP String
    controlFP Paragraph -> AndRelation
    depF String
    rel (((Status, [Paragraph]) -> IO ())
    -> [(Status, [Paragraph])] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (\ (Status
    _,[Paragraph]
    p) -> (Paragraph -> IO ()) -> [Paragraph] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((BinPkgName, String) -> IO ()
    forall a. Show a => a -> IO ()
    print ((BinPkgName, String) -> IO ())
    -> (Paragraph -> (BinPkgName, String)) -> Paragraph -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DebianVersion -> String)
    -> (BinPkgName, DebianVersion) -> (BinPkgName, String)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (Doc -> String
    render (Doc -> String)
    -> (DebianVersion -> Doc) -> DebianVersion -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DebianVersion -> Doc
    prettyDebianVersion) ((BinPkgName, DebianVersion) -> (BinPkgName, String))
    -> (Paragraph -> (BinPkgName, DebianVersion))
    -> Paragraph
    -> (BinPkgName, String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Paragraph -> (BinPkgName, DebianVersion)
    packageVersionParagraph) [Paragraph]
    p ) ([(Status, [Paragraph])] -> IO ())
    -> (CSP Paragraph -> [(Status, [Paragraph])])
    -> CSP Paragraph
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [(Status, [Paragraph])] -> [(Status, [Paragraph])]
    forall a. Int -> [a] -> [a]
    take Int
    1 ([(Status, [Paragraph])] -> [(Status, [Paragraph])])
    -> (CSP Paragraph -> [(Status, [Paragraph])])
    -> CSP Paragraph
    -> [(Status, [Paragraph])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Labeler Paragraph -> CSP Paragraph -> [(Status, [Paragraph])]
    forall a. Labeler a -> CSP a -> [State a]
    search Labeler Paragraph
    labeler)

    -- TODO: add better errors
    packageVersionParagraph :: Paragraph -> (BinPkgName, DebianVersion)
    packageVersionParagraph :: Paragraph -> (BinPkgName, DebianVersion)
    packageVersionParagraph Paragraph
    p =
        case String -> Paragraph -> Maybe (Field' ByteString)
    forall a.
    ControlFunctions a =>
    String -> Paragraph' a -> Maybe (Field' a)
    lookupP String
    "Package" Paragraph
    p of
          Maybe (Field' ByteString)
    Nothing -> String -> (BinPkgName, DebianVersion)
    forall a. HasCallStack => String -> a
    error (String -> (BinPkgName, DebianVersion))
    -> String -> (BinPkgName, DebianVersion)
    forall a b. (a -> b) -> a -> b
    $ String
    "Paragraph missing Package field"
          (Just (Field (ByteString
    _, ByteString
    name))) ->
              case String -> Paragraph -> Maybe (Field' ByteString)
    forall a.
    ControlFunctions a =>
    String -> Paragraph' a -> Maybe (Field' a)
    lookupP String
    "Version" Paragraph
    p of
                Maybe (Field' ByteString)
    Nothing -> String -> (BinPkgName, DebianVersion)
    forall a. HasCallStack => String -> a
    error (String -> (BinPkgName, DebianVersion))
    -> String -> (BinPkgName, DebianVersion)
    forall a b. (a -> b) -> a -> b
    $ String
    "Paragraph missing Version field"
                (Just (Field (ByteString
    _, ByteString
    str))) ->
                    case ByteString -> Either ParseError DebianVersion
    forall a.
    ParseDebianVersion a =>
    a -> Either ParseError DebianVersion
    parseDebianVersion ByteString
    str of
                      Right DebianVersion
    ver -> (String -> BinPkgName
    BinPkgName (ByteString -> String
    C.unpack (ByteString -> ByteString
    forall a. ControlFunctions a => a -> a
    stripWS ByteString
    name)), DebianVersion
    ver)
                      Left ParseError
    e -> String -> (BinPkgName, DebianVersion)
    forall a. HasCallStack => String -> a
    error (String -> (BinPkgName, DebianVersion))
    -> String -> (BinPkgName, DebianVersion)
    forall a b. (a -> b) -> a -> b
    $ String
    "packageVersionParagraph: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ParseError -> String
    forall a. Show a => a -> String
    show ParseError
    e
                (Just (Comment ByteString
    _)) -> String -> (BinPkgName, DebianVersion)
    forall a. HasCallStack => String -> a
    error String
    "packageVersionParagraph"
          (Just (Comment ByteString
    _)) -> String -> (BinPkgName, DebianVersion)
    forall a. HasCallStack => String -> a
    error String
    "packageVersionParagraph"

    conflict :: CSP p -> p -> p -> Bool
    conflict :: forall p. CSP p -> p -> p -> Bool
    conflict CSP p
    csp p
    p1 p
    p2 =
        let (BinPkgName
    name1, DebianVersion
    version1) = (CSP p -> p -> (BinPkgName, DebianVersion)
    forall a. CSP a -> a -> (BinPkgName, DebianVersion)
    packageVersion CSP p
    csp) p
    p1
            (BinPkgName
    name2, DebianVersion
    version2) = (CSP p -> p -> (BinPkgName, DebianVersion)
    forall a. CSP a -> a -> (BinPkgName, DebianVersion)
    packageVersion CSP p
    csp) p
    p2
        in
          if BinPkgName
    name1 BinPkgName -> BinPkgName -> Bool
    forall a. Eq a => a -> a -> Bool
    == BinPkgName
    name2
          then DebianVersion
    version1 DebianVersion -> DebianVersion -> Bool
    forall a. Eq a => a -> a -> Bool
    /= DebianVersion
    version2
          else
            (Relation -> Bool) -> [Relation] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ((BinPkgName, DebianVersion) -> Relation -> Bool
    conflict' (BinPkgName
    name1, DebianVersion
    version1)) (AndRelation -> [Relation]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (AndRelation -> [Relation]) -> AndRelation -> [Relation]
    forall a b. (a -> b) -> a -> b
    $ (CSP p -> p -> AndRelation
    forall a. CSP a -> a -> AndRelation
    conflicts CSP p
    csp) p
    p2) Bool -> Bool -> Bool
    ||
            (Relation -> Bool) -> [Relation] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ((BinPkgName, DebianVersion) -> Relation -> Bool
    conflict' (BinPkgName
    name2, DebianVersion
    version2)) (AndRelation -> [Relation]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (AndRelation -> [Relation]) -> AndRelation -> [Relation]
    forall a b. (a -> b) -> a -> b
    $ (CSP p -> p -> AndRelation
    forall a. CSP a -> a -> AndRelation
    conflicts CSP p
    csp) p
    p1)

    -- |JAS: deal with 'Provides' (can a package provide more than one package?)
    conflict' :: (BinPkgName, DebianVersion) -> Relation -> Bool
    conflict' :: (BinPkgName, DebianVersion) -> Relation -> Bool
    conflict' (BinPkgName
    pName, DebianVersion
    pVersion) (RRel BinPkgName
    pkgName Maybe VersionReq
    mVersionReq Maybe ArchitectureReq
    _ [RestrictionList]
    _) =
        (BinPkgName
    pName BinPkgName -> BinPkgName -> Bool
    forall a. Eq a => a -> a -> Bool
    == BinPkgName
    pkgName) Bool -> Bool -> Bool
    && (Maybe VersionReq -> Maybe DebianVersion -> Bool
    checkVersionReq Maybe VersionReq
    mVersionReq (DebianVersion -> Maybe DebianVersion
    forall a. a -> Maybe a
    Just DebianVersion
    pVersion))

    -- * Tree Helper Functions

    mkTree :: a -> [Tree a] -> Tree a
    mkTree :: forall a. a -> [Tree a] -> Tree a
    mkTree = a -> [Tree a] -> Tree a
    forall a. a -> [Tree a] -> Tree a
    Node

    label :: Tree a -> a
    label :: forall a. Tree a -> a
    label = Tree a -> a
    forall a. Tree a -> a
    rootLabel

    initTree :: (a -> [a]) -> a -> Tree a
    initTree :: forall a. (a -> [a]) -> a -> Tree a
    initTree a -> [a]
    f a
    a = a -> [Tree a] -> Tree a
    forall a. a -> [Tree a] -> Tree a
    Node a
    a ((a -> Tree a) -> [a] -> [Tree a]
    forall a b. (a -> b) -> [a] -> [b]
    map ((a -> [a]) -> a -> Tree a
    forall a. (a -> [a]) -> a -> Tree a
    initTree a -> [a]
    f) (a -> [a]
    f a
    a))

    mapTree :: (a -> b) -> Tree a -> Tree b
    mapTree :: forall a b. (a -> b) -> Tree a -> Tree b
    mapTree = (a -> b) -> Tree a -> Tree b
    forall a b. (a -> b) -> Tree a -> Tree b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap

    foldTree :: (a -> [b] -> b) -> Tree a -> b
    foldTree :: forall a b. (a -> [b] -> b) -> Tree a -> b
    foldTree a -> [b] -> b
    f (Node a
    a [Tree a]
    ts) = a -> [b] -> b
    f a
    a ((Tree a -> b) -> [Tree a] -> [b]
    forall a b. (a -> b) -> [a] -> [b]
    map ((a -> [b] -> b) -> Tree a -> b
    forall a b. (a -> [b] -> b) -> Tree a -> b
    foldTree a -> [b] -> b
    f) [Tree a]
    ts)

    zipTreesWith :: (a -> b -> c) -> Tree a -> Tree b -> Tree c
    zipTreesWith :: forall a b c. (a -> b -> c) -> Tree a -> Tree b -> Tree c
    zipTreesWith a -> b -> c
    f (Node a
    a [Tree a]
    ts) (Node b
    b [Tree b]
    us) =
        c -> [Tree c] -> Tree c
    forall a. a -> [Tree a] -> Tree a
    Node (a -> b -> c
    f a
    a b
    b) ((Tree a -> Tree b -> Tree c) -> [Tree a] -> [Tree b] -> [Tree c]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith ((a -> b -> c) -> Tree a -> Tree b -> Tree c
    forall a b c. (a -> b -> c) -> Tree a -> Tree b -> Tree c
    zipTreesWith a -> b -> c
    f) [Tree a]
    ts [Tree b]
    us)

    prune :: (a -> Bool) -> Tree a -> Tree a
    prune :: forall a. (a -> Bool) -> Tree a -> Tree a
    prune a -> Bool
    p = (a -> [Tree a] -> Tree a) -> Tree a -> Tree a
    forall a b. (a -> [b] -> b) -> Tree a -> b
    foldTree a -> [Tree a] -> Tree a
    f
        where f :: a -> [Tree a] -> Tree a
    f a
    a [Tree a]
    ts = a -> [Tree a] -> Tree a
    forall a. a -> [Tree a] -> Tree a
    Node a
    a ((Tree a -> Bool) -> [Tree a] -> [Tree a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Tree a -> Bool) -> Tree a -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Bool
    p (a -> Bool) -> (Tree a -> a) -> Tree a -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tree a -> a
    forall a. Tree a -> a
    label) [Tree a]
    ts)

    leaves :: Tree a -> [a]
    leaves :: forall a. Tree a -> [a]
    leaves = (a -> [[a]] -> [a]) -> Tree a -> [a]
    forall a b. (a -> [b] -> b) -> Tree a -> b
    foldTree a -> [[a]] -> [a]
    forall {a}. a -> [[a]] -> [a]
    f
        where f :: a -> [[a]] -> [a]
    f a
    leaf [] = [a
    leaf]
              f a
    _ [[a]]
    ts = [[a]] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[a]]
    ts

    inhTree :: (b -> a -> b) -> b -> Tree a -> Tree b
    inhTree :: forall b a. (b -> a -> b) -> b -> Tree a -> Tree b
    inhTree b -> a -> b
    f b
    b (Node a
    a [Tree a]
    ts) = b -> [Tree b] -> Tree b
    forall a. a -> [Tree a] -> Tree a
    Node b
    b' ((Tree a -> Tree b) -> [Tree a] -> [Tree b]
    forall a b. (a -> b) -> [a] -> [b]
    map ((b -> a -> b) -> b -> Tree a -> Tree b
    forall b a. (b -> a -> b) -> b -> Tree a -> Tree b
    inhTree b -> a -> b
    f b
    b') [Tree a]
    ts)
        where b' :: b
    b' = b -> a -> b
    f b
    b a
    a

    distrTree :: (a -> [b]) -> b -> Tree a -> Tree b
    distrTree :: forall a b. (a -> [b]) -> b -> Tree a -> Tree b
    distrTree  a -> [b]
    f b
    b (Node a
    a [Tree a]
    ts) = b -> [Tree b] -> Tree b
    forall a. a -> [Tree a] -> Tree a
    Node b
    b ((b -> Tree a -> Tree b) -> [b] -> [Tree a] -> [Tree b]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith ((a -> [b]) -> b -> Tree a -> Tree b
    forall a b. (a -> [b]) -> b -> Tree a -> Tree b
    distrTree a -> [b]
    f) (a -> [b]
    f a
    a) [Tree a]
    ts)

    -- * mkSearchTree

    -- TODO: might want to leave markers about what relation we are satisfying?
    mkSearchTree :: forall a. CSP a -> Tree (State a)
    mkSearchTree :: forall a. CSP a -> Tree (State a)
    mkSearchTree CSP a
    csp =
        State a -> [Tree (State a)] -> Tree (State a)
    forall a. a -> [Tree a] -> Tree a
    Node (AndRelation -> Status
    Remaining (CSP a -> AndRelation
    forall a. CSP a -> AndRelation
    relations CSP a
    csp),[]) (([a], AndRelation) -> AndRelation -> [Tree (State a)]
    andRelation ([],[]) (CSP a -> AndRelation
    forall a. CSP a -> AndRelation
    relations CSP a
    csp))
        where
          andRelation :: ([a],AndRelation) -> AndRelation -> [Tree (State a)]
          andRelation :: ([a], AndRelation) -> AndRelation -> [Tree (State a)]
    andRelation ([a]
    candidates,[]) [] = [State a -> [Tree (State a)] -> Tree (State a)
    forall a. a -> [Tree a] -> Tree a
    Node (Status
    Complete, [a]
    candidates) []]
          andRelation ([a]
    candidates,AndRelation
    remaining) [] = ([a], AndRelation) -> AndRelation -> [Tree (State a)]
    andRelation ([a]
    candidates, []) AndRelation
    remaining
          andRelation ([a]
    candidates, AndRelation
    remaining) ([Relation]
    x:AndRelation
    xs) =
              ([a], AndRelation) -> [Relation] -> [Tree (State a)]
    orRelation ([a]
    candidates, AndRelation
    xs AndRelation -> AndRelation -> AndRelation
    forall a. [a] -> [a] -> [a]
    ++ AndRelation
    remaining) [Relation]
    x
          orRelation :: ([a],AndRelation) -> OrRelation -> [Tree (State a)]
          orRelation :: ([a], AndRelation) -> [Relation] -> [Tree (State a)]
    orRelation ([a], AndRelation)
    acc [Relation]
    x =
              [[Tree (State a)]] -> [Tree (State a)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ((Relation -> [Tree (State a)]) -> [Relation] -> [[Tree (State a)]]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (([a], AndRelation) -> Relation -> [Tree (State a)]
    relation ([a], AndRelation)
    acc) [Relation]
    x)
          relation :: ([a],AndRelation) -> Relation -> [Tree (State a)]
          relation :: ([a], AndRelation) -> Relation -> [Tree (State a)]
    relation acc :: ([a], AndRelation)
    acc@([a]
    candidates,AndRelation
    _) Relation
    rel =
              let packages :: [a]
    packages = PackageNameMap a
    -> (a -> (BinPkgName, DebianVersion)) -> Relation -> [a]
    forall a.
    PackageNameMap a
    -> (a -> (BinPkgName, DebianVersion)) -> Relation -> [a]
    lookupPackageByRel (CSP a -> PackageNameMap a
    forall a. CSP a -> PackageNameMap a
    pnm CSP a
    csp) (CSP a -> a -> (BinPkgName, DebianVersion)
    forall a. CSP a -> a -> (BinPkgName, DebianVersion)
    packageVersion CSP a
    csp) Relation
    rel in
              case [a]
    packages of
                [] -> [State a -> [Tree (State a)] -> Tree (State a)
    forall a. a -> [Tree a] -> Tree a
    Node (Relation -> Status
    MissingDep Relation
    rel, [a]
    candidates) []]
                [a]
    _ -> (a -> Tree (State a)) -> [a] -> [Tree (State a)]
    forall a b. (a -> b) -> [a] -> [b]
    map (([a], AndRelation) -> a -> Tree (State a)
    package ([a], AndRelation)
    acc) [a]
    packages
          package :: ([a],AndRelation) -> a -> Tree (State a)
          package :: ([a], AndRelation) -> a -> Tree (State a)
    package ([a]
    candidates, AndRelation
    remaining) a
    p =
              if ((CSP a -> a -> (BinPkgName, DebianVersion)
    forall a. CSP a -> a -> (BinPkgName, DebianVersion)
    packageVersion CSP a
    csp) a
    p) (BinPkgName, DebianVersion)
    -> [(BinPkgName, DebianVersion)] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ((a -> (BinPkgName, DebianVersion))
    -> [a] -> [(BinPkgName, DebianVersion)]
    forall a b. (a -> b) -> [a] -> [b]
    map (CSP a -> a -> (BinPkgName, DebianVersion)
    forall a. CSP a -> a -> (BinPkgName, DebianVersion)
    packageVersion CSP a
    csp) [a]
    candidates)
              then if AndRelation -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null AndRelation
    remaining
                   then State a -> [Tree (State a)] -> Tree (State a)
    forall a. a -> [Tree a] -> Tree a
    Node (Status
    Complete, [a]
    candidates) []
                   else State a -> [Tree (State a)] -> Tree (State a)
    forall a. a -> [Tree a] -> Tree a
    Node (AndRelation -> Status
    Remaining AndRelation
    remaining, [a]
    candidates) (([a], AndRelation) -> AndRelation -> [Tree (State a)]
    andRelation ([a]
    candidates, []) AndRelation
    remaining)
              else State a -> [Tree (State a)] -> Tree (State a)
    forall a. a -> [Tree a] -> Tree a
    Node (AndRelation -> Status
    Remaining AndRelation
    remaining, (a
    p a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    candidates)) (([a], AndRelation) -> AndRelation -> [Tree (State a)]
    andRelation ((a
    p a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    candidates), AndRelation
    remaining) ((CSP a -> a -> AndRelation
    forall a. CSP a -> a -> AndRelation
    depFunction CSP a
    csp) a
    p))

    -- |earliestInconsistency does what it sounds like
    -- the 'reverse as' is because the vars are order high to low, but we
    -- want to find the lowest numbered (aka, eariest) inconsistency ??
    --
    earliestInconsistency :: CSP a -> State a -> Maybe ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion))
    earliestInconsistency :: forall a.
    CSP a
    -> State a
    -> Maybe ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion))
    earliestInconsistency CSP a
    _ (Status
    _,[]) = Maybe ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion))
    forall a. Maybe a
    Nothing
    earliestInconsistency CSP a
    _ (Status
    _,[a
    _p]) = Maybe ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion))
    forall a. Maybe a
    Nothing
    earliestInconsistency CSP a
    csp (Status
    _,(a
    p:[a]
    ps)) =
        case (a -> Bool) -> [a] -> Maybe a
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find ((CSP a -> a -> a -> Bool
    forall p. CSP p -> p -> p -> Bool
    conflict CSP a
    csp) a
    p) ([a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    ps) of
          Maybe a
    Nothing -> Maybe ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion))
    forall a. Maybe a
    Nothing
          (Just a
    conflictingPackage) -> ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion))
    -> Maybe ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion))
    forall a. a -> Maybe a
    Just ((CSP a -> a -> (BinPkgName, DebianVersion)
    forall a. CSP a -> a -> (BinPkgName, DebianVersion)
    packageVersion CSP a
    csp) a
    p, (CSP a -> a -> (BinPkgName, DebianVersion)
    forall a. CSP a -> a -> (BinPkgName, DebianVersion)
    packageVersion CSP a
    csp) a
    conflictingPackage)

    -- * Conflict Set

    -- | conflicting packages and relations that require non-existant packages
    type ConflictSet = ([(BinPkgName, DebianVersion)],[Relation])

    isConflict :: ConflictSet -> Bool
    isConflict :: ConflictSet -> Bool
    isConflict ([],[]) = Bool
    False
    isConflict ConflictSet
    _ = Bool
    True

    solutions :: Tree (State a, ConflictSet) -> [State a]
    solutions :: forall a. Tree (State a, ConflictSet) -> [State a]
    solutions = (State a -> Bool) -> [State a] -> [State a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter State a -> Bool
    forall a. State a -> Bool
    complete ([State a] -> [State a])
    -> (Tree (State a, ConflictSet) -> [State a])
    -> Tree (State a, ConflictSet)
    -> [State a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((State a, ConflictSet) -> State a)
    -> [(State a, ConflictSet)] -> [State a]
    forall a b. (a -> b) -> [a] -> [b]
    map (State a, ConflictSet) -> State a
    forall a b. (a, b) -> a
    fst ([(State a, ConflictSet)] -> [State a])
    -> (Tree (State a, ConflictSet) -> [(State a, ConflictSet)])
    -> Tree (State a, ConflictSet)
    -> [State a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tree (State a, ConflictSet) -> [(State a, ConflictSet)]
    forall a. Tree a -> [a]
    leaves (Tree (State a, ConflictSet) -> [(State a, ConflictSet)])
    -> (Tree (State a, ConflictSet) -> Tree (State a, ConflictSet))
    -> Tree (State a, ConflictSet)
    -> [(State a, ConflictSet)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((State a, ConflictSet) -> Bool)
    -> Tree (State a, ConflictSet) -> Tree (State a, ConflictSet)
    forall a. (a -> Bool) -> Tree a -> Tree a
    prune (ConflictSet -> Bool
    isConflict (ConflictSet -> Bool)
    -> ((State a, ConflictSet) -> ConflictSet)
    -> (State a, ConflictSet)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (State a, ConflictSet) -> ConflictSet
    forall a b. (a, b) -> b
    snd)

    type Labeler a = CSP a -> Tree (State a) -> Tree (State a, ConflictSet)

    search :: Labeler a -> CSP a -> [State a]
    search :: forall a. Labeler a -> CSP a -> [State a]
    search Labeler a
    labeler CSP a
    csp = (Tree (State a, ConflictSet) -> [State a]
    forall a. Tree (State a, ConflictSet) -> [State a]
    solutions (Tree (State a, ConflictSet) -> [State a])
    -> (CSP a -> Tree (State a, ConflictSet)) -> CSP a -> [State a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Labeler a
    labeler CSP a
    csp) (Tree (State a) -> Tree (State a, ConflictSet))
    -> (CSP a -> Tree (State a))
    -> CSP a
    -> Tree (State a, ConflictSet)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CSP a -> Tree (State a)
    forall a. CSP a -> Tree (State a)
    mkSearchTree) CSP a
    csp

    -- * Backtracking Labeler

    bt :: Labeler a
    bt :: forall a. Labeler a
    bt CSP a
    csp = (State a -> (State a, ConflictSet))
    -> Tree (State a) -> Tree (State a, ConflictSet)
    forall a b. (a -> b) -> Tree a -> Tree b
    mapTree State a -> (State a, ConflictSet)
    f
        where
          f :: State a -> (State a, ConflictSet)
    f s :: State a
    s@(Status
    status,[a]
    _) =
                  case Status
    status of
                    (MissingDep Relation
    rel) -> (State a
    s, ([], [Relation
    rel]))
                    Status
    _ ->
                        (State a
    s,
                          case (CSP a
    -> State a
    -> Maybe ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion))
    forall a.
    CSP a
    -> State a
    -> Maybe ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion))
    earliestInconsistency CSP a
    csp) State a
    s of
                            Maybe ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion))
    Nothing -> ([],[])
                            Just ((BinPkgName, DebianVersion)
    a,(BinPkgName, DebianVersion)
    b) -> ([(BinPkgName, DebianVersion)
    a,(BinPkgName, DebianVersion)
    b], []))

    -- * BackJumping Solver

    {-|bj - backjumping labeler

    If the node already has a conflict set, then leave it alone.

    Otherwise, the conflictset for the node is the combination of the
    conflict sets of its direct children.
    -}
    bj :: CSP p -> Tree (State p, ConflictSet) -> Tree (State p, ConflictSet)
    bj :: forall p.
    CSP p -> Tree (State p, ConflictSet) -> Tree (State p, ConflictSet)
    bj CSP p
    csp = ((State p, ConflictSet)
     -> [Tree (State p, ConflictSet)] -> Tree (State p, ConflictSet))
    -> Tree (State p, ConflictSet) -> Tree (State p, ConflictSet)
    forall a b. (a -> [b] -> b) -> Tree a -> b
    foldTree (State p, ConflictSet)
    -> [Tree (State p, ConflictSet)] -> Tree (State p, ConflictSet)
    f
        where f :: (State p, ConflictSet)
    -> [Tree (State p, ConflictSet)] -> Tree (State p, ConflictSet)
    f (State p
    s, ConflictSet
    cs) [Tree (State p, ConflictSet)]
    ts
                | ConflictSet -> Bool
    isConflict ConflictSet
    cs  = (State p, ConflictSet)
    -> [Tree (State p, ConflictSet)] -> Tree (State p, ConflictSet)
    forall a. a -> [Tree a] -> Tree a
    mkTree (State p
    s, ConflictSet
    cs) [Tree (State p, ConflictSet)]
    ts
    --            | isConflict cs' = mkTree (s, cs') [] -- prevent space leak
                | Bool
    otherwise = (State p, ConflictSet)
    -> [Tree (State p, ConflictSet)] -> Tree (State p, ConflictSet)
    forall a. a -> [Tree a] -> Tree a
    mkTree (State p
    s, ConflictSet
    cs') [Tree (State p, ConflictSet)]
    ts
                where cs' :: ConflictSet
    cs' =
                          let set :: ConflictSet
    set = CSP p -> [(State p, ConflictSet)] -> [ConflictSet] -> ConflictSet
    forall p.
    CSP p -> [(State p, ConflictSet)] -> [ConflictSet] -> ConflictSet
    combine CSP p
    csp ((Tree (State p, ConflictSet) -> (State p, ConflictSet))
    -> [Tree (State p, ConflictSet)] -> [(State p, ConflictSet)]
    forall a b. (a -> b) -> [a] -> [b]
    map Tree (State p, ConflictSet) -> (State p, ConflictSet)
    forall a. Tree a -> a
    label [Tree (State p, ConflictSet)]
    ts) [] in
                          ConflictSet
    set ConflictSet -> ConflictSet -> ConflictSet
    forall a b. a -> b -> b
    `seq` ConflictSet
    set -- prevent space leak

    unionCS :: [ConflictSet] -> ConflictSet
    unionCS :: [ConflictSet] -> ConflictSet
    unionCS [ConflictSet]
    css = (ConflictSet -> ConflictSet -> ConflictSet)
    -> ConflictSet -> [ConflictSet] -> ConflictSet
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\([(BinPkgName, DebianVersion)]
    c1, [Relation]
    m1) ([(BinPkgName, DebianVersion)]
    c2, [Relation]
    m2) -> (([(BinPkgName, DebianVersion)]
    c1 [(BinPkgName, DebianVersion)]
    -> [(BinPkgName, DebianVersion)] -> [(BinPkgName, DebianVersion)]
    forall a. Eq a => [a] -> [a] -> [a]
    `union` [(BinPkgName, DebianVersion)]
    c2), ([Relation]
    m1 [Relation] -> [Relation] -> [Relation]
    forall a. Eq a => [a] -> [a] -> [a]
    `union` [Relation]
    m2))) ([],[]) [ConflictSet]
    css

    combine :: CSP p -> [(State p, ConflictSet)] -> [ConflictSet] -> ConflictSet
    combine :: forall p.
    CSP p -> [(State p, ConflictSet)] -> [ConflictSet] -> ConflictSet
    combine CSP p
    _ [] [ConflictSet]
    acc = [ConflictSet] -> ConflictSet
    unionCS [ConflictSet]
    acc
    combine CSP p
    csp ((State p
    s,cs :: ConflictSet
    cs@([(BinPkgName, DebianVersion)]
    c,[Relation]
    m)):[(State p, ConflictSet)]
    ns) [ConflictSet]
    acc
        | (Bool -> Bool
    not ((BinPkgName, DebianVersion)
    lastvar (BinPkgName, DebianVersion)
    -> [(BinPkgName, DebianVersion)] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [(BinPkgName, DebianVersion)]
    c)) Bool -> Bool -> Bool
    && [Relation] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Relation]
    m = ConflictSet
    cs
        | [(BinPkgName, DebianVersion)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(BinPkgName, DebianVersion)]
    c Bool -> Bool -> Bool
    && [Relation] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Relation]
    m = ([],[]) -- is this case ever used?
        | Bool
    otherwise = CSP p -> [(State p, ConflictSet)] -> [ConflictSet] -> ConflictSet
    forall p.
    CSP p -> [(State p, ConflictSet)] -> [ConflictSet] -> ConflictSet
    combine CSP p
    csp [(State p, ConflictSet)]
    ns (([(BinPkgName, DebianVersion)]
    c, [Relation]
    m)ConflictSet -> [ConflictSet] -> [ConflictSet]
    forall a. a -> [a] -> [a]
    :[ConflictSet]
    acc)
        where lastvar :: (BinPkgName, DebianVersion)
    lastvar = case State p
    s of
                            (Status
    _, p
    p:[p]
    _) -> CSP p -> p -> (BinPkgName, DebianVersion)
    forall a. CSP a -> a -> (BinPkgName, DebianVersion)
    packageVersion CSP p
    csp p
    p
                            State p
    _        -> String -> (BinPkgName, DebianVersion)
    forall a. HasCallStack => String -> a
    error String
    "combine: empty stack"