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

-- test gutsyPackages "libc6" (\csp -> bt csp)

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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c== :: 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 = 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 forall a.
ControlFunctions a =>
String -> Paragraph' a -> Maybe (Field' a)
lookupP String
"Package" Paragraph
p of
                    Maybe (Field' ByteString)
Nothing -> forall a. HasCallStack => String -> a
error String
"Missing Package field"
                    Just (Field (ByteString
_,ByteString
n)) -> String -> BinPkgName
BinPkgName (ByteString -> String
C.unpack (forall a. ControlFunctions a => a -> a
stripWS ByteString
n))
                    Just (Comment ByteString
_) -> forall a. HasCallStack => String -> a
error String
"controlCSP"
      conflicts' :: Paragraph -> Relations
      conflicts' :: Paragraph -> AndRelation
conflicts' Paragraph
p =
          case 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)) -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. a -> a
id (forall a. ParseRelations a => a -> Either ParseError AndRelation
parseRelations ByteString
c)
            Just (Comment ByteString
_) -> 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 Either ParseError Control
c' <- forall a.
ControlFunctions a =>
String -> IO (Either ParseError (Control' a))
parseControlFromFile String
controlFile
       case Either ParseError Control
c' of
         Left ParseError
e -> forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show ParseError
e)
         Right control :: Control
control@(Control [Paragraph]
_) ->
             case forall a. ParseRelations a => a -> Either ParseError AndRelation
parseRelations String
relationStr of
               Left ParseError
e -> forall a. HasCallStack => String -> a
error (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 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)) ->
                  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. a -> a
id (forall a. ParseRelations a => a -> Either ParseError AndRelation
parseRelations ByteString
pd)
              Just (Comment ByteString
_) -> forall a. HasCallStack => String -> a
error String
"depF"
        depends :: AndRelation
depends =
            case 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)) ->
                  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. a -> a
id (forall a. ParseRelations a => a -> Either ParseError AndRelation
parseRelations ByteString
pd)
              Just (Comment ByteString
_) -> forall a. HasCallStack => String -> a
error String
"depF"
    in
      AndRelation
preDepends forall a. [a] -> [a] -> [a]
++ AndRelation
depends

sidPackages :: String
sidPackages = String
"/var/lib/apt/lists/ftp.debian.org_debian_dists_unstable_main_binary-i386_Packages"
gutsyPackages :: String
gutsyPackages = String
"/var/lib/apt/lists/mirror.anl.gov_pub_ubuntu_dists_gutsy_main_binary-i386_Packages"

test :: String -> String -> Labeler Paragraph -> IO ()
test String
controlFP String
rel Labeler Paragraph
labeler =
    forall a.
String
-> (Paragraph -> AndRelation)
-> String
-> (CSP Paragraph -> IO a)
-> IO a
testCSP String
controlFP Paragraph -> AndRelation
depF String
rel (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ (Status
_,[Paragraph]
p) -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a. Show a => a -> IO ()
print forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Doc -> String
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. DebianVersion -> Doc
prettyDebianVersion) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Paragraph -> (BinPkgName, DebianVersion)
packageVersionParagraph) [Paragraph]
p ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a.
ControlFunctions a =>
String -> Paragraph' a -> Maybe (Field' a)
lookupP String
"Package" Paragraph
p of
      Maybe (Field' ByteString)
Nothing -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Paragraph missing Package field"
      (Just (Field (ByteString
_, ByteString
name))) ->
          case forall a.
ControlFunctions a =>
String -> Paragraph' a -> Maybe (Field' a)
lookupP String
"Version" Paragraph
p of
            Maybe (Field' ByteString)
Nothing -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Paragraph missing Version field"
            (Just (Field (ByteString
_, ByteString
str))) ->
                case forall a.
ParseDebianVersion a =>
a -> Either ParseError DebianVersion
parseDebianVersion ByteString
str of
                  Right DebianVersion
ver -> (String -> BinPkgName
BinPkgName (ByteString -> String
C.unpack (forall a. ControlFunctions a => a -> a
stripWS ByteString
name)), DebianVersion
ver)
                  Left ParseError
e -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"packageVersionParagraph: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ParseError
e
            (Just (Comment ByteString
_)) -> forall a. HasCallStack => String -> a
error String
"packageVersionParagraph"
      (Just (Comment ByteString
_)) -> 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) = (forall a. CSP a -> a -> (BinPkgName, DebianVersion)
packageVersion CSP p
csp) p
p1
        (BinPkgName
name2, DebianVersion
version2) = (forall a. CSP a -> a -> (BinPkgName, DebianVersion)
packageVersion CSP p
csp) p
p2
    in
      if BinPkgName
name1 forall a. Eq a => a -> a -> Bool
== BinPkgName
name2
      then DebianVersion
version1 forall a. Eq a => a -> a -> Bool
/= DebianVersion
version2
      else
        forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((BinPkgName, DebianVersion) -> Relation -> Bool
conflict' (BinPkgName
name1, DebianVersion
version1)) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ (forall a. CSP a -> a -> AndRelation
conflicts CSP p
csp) p
p2) Bool -> Bool -> Bool
||
        forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((BinPkgName, DebianVersion) -> Relation -> Bool
conflict' (BinPkgName
name2, DebianVersion
version2)) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ (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) (Rel BinPkgName
pkgName Maybe VersionReq
mVersionReq Maybe ArchitectureReq
_) =
    (BinPkgName
pName forall a. Eq a => a -> a -> Bool
== BinPkgName
pkgName) Bool -> Bool -> Bool
&& (Maybe VersionReq -> Maybe DebianVersion -> Bool
checkVersionReq Maybe VersionReq
mVersionReq (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 = forall a. a -> [Tree a] -> Tree a
Node

label :: Tree a -> a
label :: forall a. Tree a -> a
label = 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 = forall a. a -> [Tree a] -> Tree a
Node a
a (forall a b. (a -> b) -> [a] -> [b]
map (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 = 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 (forall a b. (a -> b) -> [a] -> [b]
map (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) =
    forall a. a -> [Tree a] -> Tree a
Node (a -> b -> c
f a
a b
b) (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (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 = 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 = forall a. a -> [Tree a] -> Tree a
Node a
a (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> a
label) [Tree a]
ts)

leaves :: Tree a -> [a]
leaves :: forall a. Tree a -> [a]
leaves = forall a b. (a -> [b] -> b) -> Tree a -> b
foldTree forall {a}. a -> [[a]] -> [a]
f
    where f :: a -> [[a]] -> [a]
f a
leaf [] = [a
leaf]
          f a
_ [[a]]
ts = 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) = forall a. a -> [Tree a] -> Tree a
Node b
b' (forall a b. (a -> b) -> [a] -> [b]
map (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) = forall a. a -> [Tree a] -> Tree a
Node b
b (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (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 =
    forall a. a -> [Tree a] -> Tree a
Node (AndRelation -> Status
Remaining (forall a. CSP a -> AndRelation
relations CSP a
csp),[]) (([a], AndRelation) -> AndRelation -> [Tree (State 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,[]) [] = [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 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 =
          forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (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 = forall a.
PackageNameMap a
-> (a -> (BinPkgName, DebianVersion)) -> Relation -> [a]
lookupPackageByRel (forall a. CSP a -> PackageNameMap a
pnm CSP a
csp) (forall a. CSP a -> a -> (BinPkgName, DebianVersion)
packageVersion CSP a
csp) Relation
rel in
          case [a]
packages of
            [] -> [forall a. a -> [Tree a] -> Tree a
Node (Relation -> Status
MissingDep Relation
rel, [a]
candidates) []]
            [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 ((forall a. CSP a -> a -> (BinPkgName, DebianVersion)
packageVersion CSP a
csp) a
p) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (forall a b. (a -> b) -> [a] -> [b]
map (forall a. CSP a -> a -> (BinPkgName, DebianVersion)
packageVersion CSP a
csp) [a]
candidates)
          then if forall (t :: * -> *) a. Foldable t => t a -> Bool
null AndRelation
remaining
               then forall a. a -> [Tree a] -> Tree a
Node (Status
Complete, [a]
candidates) []
               else 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 forall a. a -> [Tree a] -> Tree a
Node (AndRelation -> Status
Remaining AndRelation
remaining, (a
p forall a. a -> [a] -> [a]
: [a]
candidates)) (([a], AndRelation) -> AndRelation -> [Tree (State a)]
andRelation ((a
p forall a. a -> [a] -> [a]
: [a]
candidates), AndRelation
remaining) ((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
_,[]) = forall a. Maybe a
Nothing
earliestInconsistency CSP a
_ (Status
_,[a
_p]) = forall a. Maybe a
Nothing
earliestInconsistency CSP a
csp (Status
_,(a
p:[a]
ps)) =
    case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall p. CSP p -> p -> p -> Bool
conflict CSP a
csp) a
p) (forall a. [a] -> [a]
reverse [a]
ps) of
      Maybe a
Nothing -> forall a. Maybe a
Nothing
      (Just a
conflictingPackage) -> forall a. a -> Maybe a
Just ((forall a. CSP a -> a -> (BinPkgName, DebianVersion)
packageVersion CSP a
csp) a
p, (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 = forall a. (a -> Bool) -> [a] -> [a]
filter forall a. State a -> Bool
complete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> [a]
leaves forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Tree a -> Tree a
prune (ConflictSet -> Bool
isConflict forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = (forall a. Tree (State a, ConflictSet) -> [State a]
solutions forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Labeler a
labeler CSP a
csp) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b. (a -> b) -> Tree a -> Tree b
mapTree (Status, [a]) -> ((Status, [a]), ConflictSet)
f
    where
      f :: (Status, [a]) -> ((Status, [a]), ConflictSet)
f s :: (Status, [a])
s@(Status
status,[a]
_) =
              case Status
status of
                (MissingDep Relation
rel) -> ((Status, [a])
s, ([], [Relation
rel]))
                Status
_ ->
                    ((Status, [a])
s,
                      case (forall a.
CSP a
-> State a
-> Maybe ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion))
earliestInconsistency CSP a
csp) (Status, [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 = 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  = 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 = 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 = forall p.
CSP p -> [(State p, ConflictSet)] -> [ConflictSet] -> ConflictSet
combine CSP p
csp (forall a b. (a -> b) -> [a] -> [b]
map forall a. Tree a -> a
label [Tree (State p, ConflictSet)]
ts) [] in
                      ConflictSet
set seq :: forall a b. a -> b -> b
`seq` ConflictSet
set -- prevent space leak

unionCS :: [ConflictSet] -> ConflictSet
unionCS :: [ConflictSet] -> ConflictSet
unionCS [ConflictSet]
css = 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 forall a. Eq a => [a] -> [a] -> [a]
`union` [(BinPkgName, DebianVersion)]
c2), ([Relation]
m1 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(BinPkgName, DebianVersion)]
c)) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Relation]
m = ConflictSet
cs
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(BinPkgName, DebianVersion)]
c Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Relation]
m = ([],[]) -- is this case ever used?
    | Bool
otherwise = forall p.
CSP p -> [(State p, ConflictSet)] -> [ConflictSet] -> ConflictSet
combine CSP p
csp [(State p, ConflictSet)]
ns (([(BinPkgName, DebianVersion)]
c, [Relation]
m)forall a. a -> [a] -> [a]
:[ConflictSet]
acc)
    where lastvar :: (BinPkgName, DebianVersion)
lastvar =
              let (Status
_,(p
p:[p]
_)) = State p
s in (forall a. CSP a -> a -> (BinPkgName, DebianVersion)
packageVersion CSP p
csp) p
p