{-# LANGUAGE CPP, FlexibleContexts, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TemplateHaskell #-}
{-# LANGUAGE NoDisambiguateRecordFields, NoRecordWildCards #-}
module Debian.GenBuildDeps
( DepInfo(..)
, sourceName'
, relations'
, binaryNames'
, buildDependencies
, RelaxInfo
, relaxDeps
, BuildableInfo(..)
, ReadyTarget(..)
, buildable
, compareSource
, orderSource
, genDeps
, failPackage
, getSourceOrder
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Exception (throw)
import Control.Monad (filterM, foldM)
import Control.Monad.State (evalState, get, modify, State)
import Data.Graph (Graph, Edge, Vertex, buildG, topSort, reachable, transposeG, edges, scc)
import Data.List as List (elemIndex, find, map, nub, partition, tails)
import Data.Map as Map (empty, findWithDefault, fromList, insert, Map, lookup)
import Data.Maybe
import Data.Set as Set (fromList, intersection, null, Set)
import Data.Tree as Tree (Tree(Node, rootLabel, subForest))
import Debian.Control (parseControlFromFile)
import Debian.Control.Policy (HasDebianControl, DebianControl, ControlFileError(..), validateDebianControl, debianSourcePackageName, debianBinaryPackageNames, debianBuildDeps, debianBuildDepsIndep)
import Debian.Loc (__LOC__)
import Debian.Relation
import Debian.Relation.Text ()
import System.Directory (getDirectoryContents, doesFileExist)
data DepInfo = DepInfo {
DepInfo -> SrcPkgName
sourceName :: SrcPkgName
, DepInfo -> Relations
relations :: Relations
, DepInfo -> [BinPkgName]
binaryNames :: [BinPkgName]
, DepInfo -> Set BinPkgName
depSet :: Set.Set BinPkgName
, DepInfo -> Set BinPkgName
binSet :: Set.Set BinPkgName
} deriving Vertex -> DepInfo -> ShowS
[DepInfo] -> ShowS
DepInfo -> [Char]
forall a.
(Vertex -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DepInfo] -> ShowS
$cshowList :: [DepInfo] -> ShowS
show :: DepInfo -> [Char]
$cshow :: DepInfo -> [Char]
showsPrec :: Vertex -> DepInfo -> ShowS
$cshowsPrec :: Vertex -> DepInfo -> ShowS
Show
instance Eq DepInfo where
DepInfo
a == :: DepInfo -> DepInfo -> Bool
== DepInfo
b = (DepInfo -> SrcPkgName
sourceName DepInfo
a forall a. Eq a => a -> a -> Bool
== DepInfo -> SrcPkgName
sourceName DepInfo
b) Bool -> Bool -> Bool
&&
forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
map forall a. Ord a => [a] -> Set a
Set.fromList (DepInfo -> Relations
relations DepInfo
a)) forall a. Eq a => a -> a -> Bool
== forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
map forall a. Ord a => [a] -> Set a
Set.fromList (DepInfo -> Relations
relations DepInfo
b)) Bool -> Bool -> Bool
&&
forall a. Ord a => [a] -> Set a
Set.fromList (DepInfo -> [BinPkgName]
binaryNames DepInfo
a) forall a. Eq a => a -> a -> Bool
== forall a. Ord a => [a] -> Set a
Set.fromList (DepInfo -> [BinPkgName]
binaryNames DepInfo
b)
buildDependencies :: HasDebianControl control => control -> DepInfo
buildDependencies :: forall control. HasDebianControl control => control -> DepInfo
buildDependencies control
control = do
let rels :: Relations
rels = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall a. a -> Maybe a -> a
fromMaybe [] (forall a. HasDebianControl a => a -> Maybe Relations
debianBuildDeps control
control),
forall a. a -> Maybe a -> a
fromMaybe [] (forall a. HasDebianControl a => a -> Maybe Relations
debianBuildDepsIndep control
control)]
bins :: [BinPkgName]
bins = forall a. HasDebianControl a => a -> [BinPkgName]
debianBinaryPackageNames control
control
DepInfo { sourceName :: SrcPkgName
sourceName = forall a. HasDebianControl a => a -> SrcPkgName
debianSourcePackageName control
control
, relations :: Relations
relations = Relations
rels
, binaryNames :: [BinPkgName]
binaryNames = [BinPkgName]
bins
, depSet :: Set BinPkgName
depSet = forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
List.map (\(Rel BinPkgName
x Maybe VersionReq
_ Maybe ArchitectureReq
_) -> BinPkgName
x) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Relations
rels))
, binSet :: Set BinPkgName
binSet = forall a. Ord a => [a] -> Set a
Set.fromList [BinPkgName]
bins }
sourceName' :: HasDebianControl control => control -> SrcPkgName
sourceName' :: forall a. HasDebianControl a => a -> SrcPkgName
sourceName' control
control = forall a. HasDebianControl a => a -> SrcPkgName
debianSourcePackageName control
control
relations' :: HasDebianControl control => control -> Relations
relations' :: forall control. HasDebianControl control => control -> Relations
relations' control
control = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall a. a -> Maybe a -> a
fromMaybe [] (forall a. HasDebianControl a => a -> Maybe Relations
debianBuildDeps control
control),
forall a. a -> Maybe a -> a
fromMaybe [] (forall a. HasDebianControl a => a -> Maybe Relations
debianBuildDepsIndep control
control)]
binaryNames' :: HasDebianControl control => control -> [BinPkgName]
binaryNames' :: forall a. HasDebianControl a => a -> [BinPkgName]
binaryNames' control
control = forall a. HasDebianControl a => a -> [BinPkgName]
debianBinaryPackageNames control
control
newtype OldRelaxInfo = RelaxInfo [(BinPkgName, Maybe SrcPkgName)] deriving Vertex -> OldRelaxInfo -> ShowS
[OldRelaxInfo] -> ShowS
OldRelaxInfo -> [Char]
forall a.
(Vertex -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OldRelaxInfo] -> ShowS
$cshowList :: [OldRelaxInfo] -> ShowS
show :: OldRelaxInfo -> [Char]
$cshow :: OldRelaxInfo -> [Char]
showsPrec :: Vertex -> OldRelaxInfo -> ShowS
$cshowsPrec :: Vertex -> OldRelaxInfo -> ShowS
Show
type RelaxInfo = SrcPkgName -> BinPkgName -> Bool
relaxDeps :: RelaxInfo -> [DepInfo] -> [DepInfo]
relaxDeps :: RelaxInfo -> [DepInfo] -> [DepInfo]
relaxDeps RelaxInfo
relaxInfo [DepInfo]
deps =
forall a b. (a -> b) -> [a] -> [b]
List.map DepInfo -> DepInfo
relaxDep [DepInfo]
deps
where
relaxDep :: DepInfo -> DepInfo
relaxDep :: DepInfo -> DepInfo
relaxDep DepInfo
info = DepInfo
info {relations :: Relations
relations = Relations
filteredDependencies}
where
filteredDependencies :: Relations
filteredDependencies :: Relations
filteredDependencies = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= []) (forall a b. (a -> b) -> [a] -> [b]
List.map (forall a. (a -> Bool) -> [a] -> [a]
filter Relation -> Bool
keepDep) (DepInfo -> Relations
relations DepInfo
info))
keepDep :: Relation -> Bool
keepDep :: Relation -> Bool
keepDep (Rel BinPkgName
name Maybe VersionReq
_ Maybe ArchitectureReq
_) = Bool -> Bool
not (RelaxInfo
relaxInfo (DepInfo -> SrcPkgName
sourceName DepInfo
info) BinPkgName
name)
data ReadyTarget a
= ReadyTarget { forall a. ReadyTarget a -> a
ready :: a
, forall a. ReadyTarget a -> [a]
waiting :: [a]
, forall a. ReadyTarget a -> [a]
other :: [a]
}
data BuildableInfo a
= BuildableInfo
{ forall a. BuildableInfo a -> [ReadyTarget a]
readyTargets :: [ReadyTarget a]
, forall a. BuildableInfo a -> [a]
allBlocked :: [a] }
| CycleInfo
{ forall a. BuildableInfo a -> [(a, a)]
depPairs :: [(a, a)] }
buildable :: forall a. (a -> DepInfo) -> [a] -> BuildableInfo a
buildable :: forall a. (a -> DepInfo) -> [a] -> BuildableInfo a
buildable a -> DepInfo
relax [a]
packages =
case forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\ Vertex
x -> Graph -> Vertex -> [Vertex]
reachable Graph
hasDep Vertex
x forall a. Eq a => a -> a -> Bool
== [Vertex
x]) [Vertex]
verts of
([], [Vertex]
_) -> CycleInfo {depPairs :: [(a, a)]
depPairs = forall a b. (a -> b) -> [a] -> [b]
List.map (Vertex, Vertex) -> (a, a)
ofEdge forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ (Graph -> [[(Vertex, Vertex)]]
allCycles Graph
hasDep)}
([Vertex]
allReady, [Vertex]
blocked) ->
BuildableInfo { readyTargets :: [ReadyTarget a]
readyTargets = forall a b. (a -> b) -> [a] -> [b]
List.map ([Vertex] -> [Vertex] -> Vertex -> ReadyTarget a
makeReady [Vertex]
blocked [Vertex]
allReady) [Vertex]
allReady
, allBlocked :: [a]
allBlocked = forall a b. (a -> b) -> [a] -> [b]
List.map Vertex -> a
ofVertex [Vertex]
blocked }
where
makeReady :: [Vertex] -> [Vertex] -> Vertex -> ReadyTarget a
makeReady :: [Vertex] -> [Vertex] -> Vertex -> ReadyTarget a
makeReady [Vertex]
blocked [Vertex]
ready Vertex
thisReady =
let otherReady :: [Vertex]
otherReady = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Vertex
thisReady) [Vertex]
ready
([Vertex]
directlyBlocked, [Vertex]
otherBlocked) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\ Vertex
x -> forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Vertex
x (Graph -> Vertex -> [Vertex]
reachable Graph
isDep Vertex
thisReady)) [Vertex]
blocked in
ReadyTarget { ready :: a
ready = Vertex -> a
ofVertex Vertex
thisReady
, waiting :: [a]
waiting = forall a b. (a -> b) -> [a] -> [b]
List.map Vertex -> a
ofVertex [Vertex]
directlyBlocked
, other :: [a]
other = forall a b. (a -> b) -> [a] -> [b]
List.map Vertex -> a
ofVertex ([Vertex]
otherReady forall a. [a] -> [a] -> [a]
++ [Vertex]
otherBlocked) }
isDep :: Graph
isDep :: Graph
isDep = Graph -> Graph
transposeG Graph
hasDep
hasDep :: Graph
hasDep :: Graph
hasDep = (Vertex, Vertex) -> [(Vertex, Vertex)] -> Graph
buildG (Vertex
0, forall (t :: * -> *) a. Foldable t => t a -> Vertex
length [a]
packages forall a. Num a => a -> a -> a
- Vertex
1) [(Vertex, Vertex)]
hasDepEdges
hasDepEdges :: [(Int, Int)]
hasDepEdges :: [(Vertex, Vertex)]
hasDepEdges =
#if 0
nub (foldr f [] (tails vertPairs))
where f :: [(Int, DepInfo)] -> [(Int, Int)] -> [(Int, Int)]
f [] es = es
f (x : xs) es = catMaybes (List.map (toEdge x) xs) ++ es
toEdge :: (Int, DepInfo) -> (Int, DepInfo) -> Maybe Edge
toEdge (xv, xa) (yv, ya) =
case compareSource xa ya of
EQ -> Nothing
LT -> Just (yv, xv)
GT -> Just (xv, yv)
#else
forall a. Eq a => [a] -> [a]
nub (forall s a. State s a -> s -> a
evalState (forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM [(Vertex, Vertex)]
-> [(Vertex, DepInfo)]
-> State (Map (Vertex, Vertex) Ordering) [(Vertex, Vertex)]
f [] (forall a. [a] -> [[a]]
tails [(Vertex, DepInfo)]
vertPairs)) forall k a. Map k a
Map.empty)
where f :: [(Int, Int)] -> [(Int, DepInfo)] -> State (Map.Map (Int, Int) Ordering) [(Int, Int)]
f :: [(Vertex, Vertex)]
-> [(Vertex, DepInfo)]
-> State (Map (Vertex, Vertex) Ordering) [(Vertex, Vertex)]
f [(Vertex, Vertex)]
es [] = forall (m :: * -> *) a. Monad m => a -> m a
return [(Vertex, Vertex)]
es
f [(Vertex, Vertex)]
es ((Vertex, DepInfo)
x : [(Vertex, DepInfo)]
xs) = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Vertex, DepInfo)
-> (Vertex, DepInfo)
-> State (Map (Vertex, Vertex) Ordering) (Maybe (Vertex, Vertex))
toEdge (Vertex, DepInfo)
x) [(Vertex, DepInfo)]
xs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Maybe (Vertex, Vertex)]
es' -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [Maybe a] -> [a]
catMaybes [Maybe (Vertex, Vertex)]
es' forall a. [a] -> [a] -> [a]
++ [(Vertex, Vertex)]
es)
toEdge :: (Int, DepInfo) -> (Int, DepInfo) -> State (Map.Map (Int, Int) Ordering) (Maybe Edge)
toEdge :: (Vertex, DepInfo)
-> (Vertex, DepInfo)
-> State (Map (Vertex, Vertex) Ordering) (Maybe (Vertex, Vertex))
toEdge (Vertex
xv, DepInfo
xa) (Vertex
yv, DepInfo
ya) = do
Map (Vertex, Vertex) Ordering
mp <- forall s (m :: * -> *). MonadState s m => m s
get
Ordering
r <- case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Vertex
xv, Vertex
yv) Map (Vertex, Vertex) Ordering
mp of
Just Ordering
r' -> forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
r'
Maybe Ordering
Nothing -> do
let r' :: Ordering
r' = DepInfo -> DepInfo -> Ordering
compareSource DepInfo
xa DepInfo
ya
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Vertex
xv, Vertex
yv) Ordering
r')
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
r'
case Ordering
r of
Ordering
EQ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Ordering
LT -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Vertex
yv, Vertex
xv)
Ordering
GT -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Vertex
xv, Vertex
yv)
#endif
ofEdge :: Edge -> (a, a)
ofEdge :: (Vertex, Vertex) -> (a, a)
ofEdge (Vertex
a, Vertex
b) = (Vertex -> a
ofVertex Vertex
a, Vertex -> a
ofVertex Vertex
b)
ofVertex :: Int -> a
ofVertex :: Vertex -> a
ofVertex Vertex
n = forall a. HasCallStack => Maybe a -> a
fromJust (forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Maybe a
Nothing Vertex
n (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip [Vertex
0..] (forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just [a]
packages))))
verts :: [Int]
verts :: [Vertex]
verts = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Vertex, DepInfo)]
vertPairs
vertPairs :: [(Int, DepInfo)]
vertPairs :: [(Vertex, DepInfo)]
vertPairs = forall a b. [a] -> [b] -> [(a, b)]
zip [Vertex
0..] forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map a -> DepInfo
relax [a]
packages
allCycles :: Graph -> [[Edge]]
allCycles :: Graph -> [[(Vertex, Vertex)]]
allCycles Graph
g =
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree Vertex -> [[(Vertex, Vertex)]]
sccCycles (Graph -> Forest Vertex
scc Graph
g)
where
sccCycles :: Tree Vertex -> [[Edge]]
sccCycles :: Tree Vertex -> [[(Vertex, Vertex)]]
sccCycles Tree Vertex
t = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Vertex] -> Maybe [(Vertex, Vertex)]
addBackEdge (forall a. Tree a -> [[a]]
treePaths Tree Vertex
t)
addBackEdge :: [Vertex] -> Maybe [Edge]
addBackEdge :: [Vertex] -> Maybe [(Vertex, Vertex)]
addBackEdge path :: [Vertex]
path@(Vertex
root : [Vertex]
_) =
let back :: (Vertex, Vertex)
back = (forall a. [a] -> a
last [Vertex]
path, Vertex
root) in
if forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Vertex, Vertex)
back (Graph -> [(Vertex, Vertex)]
edges Graph
g) then forall a. a -> Maybe a
Just (forall a. [a] -> [(a, a)]
pathEdges ([Vertex]
path forall a. [a] -> [a] -> [a]
++ [Vertex
root])) else forall a. Maybe a
Nothing
treePaths :: Tree a -> [[a]]
treePaths :: forall a. Tree a -> [[a]]
treePaths (Node {rootLabel :: forall a. Tree a -> a
rootLabel = a
r, subForest :: forall a. Tree a -> [Tree a]
subForest = []}) = [[a
r]]
treePaths (Node {rootLabel :: forall a. Tree a -> a
rootLabel = a
r, subForest :: forall a. Tree a -> [Tree a]
subForest = [Tree a]
ts}) = forall a b. (a -> b) -> [a] -> [b]
map (a
r forall a. a -> [a] -> [a]
:) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Tree a -> [[a]]
treePaths [Tree a]
ts)
pathEdges :: [a] -> [(a, a)]
pathEdges :: forall a. [a] -> [(a, a)]
pathEdges (a
v1 : a
v2 : [a]
vs) = (a
v1, a
v2) forall a. a -> [a] -> [a]
: forall a. [a] -> [(a, a)]
pathEdges (a
v2 forall a. a -> [a] -> [a]
: [a]
vs)
pathEdges [a]
_ = []
failPackage :: Eq a => (a -> a -> Ordering) -> a -> [a] -> ([a], [a])
failPackage :: forall a. Eq a => (a -> a -> Ordering) -> a -> [a] -> ([a], [a])
failPackage a -> a -> Ordering
cmp a
failed [a]
packages =
let graph :: Graph
graph = forall a. (a -> a -> Ordering) -> [a] -> Graph
buildGraph a -> a -> Ordering
cmp [a]
packages in
let root :: Maybe Vertex
root = forall a. Eq a => a -> [a] -> Maybe Vertex
elemIndex a
failed [a]
packages in
let victims :: [a]
victims = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a b. (a -> b) -> [a] -> [b]
map (forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex -> Maybe a
vertex) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> Vertex -> [Vertex]
reachable Graph
graph) Maybe Vertex
root in
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\ a
x -> Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
x forall a b. (a -> b) -> a -> b
$ [a]
victims) [a]
packages
where
vertex :: Vertex -> Maybe a
vertex Vertex
n = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Maybe a
Nothing Vertex
n Map Vertex (Maybe a)
vertexMap
vertexMap :: Map Vertex (Maybe a)
vertexMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip [Vertex
0..] (forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just [a]
packages))
orderSource :: (a -> a -> Ordering) -> [a] -> [a]
orderSource :: forall a. (a -> a -> Ordering) -> [a] -> [a]
orderSource a -> a -> Ordering
cmp [a]
packages =
forall a b. (a -> b) -> [a] -> [b]
map (forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex -> Maybe a
vertex) (Graph -> [Vertex]
topSort Graph
graph)
where
graph :: Graph
graph = forall a. (a -> a -> Ordering) -> [a] -> Graph
buildGraph a -> a -> Ordering
cmp [a]
packages
vertex :: Vertex -> Maybe a
vertex Vertex
n = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Maybe a
Nothing Vertex
n Map Vertex (Maybe a)
vertexMap
vertexMap :: Map Vertex (Maybe a)
vertexMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip [Vertex
0..] (forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just [a]
packages))
buildGraph :: (a -> a -> Ordering) -> [a] -> Graph
buildGraph :: forall a. (a -> a -> Ordering) -> [a] -> Graph
buildGraph a -> a -> Ordering
cmp [a]
packages =
let es :: [(Vertex, Vertex)]
es = forall {a}. [(a, a)] -> [(a, a)]
someEdges (forall a b. [a] -> [b] -> [(a, b)]
zip [a]
packages [Vertex
0..]) in
(Vertex, Vertex) -> [(Vertex, Vertex)] -> Graph
buildG (Vertex
0, forall (t :: * -> *) a. Foldable t => t a -> Vertex
length [a]
packages forall a. Num a => a -> a -> a
- Vertex
1) [(Vertex, Vertex)]
es
where
someEdges :: [(a, a)] -> [(a, a)]
someEdges [] = []
someEdges ((a, a)
a : [(a, a)]
etc) = forall {a}. (a, a) -> [(a, a)] -> [(a, a)]
aEdges (a, a)
a [(a, a)]
etc forall a. [a] -> [a] -> [a]
++ [(a, a)] -> [(a, a)]
someEdges [(a, a)]
etc
aEdges :: (a, a) -> [(a, a)] -> [(a, a)]
aEdges (a
ap, a
an) [(a, a)]
etc =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> b) -> [a] -> [b]
map (\ (a
bp, a
bn) ->
case a -> a -> Ordering
cmp a
ap a
bp of
Ordering
LT -> [(a
an, a
bn)]
Ordering
GT -> [(a
bn, a
an)]
Ordering
EQ -> []) [(a, a)]
etc)
compareSource :: DepInfo -> DepInfo -> Ordering
compareSource :: DepInfo -> DepInfo -> Ordering
compareSource DepInfo
p1 DepInfo
p2
#if 0
| any (\rel -> isJust (find (checkPackageNameReq rel) (binaryNames p2))) (concat (relations p1)) = GT
| any (\rel -> isJust (find (checkPackageNameReq rel) (binaryNames p1))) (concat (relations p2)) = LT
| otherwise = EQ
where
checkPackageNameReq :: Relation -> BinPkgName -> Bool
checkPackageNameReq (Rel rPkgName _ _) bPkgName = rPkgName == bPkgName
#else
| Bool -> Bool
not (forall a. Set a -> Bool
Set.null (forall a. Ord a => Set a -> Set a -> Set a
Set.intersection (DepInfo -> Set BinPkgName
depSet DepInfo
p1) (DepInfo -> Set BinPkgName
binSet DepInfo
p2))) = Ordering
GT
| Bool -> Bool
not (forall a. Set a -> Bool
Set.null (forall a. Ord a => Set a -> Set a -> Set a
Set.intersection (DepInfo -> Set BinPkgName
depSet DepInfo
p2) (DepInfo -> Set BinPkgName
binSet DepInfo
p1))) = Ordering
LT
| Bool
otherwise = Ordering
EQ
#endif
compareSource' :: HasDebianControl control => control -> control -> Ordering
compareSource' :: forall control.
HasDebianControl control =>
control -> control -> Ordering
compareSource' control
control1 control
control2
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Relation
rel -> forall a. Maybe a -> Bool
isJust (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Relation -> BinPkgName -> Bool
checkPackageNameReq Relation
rel) [BinPkgName]
bins2)) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Relations
depends1) = Ordering
GT
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Relation
rel -> forall a. Maybe a -> Bool
isJust (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Relation -> BinPkgName -> Bool
checkPackageNameReq Relation
rel) [BinPkgName]
bins1)) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Relations
depends2) = Ordering
LT
| Bool
otherwise = Ordering
EQ
where
bins1 :: [BinPkgName]
bins1 = forall a. HasDebianControl a => a -> [BinPkgName]
binaryNames' control
control1
bins2 :: [BinPkgName]
bins2 = forall a. HasDebianControl a => a -> [BinPkgName]
binaryNames' control
control2
depends1 :: Relations
depends1 = forall control. HasDebianControl control => control -> Relations
relations' control
control1
depends2 :: Relations
depends2 = forall control. HasDebianControl control => control -> Relations
relations' control
control2
checkPackageNameReq :: Relation -> BinPkgName -> Bool
checkPackageNameReq :: Relation -> BinPkgName -> Bool
checkPackageNameReq (Rel BinPkgName
rPkgName Maybe VersionReq
_ Maybe ArchitectureReq
_) BinPkgName
bPkgName = BinPkgName
rPkgName forall a. Eq a => a -> a -> Bool
== BinPkgName
bPkgName
genDeps :: [FilePath] -> IO [DebianControl]
genDeps :: [[Char]] -> IO [DebianControl]
genDeps [[Char]]
controlFiles = do
forall a. (a -> a -> Ordering) -> [a] -> [a]
orderSource forall control.
HasDebianControl control =>
control -> control -> Ordering
compareSource' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> IO DebianControl
genDep' [[Char]]
controlFiles
where
genDep' :: [Char] -> IO DebianControl
genDep' [Char]
controlPath = forall a.
ControlFunctions a =>
[Char] -> IO (Either ParseError (Control' a))
parseControlFromFile [Char]
controlPath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ ParseError
x -> forall a e. Exception e => e -> a
throw ([Loc] -> ParseError -> ControlFileError
ParseRelationsError [$Vertex
[Char]
loc_end :: (Vertex, Vertex)
loc_filename :: [Char]
loc_module :: [Char]
loc_package :: [Char]
loc_start :: (Vertex, Vertex)
__LOC__] ParseError
x))
(\ Control' Text
x -> forall (m :: * -> *).
MonadCatch m =>
Control' Text -> m (Either ControlFileError DebianControl)
validateDebianControl Control' Text
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a e. Exception e => e -> a
throw forall (m :: * -> *) a. Monad m => a -> m a
return)
getSourceOrder :: FilePath -> IO [SrcPkgName]
getSourceOrder :: [Char] -> IO [SrcPkgName]
getSourceOrder [Char]
fp =
[Char] -> IO [[Char]]
findControlFiles [Char]
fp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [[Char]] -> IO [DebianControl]
genDeps forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. HasDebianControl a => a -> SrcPkgName
sourceName'
where
findControlFiles :: FilePath -> IO [FilePath]
findControlFiles :: [Char] -> IO [[Char]]
findControlFiles [Char]
root =
[Char] -> IO [[Char]]
getDirectoryContents [Char]
root forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ [Char]
x -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char]
root forall a. [a] -> [a] -> [a]
++ [Char]
"/" forall a. [a] -> [a] -> [a]
++ [Char]
x forall a. [a] -> [a] -> [a]
++ [Char]
"/debian/control") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [Char] -> IO Bool
doesFileExist