{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS -fno-warn-missing-signatures #-}
module Debian.Apt.Dependencies
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)
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 (Complete, _) = Bool
True
complete _ = 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)
}
controlCSP :: Control -> Relations -> (Paragraph -> Relations) -> CSP Paragraph
controlCSP :: Control -> Relations -> (Paragraph -> Relations) -> CSP Paragraph
controlCSP (Control paragraphs :: [Paragraph]
paragraphs) rels :: Relations
rels depF' :: 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 p :: Paragraph
p = case String -> Paragraph -> Maybe (Field' ByteString)
forall a.
ControlFunctions a =>
String -> Paragraph' a -> Maybe (Field' a)
lookupP "Package" Paragraph
p of
Nothing -> String -> BinPkgName
forall a. HasCallStack => String -> a
error "Missing Package field"
Just (Field (_,n :: ByteString
n)) -> String -> BinPkgName
BinPkgName (ByteString -> String
C.unpack (ByteString -> ByteString
forall a. ControlFunctions a => a -> a
stripWS ByteString
n))
Just (Comment _) -> String -> BinPkgName
forall a. HasCallStack => String -> a
error "controlCSP"
conflicts' :: Paragraph -> Relations
conflicts' :: Paragraph -> Relations
conflicts' p :: Paragraph
p =
case String -> Paragraph -> Maybe (Field' ByteString)
forall a.
ControlFunctions a =>
String -> Paragraph' a -> Maybe (Field' a)
lookupP "Conflicts" Paragraph
p of
Nothing -> []
Just (Field (_, c :: 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 _) -> String -> Relations
forall a. HasCallStack => String -> a
error "controlCSP"
testCSP :: FilePath -> (Paragraph -> Relations) -> String -> (CSP Paragraph -> IO a) -> IO a
testCSP :: String
-> (Paragraph -> Relations)
-> String
-> (CSP Paragraph -> IO a)
-> IO a
testCSP controlFile :: String
controlFile depf :: Paragraph -> Relations
depf relationStr :: String
relationStr cspf :: 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 e :: 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 _) ->
case String -> Either ParseError Relations
forall a. ParseRelations a => a -> Either ParseError Relations
parseRelations String
relationStr of
Left e :: ParseError
e -> String -> IO a
forall a. HasCallStack => String -> a
error (ParseError -> String
forall a. Show a => a -> String
show ParseError
e)
Right r :: 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 p :: Paragraph
p =
let preDepends :: Relations
preDepends =
case String -> Paragraph -> Maybe (Field' ByteString)
forall a.
ControlFunctions a =>
String -> Paragraph' a -> Maybe (Field' a)
lookupP "Pre-Depends" Paragraph
p of
Nothing -> []
Just (Field (_,pd :: 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 _) -> String -> Relations
forall a. HasCallStack => String -> a
error "depF"
depends :: Relations
depends =
case String -> Paragraph -> Maybe (Field' ByteString)
forall a.
ControlFunctions a =>
String -> Paragraph' a -> Maybe (Field' a)
lookupP "Depends" Paragraph
p of
Nothing -> []
Just (Field (_,pd :: 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 _) -> String -> Relations
forall a. HasCallStack => String -> a
error "depF"
in
Relations
preDepends Relations -> Relations -> Relations
forall a. [a] -> [a] -> [a]
++ Relations
depends
sidPackages :: String
sidPackages = "/var/lib/apt/lists/ftp.debian.org_debian_dists_unstable_main_binary-i386_Packages"
gutsyPackages :: String
gutsyPackages = "/var/lib/apt/lists/mirror.anl.gov_pub_ubuntu_dists_gutsy_main_binary-i386_Packages"
test :: String -> String -> Labeler Paragraph -> IO ()
test controlFP :: String
controlFP rel :: String
rel labeler :: 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_ (\ (_,p :: [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 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)
packageVersionParagraph :: Paragraph -> (BinPkgName, DebianVersion)
packageVersionParagraph :: Paragraph -> (BinPkgName, DebianVersion)
packageVersionParagraph p :: Paragraph
p =
case String -> Paragraph -> Maybe (Field' ByteString)
forall a.
ControlFunctions a =>
String -> Paragraph' a -> Maybe (Field' a)
lookupP "Package" Paragraph
p of
Nothing -> String -> (BinPkgName, DebianVersion)
forall a. HasCallStack => String -> a
error (String -> (BinPkgName, DebianVersion))
-> String -> (BinPkgName, DebianVersion)
forall a b. (a -> b) -> a -> b
$ "Paragraph missing Package field"
(Just (Field (_, name :: ByteString
name))) ->
case String -> Paragraph -> Maybe (Field' ByteString)
forall a.
ControlFunctions a =>
String -> Paragraph' a -> Maybe (Field' a)
lookupP "Version" Paragraph
p of
Nothing -> String -> (BinPkgName, DebianVersion)
forall a. HasCallStack => String -> a
error (String -> (BinPkgName, DebianVersion))
-> String -> (BinPkgName, DebianVersion)
forall a b. (a -> b) -> a -> b
$ "Paragraph missing Version field"
(Just (Field (_, str :: ByteString
str))) ->
case ByteString -> Either ParseError DebianVersion
forall a.
ParseDebianVersion a =>
a -> Either ParseError DebianVersion
parseDebianVersion ByteString
str of
Right ver :: DebianVersion
ver -> (String -> BinPkgName
BinPkgName (ByteString -> String
C.unpack (ByteString -> ByteString
forall a. ControlFunctions a => a -> a
stripWS ByteString
name)), DebianVersion
ver)
Left e :: ParseError
e -> String -> (BinPkgName, DebianVersion)
forall a. HasCallStack => String -> a
error (String -> (BinPkgName, DebianVersion))
-> String -> (BinPkgName, DebianVersion)
forall a b. (a -> b) -> a -> b
$ "packageVersionParagraph: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
e
(Just (Comment _)) -> String -> (BinPkgName, DebianVersion)
forall a. HasCallStack => String -> a
error "packageVersionParagraph"
(Just (Comment _)) -> String -> (BinPkgName, DebianVersion)
forall a. HasCallStack => String -> a
error "packageVersionParagraph"
conflict :: CSP p -> p -> p -> Bool
conflict :: CSP p -> p -> p -> Bool
conflict csp :: CSP p
csp p1 :: p
p1 p2 :: p
p2 =
let (name1 :: BinPkgName
name1, version1 :: DebianVersion
version1) = (CSP p -> p -> (BinPkgName, DebianVersion)
forall a. CSP a -> a -> (BinPkgName, DebianVersion)
packageVersion CSP p
csp) p
p1
(name2 :: BinPkgName
name2, version2 :: 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)
conflict' :: (BinPkgName, DebianVersion) -> Relation -> Bool
conflict' :: (BinPkgName, DebianVersion) -> Relation -> Bool
conflict' (pName :: BinPkgName
pName, pVersion :: DebianVersion
pVersion) (Rel pkgName :: BinPkgName
pkgName mVersionReq :: Maybe VersionReq
mVersionReq _) =
(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))
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 f :: a -> [a]
f a :: 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 f :: a -> [b] -> b
f (Node a :: a
a ts :: 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 f :: a -> b -> c
f (Node a :: a
a ts :: Forest a
ts) (Node b :: b
b us :: 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 p :: 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
a ts :: [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 leaf :: a
leaf [] = [a
leaf]
f _ ts :: [[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 f :: b -> a -> b
f b :: b
b (Node a :: a
a ts :: 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 f :: a -> [b]
f b :: b
b (Node a :: a
a ts :: 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 :: forall a. CSP a -> Tree (State a)
mkSearchTree :: CSP a -> Tree (State a)
mkSearchTree csp :: 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 (candidates :: [a]
candidates,[]) [] = [State a -> Forest (State a) -> Tree (State a)
forall a. a -> Forest a -> Tree a
Node (Status
Complete, [a]
candidates) []]
andRelation (candidates :: [a]
candidates,remaining :: Relations
remaining) [] = ([a], Relations) -> Relations -> Forest (State a)
andRelation ([a]
candidates, []) Relations
remaining
andRelation (candidates :: [a]
candidates, remaining :: Relations
remaining) (x :: [Relation]
x:xs :: 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 acc :: ([a], Relations)
acc x :: [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@(candidates :: [a]
candidates,_) rel :: 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 -> 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 (candidates :: [a]
candidates, remaining :: Relations
remaining) p :: 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 :: CSP a -> State a -> Maybe ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion))
earliestInconsistency :: CSP a
-> State a
-> Maybe ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion))
earliestInconsistency _ (_,[]) = Maybe ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion))
forall a. Maybe a
Nothing
earliestInconsistency _ (_,[_p :: a
_p]) = Maybe ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion))
forall a. Maybe a
Nothing
earliestInconsistency csp :: CSP a
csp (_,(p :: a
p:ps :: [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
Nothing -> Maybe ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion))
forall a. Maybe a
Nothing
(Just conflictingPackage :: 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)
type ConflictSet = ([(BinPkgName, DebianVersion)],[Relation])
isConflict :: ConflictSet -> Bool
isConflict :: ConflictSet -> Bool
isConflict ([],[]) = Bool
False
isConflict _ = 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 :: Labeler a
labeler csp :: 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
bt :: Labeler a
bt :: Labeler a
bt csp :: 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
status,_) =
case Status
status of
(MissingDep rel :: Relation
rel) -> ((Status, [a])
s, ([], [Relation
rel]))
_ ->
((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
Nothing -> ([],[])
Just (a :: (BinPkgName, DebianVersion)
a,b :: (BinPkgName, DebianVersion)
b) -> ([(BinPkgName, DebianVersion)
a,(BinPkgName, DebianVersion)
b], []))
bj :: CSP p -> Tree (State p, ConflictSet) -> Tree (State p, ConflictSet)
bj :: CSP p -> Tree (State p, ConflictSet) -> Tree (State p, ConflictSet)
bj csp :: 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 (s :: State p
s, cs :: ConflictSet
cs) ts :: [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
| 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
forall a b. a -> b -> b
`seq` ConflictSet
set
unionCS :: [ConflictSet] -> ConflictSet
unionCS :: [ConflictSet] -> ConflictSet
unionCS css :: [ConflictSet]
css = (ConflictSet -> ConflictSet -> ConflictSet)
-> ConflictSet -> [ConflictSet] -> ConflictSet
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(c1 :: [(BinPkgName, DebianVersion)]
c1, m1 :: [Relation]
m1) (c2 :: [(BinPkgName, DebianVersion)]
c2, m2 :: [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 _ [] acc :: [ConflictSet]
acc = [ConflictSet] -> ConflictSet
unionCS [ConflictSet]
acc
combine csp :: CSP p
csp ((s :: State p
s,cs :: ConflictSet
cs@(c :: [(BinPkgName, DebianVersion)]
c,m :: [Relation]
m)):ns :: [(State p, ConflictSet)]
ns) acc :: [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 = ([],[])
| 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 (_,(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