{-# LANGUAGE CPP, FlexibleContexts, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TemplateHaskell #-}
{-# LANGUAGE NoDisambiguateRecordFields, NoRecordWildCards #-}
-- |Figure out the dependency relation between debianized source
-- directories.  The code to actually solve these dependency relations
-- for a particular set of binary packages is in Debian.Repo.Dependency.
module Debian.GenBuildDeps
    ( DepInfo(..)
    , sourceName'
    , relations'
    , binaryNames'
    -- * Preparing dependency info
    , buildDependencies
    , RelaxInfo
    , relaxDeps
    -- * Using dependency info
    , BuildableInfo(..)
    , ReadyTarget(..)
    , buildable
    , compareSource
    -- * Obsolete?
    , 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           Debug.Trace (trace)
import           System.Directory (getDirectoryContents, doesFileExist)

-- | This type describes the build dependencies of a source package.
data DepInfo = DepInfo {
      DepInfo -> SrcPkgName
sourceName :: SrcPkgName          -- ^ source package name
    , DepInfo -> Relations
relations :: Relations            -- ^ dependency relations
    , DepInfo -> [BinPkgName]
binaryNames :: [BinPkgName]       -- ^ binary dependency names (is this a function of relations?)
    , DepInfo -> Set BinPkgName
depSet :: Set.Set BinPkgName          -- ^ Set containing all binary package names mentioned in relations
    , DepInfo -> Set BinPkgName
binSet :: Set.Set BinPkgName          -- ^ Set containing binaryNames
    } 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)

-- |Return the dependency info for a source package with the given dependency relaxation.
-- |According to debian policy, only the first paragraph in debian\/control can be a source package
-- <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-sourcecontrolfiles>
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 }

-- | source package name
sourceName' :: HasDebianControl control => control -> SrcPkgName
sourceName' :: forall a. HasDebianControl a => a -> SrcPkgName
sourceName' control
control = forall a. HasDebianControl a => a -> SrcPkgName
debianSourcePackageName control
control

-- | dependency relations
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)]

-- | binary dependency names (is this a function of relations?)
binaryNames' :: HasDebianControl control => control -> [BinPkgName]
binaryNames' :: forall a. HasDebianControl a => a -> [BinPkgName]
binaryNames' control
control = forall a. HasDebianControl a => a -> [BinPkgName]
debianBinaryPackageNames control
control

-- |Specifies build dependencies that should be ignored during the build
-- decision.  If the pair is (BINARY, Nothing) it means the binary package
-- BINARY should always be ignored when deciding whether to build.  If the
-- pair is (BINARY, Just SOURCE) it means that binary package BINARY should
-- be ignored when deiciding whether to build package SOURCE.
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

-- | Given a source package name and a binary package name, return
-- False if the binary package should be ignored hwen deciding whether
-- to build the source package.  This is used to prevent build
-- dependency cycles from triggering unnecessary rebuilds.  (This is a
-- replacement for the RelaxInfo type, which we temporarily rename
-- OldRelaxInfo.)
type RelaxInfo = SrcPkgName -> BinPkgName -> Bool

-- |Remove any dependencies that are designated \"relaxed\" by relaxInfo.
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
            -- Discard any dependencies not on the filtered package name list.  If
            -- this results in an empty list in an or-dep the entire dependency can
            -- be discarded.
            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
                  -- ^ Some target whose build dependencies are all satisfied
                  , forall a. ReadyTarget a -> [a]
waiting :: [a]
                  -- ^ The targets that are waiting for the ready target
                  , forall a. ReadyTarget a -> [a]
other :: [a]
                  -- ^ The rest of the targets that need to be built
                  }

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)] }

-- | Given an ordering function representing the dependencies on a
-- list of packages, return a ReadyTarget triple: One ready package,
-- the packages that depend on the ready package directly or
-- indirectly, and all the other packages.
buildable :: forall a. (a -> DepInfo) -> [a] -> BuildableInfo a
buildable :: forall a. (a -> DepInfo) -> [a] -> BuildableInfo a
buildable a -> DepInfo
relax [a]
packages =
    -- Find all packages which can't reach any other packages in the
    -- graph of the "has build dependency" relation on the
    -- yet-to-be-built 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
      -- None of the packages are buildable, return information
      -- about how to break this build dependency cycle.
      ([], [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)}
      -- We have some buildable packages, return them along with
      -- the list of packages each one directly blocks
      ([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) }
      --allDeps x = (ofVertex x, List.map ofVertex (filter (/= x) (reachable hasDep x)))
      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
                           -- trace ("compareSource " ++ show (unSrcPkgName $ sourceName xa) ++ " " ++ show (unSrcPkgName $ sourceName ya) ++ " -> " ++ show r') (return ())
                           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

-- | Find a cycle in a graph that involves
allCycles :: Graph -> [[Edge]]
allCycles :: Graph -> [[(Vertex, Vertex)]]
allCycles Graph
g =
    -- Every cycle is confined to an SCC (strongly connected component).
    -- Every node in an SCC is part of some cycle.
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree Vertex -> [[(Vertex, Vertex)]]
sccCycles (Graph -> Forest Vertex
scc Graph
g)
    where
      -- Find all the cycles in an SCC
      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

-- | All the paths from root to a leaf
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]
_ = []

-- | Remove any packages which can't be built given that a package has failed.
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))

-- | Given a list of packages, sort them according to their apparant
-- build dependencies so that the first element doesn't depend on any
-- of the other 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))

-- | Build a graph with the list of packages as its nodes and the
-- build dependencies as its edges.
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)

-- |This is a nice start. It ignores circular build depends and takes
-- a pretty simplistic approach to 'or' build depends. However, I
-- think this should work pretty nicely in practice.
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

-- |Return the dependency info for a list of control files.
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
      -- Parse the control file and extract the build dependencies
      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 {- `mapExn` (pushLoc $__LOC__) -} 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)

-- pushLoc :: Loc -> ControlFileError -> ControlFileError
-- pushLoc loc e = e {locs = loc : locs e}

-- |One example of how to tie the below functions together. In this
-- case 'fp' is the path to a directory that contains a bunch of
-- checked out source packages. The code will automatically look for
-- debian\/control. It returns a list with the packages in the
-- order they should be built.
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
      -- Return a list of the files that look like debian\/control.
      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