{-# 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
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
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 :: State a -> Bool
complete (Status
Complete, [a]
_) = Bool
True
complete State a
_ = Bool
False

data CSP a
    = CSP { CSP a -> PackageNameMap a
pnm :: PackageNameMap a
          , CSP a -> Relations
relations :: Relations
          , CSP a -> a -> Relations
depFunction :: (a -> Relations)
          , CSP a -> a -> Relations
conflicts :: a -> Relations
          , 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 -> Relations -> (Paragraph -> Relations) -> CSP Paragraph
controlCSP (Control [Paragraph]
paragraphs) Relations
rels Paragraph -> Relations
depF' =
    CSP :: forall a.
PackageNameMap a
-> Relations
-> (a -> Relations)
-> (a -> Relations)
-> (a -> (BinPkgName, DebianVersion))
-> CSP a
CSP { pnm :: PackageNameMap Paragraph
pnm = (Paragraph -> BinPkgName)
-> [Paragraph] -> PackageNameMap Paragraph
forall a. (a -> BinPkgName) -> [a] -> PackageNameMap a
packageNameMap Paragraph -> BinPkgName
getName [Paragraph]
paragraphs
        , relations :: Relations
relations = Relations
rels
        , depFunction :: Paragraph -> Relations
depFunction = Paragraph -> Relations
depF'
        , conflicts :: Paragraph -> Relations
conflicts = Paragraph -> Relations
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 -> Relations
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 -> Relations)
-> (Relations -> Relations)
-> Either ParseError Relations
-> Relations
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Relations
forall a. HasCallStack => String -> a
error (String -> Relations)
-> (ParseError -> String) -> ParseError -> Relations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show) Relations -> Relations
forall a. a -> a
id (ByteString -> Either ParseError Relations
forall a. ParseRelations a => a -> Either ParseError Relations
parseRelations ByteString
c)
            Just (Comment ByteString
_) -> String -> Relations
forall a. HasCallStack => String -> a
error String
"controlCSP"

testCSP :: FilePath -> (Paragraph -> Relations) -> String -> (CSP Paragraph -> IO a) -> IO a
testCSP :: String
-> (Paragraph -> Relations)
-> String
-> (CSP Paragraph -> IO a)
-> IO a
testCSP String
controlFile Paragraph -> Relations
depf String
relationStr CSP Paragraph -> IO a
cspf =
    do Either ParseError Control
c' <- String -> IO (Either ParseError Control)
forall a.
ControlFunctions a =>
String -> IO (Either ParseError (Control' a))
parseControlFromFile String
controlFile
       case Either ParseError Control
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 Relations
forall a. ParseRelations a => a -> Either ParseError Relations
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 Relations
r ->
                     CSP Paragraph -> IO a
cspf (Control -> Relations -> (Paragraph -> Relations) -> CSP Paragraph
controlCSP Control
control Relations
r Paragraph -> Relations
depf)

depF :: Paragraph -> Relations
depF :: Paragraph -> Relations
depF Paragraph
p =
    let preDepends :: Relations
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 -> Relations)
-> (Relations -> Relations)
-> Either ParseError Relations
-> Relations
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Relations
forall a. HasCallStack => String -> a
error (String -> Relations)
-> (ParseError -> String) -> ParseError -> Relations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show) Relations -> Relations
forall a. a -> a
id (ByteString -> Either ParseError Relations
forall a. ParseRelations a => a -> Either ParseError Relations
parseRelations ByteString
pd)
              Just (Comment ByteString
_) -> String -> Relations
forall a. HasCallStack => String -> a
error String
"depF"
        depends :: Relations
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 -> Relations)
-> (Relations -> Relations)
-> Either ParseError Relations
-> Relations
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Relations
forall a. HasCallStack => String -> a
error (String -> Relations)
-> (ParseError -> String) -> ParseError -> Relations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show) Relations -> Relations
forall a. a -> a
id (ByteString -> Either ParseError Relations
forall a. ParseRelations a => a -> Either ParseError Relations
parseRelations ByteString
pd)
              Just (Comment ByteString
_) -> String -> Relations
forall a. HasCallStack => String -> a
error String
"depF"
    in
      Relations
preDepends Relations -> Relations -> Relations
forall a. [a] -> [a] -> [a]
++ Relations
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 =
    String
-> (Paragraph -> Relations)
-> String
-> (CSP Paragraph -> IO ())
-> IO ()
forall a.
String
-> (Paragraph -> Relations)
-> String
-> (CSP Paragraph -> IO a)
-> IO a
testCSP String
controlFP Paragraph -> Relations
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 (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 :: 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)) (Relations -> [Relation]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Relations -> [Relation]) -> Relations -> [Relation]
forall a b. (a -> b) -> a -> b
$ (CSP p -> p -> Relations
forall a. CSP a -> a -> Relations
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)) (Relations -> [Relation]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Relations -> [Relation]) -> Relations -> [Relation]
forall a b. (a -> b) -> a -> b
$ (CSP p -> p -> Relations
forall a. CSP a -> a -> Relations
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 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 :: a -> [Tree a] -> Tree a
mkTree = a -> [Tree a] -> Tree a
forall a. a -> Forest a -> Tree a
Node

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

initTree :: (a -> [a]) -> a -> Tree a
initTree :: (a -> [a]) -> a -> Tree a
initTree a -> [a]
f a
a = a -> Forest a -> Tree a
forall a. a -> Forest a -> Tree a
Node a
a ((a -> Tree a) -> [a] -> Forest 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 :: (a -> b) -> Tree a -> Tree b
mapTree = (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 :: (a -> [b] -> b) -> Tree a -> b
foldTree a -> [b] -> b
f (Node a
a Forest a
ts) = a -> [b] -> b
f a
a ((Tree a -> b) -> Forest 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) Forest a
ts)

zipTreesWith :: (a -> b -> c) -> Tree a -> Tree b -> Tree c
zipTreesWith :: (a -> b -> c) -> Tree a -> Tree b -> Tree c
zipTreesWith a -> b -> c
f (Node a
a Forest a
ts) (Node b
b Forest b
us) =
    c -> Forest c -> Tree c
forall a. a -> Forest a -> Tree a
Node (a -> b -> c
f a
a b
b) ((Tree a -> Tree b -> Tree c) -> Forest a -> Forest b -> Forest 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) Forest a
ts Forest b
us)

prune :: (a -> Bool) -> Tree a -> Tree a
prune :: (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 -> Forest 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 :: 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 :: (b -> a -> b) -> b -> Tree a -> Tree b
inhTree b -> a -> b
f b
b (Node a
a Forest a
ts) = b -> Forest b -> Tree b
forall a. a -> Forest a -> Tree a
Node b
b' ((Tree a -> Tree b) -> Forest a -> Forest 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') Forest a
ts)
    where b' :: b
b' = b -> a -> b
f b
b a
a

distrTree :: (a -> [b]) -> b -> Tree a -> Tree b
distrTree :: (a -> [b]) -> b -> Tree a -> Tree b
distrTree  a -> [b]
f b
b (Node a
a Forest a
ts) = b -> Forest b -> Tree b
forall a. a -> Forest a -> Tree a
Node b
b ((b -> Tree a -> Tree b) -> [b] -> Forest a -> Forest 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) Forest a
ts)

-- * mkSearchTree

-- TODO: might want to leave markers about what relation we are satisfying?
mkSearchTree :: forall a. CSP a -> Tree (State a)
mkSearchTree :: CSP a -> Tree (State a)
mkSearchTree CSP a
csp =
    State a -> Forest (State a) -> Tree (State a)
forall a. a -> Forest a -> Tree a
Node (Relations -> Status
Remaining (CSP a -> Relations
forall a. CSP a -> Relations
relations CSP a
csp),[]) (([a], Relations) -> Relations -> Forest (State a)
andRelation ([],[]) (CSP a -> Relations
forall a. CSP a -> Relations
relations CSP a
csp))
    where
      andRelation :: ([a],AndRelation) -> AndRelation -> [Tree (State a)]
      andRelation :: ([a], Relations) -> Relations -> Forest (State a)
andRelation ([a]
candidates,[]) [] = [State a -> Forest (State a) -> Tree (State a)
forall a. a -> Forest a -> Tree a
Node (Status
Complete, [a]
candidates) []]
      andRelation ([a]
candidates,Relations
remaining) [] = ([a], Relations) -> Relations -> Forest (State a)
andRelation ([a]
candidates, []) Relations
remaining
      andRelation ([a]
candidates, Relations
remaining) ([Relation]
x:Relations
xs) =
          ([a], Relations) -> [Relation] -> Forest (State a)
orRelation ([a]
candidates, Relations
xs Relations -> Relations -> Relations
forall a. [a] -> [a] -> [a]
++ Relations
remaining) [Relation]
x
      orRelation :: ([a],AndRelation) -> OrRelation -> [Tree (State a)]
      orRelation :: ([a], Relations) -> [Relation] -> Forest (State a)
orRelation ([a], Relations)
acc [Relation]
x =
          [Forest (State a)] -> Forest (State a)
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Relation -> Forest (State a)) -> [Relation] -> [Forest (State a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([a], Relations) -> Relation -> Forest (State a)
relation ([a], Relations)
acc) [Relation]
x)
      relation :: ([a],AndRelation) -> Relation -> [Tree (State a)]
      relation :: ([a], Relations) -> Relation -> Forest (State a)
relation acc :: ([a], Relations)
acc@([a]
candidates,Relations
_) 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 -> Forest (State a) -> Tree (State a)
forall a. a -> Forest a -> Tree a
Node (Relation -> Status
MissingDep Relation
rel, [a]
candidates) []]
            [a]
_ -> (a -> Tree (State a)) -> [a] -> Forest (State a)
forall a b. (a -> b) -> [a] -> [b]
map (([a], Relations) -> a -> Tree (State a)
package ([a], Relations)
acc) [a]
packages
      package :: ([a],AndRelation) -> a -> Tree (State a)
      package :: ([a], Relations) -> a -> Tree (State a)
package ([a]
candidates, Relations
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 (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 Relations -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Relations
remaining
               then State a -> Forest (State a) -> Tree (State a)
forall a. a -> Forest a -> Tree a
Node (Status
Complete, [a]
candidates) []
               else State a -> Forest (State a) -> Tree (State a)
forall a. a -> Forest a -> Tree a
Node (Relations -> Status
Remaining Relations
remaining, [a]
candidates) (([a], Relations) -> Relations -> Forest (State a)
andRelation ([a]
candidates, []) Relations
remaining)
          else State a -> Forest (State a) -> Tree (State a)
forall a. a -> Forest a -> Tree a
Node (Relations -> Status
Remaining Relations
remaining, (a
p a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
candidates)) (([a], Relations) -> Relations -> Forest (State a)
andRelation ((a
p a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
candidates), Relations
remaining) ((CSP a -> a -> Relations
forall a. CSP a -> a -> Relations
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 :: 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 :: 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 :: 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 :: Labeler a
bt CSP a
csp = ((Status, [a]) -> ((Status, [a]), ConflictSet))
-> Tree (Status, [a]) -> Tree ((Status, [a]), ConflictSet)
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 (CSP a
-> (Status, [a])
-> Maybe ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion))
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 :: 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 -> Forest 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 -> Forest 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
`seq` ConflictSet
set -- prevent space leak

unionCS :: [ConflictSet] -> ConflictSet
unionCS :: [ConflictSet] -> ConflictSet
unionCS [ConflictSet]
css = (ConflictSet -> ConflictSet -> ConflictSet)
-> ConflictSet -> [ConflictSet] -> ConflictSet
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 :: 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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(BinPkgName, DebianVersion)]
c)) Bool -> Bool -> Bool
&& [Relation] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Relation]
m = ConflictSet
cs
    | [(BinPkgName, DebianVersion)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(BinPkgName, DebianVersion)]
c Bool -> Bool -> Bool
&& [Relation] -> 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 =
              let (Status
_,(p
p:[p]
_)) = State p
s in (CSP p -> p -> (BinPkgName, DebianVersion)
forall a. CSP a -> a -> (BinPkgName, DebianVersion)
packageVersion CSP p
csp) p
p