{-# 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 (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)
}
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)
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)
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))
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 :: 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 :: 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)
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
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], []))
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
| 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
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 = ([],[])
| 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