{-# 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]
(Vertex -> DepInfo -> ShowS)
-> (DepInfo -> [Char]) -> ([DepInfo] -> ShowS) -> Show DepInfo
forall a.
(Vertex -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Vertex -> DepInfo -> ShowS
showsPrec :: Vertex -> DepInfo -> ShowS
$cshow :: DepInfo -> [Char]
show :: DepInfo -> [Char]
$cshowList :: [DepInfo] -> ShowS
showList :: [DepInfo] -> ShowS
Show

instance Eq DepInfo where
    DepInfo
a == :: DepInfo -> DepInfo -> Bool
== DepInfo
b = (DepInfo -> SrcPkgName
sourceName DepInfo
a SrcPkgName -> SrcPkgName -> Bool
forall a. Eq a => a -> a -> Bool
== DepInfo -> SrcPkgName
sourceName DepInfo
b) Bool -> Bool -> Bool
&&
             [Set Relation] -> Set (Set Relation)
forall a. Ord a => [a] -> Set a
Set.fromList ((OrRelation -> Set Relation) -> Relations -> [Set Relation]
forall a b. (a -> b) -> [a] -> [b]
map OrRelation -> Set Relation
forall a. Ord a => [a] -> Set a
Set.fromList (DepInfo -> Relations
relations DepInfo
a)) Set (Set Relation) -> Set (Set Relation) -> Bool
forall a. Eq a => a -> a -> Bool
== [Set Relation] -> Set (Set Relation)
forall a. Ord a => [a] -> Set a
Set.fromList ((OrRelation -> Set Relation) -> Relations -> [Set Relation]
forall a b. (a -> b) -> [a] -> [b]
map OrRelation -> Set Relation
forall a. Ord a => [a] -> Set a
Set.fromList (DepInfo -> Relations
relations DepInfo
b)) Bool -> Bool -> Bool
&&
             [BinPkgName] -> Set BinPkgName
forall a. Ord a => [a] -> Set a
Set.fromList (DepInfo -> [BinPkgName]
binaryNames DepInfo
a) Set BinPkgName -> Set BinPkgName -> Bool
forall a. Eq a => a -> a -> Bool
== [BinPkgName] -> Set BinPkgName
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 = [Relations] -> Relations
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Relations -> Maybe Relations -> Relations
forall a. a -> Maybe a -> a
fromMaybe [] (control -> Maybe Relations
forall a. HasDebianControl a => a -> Maybe Relations
debianBuildDeps control
control),
                     Relations -> Maybe Relations -> Relations
forall a. a -> Maybe a -> a
fromMaybe [] (control -> Maybe Relations
forall a. HasDebianControl a => a -> Maybe Relations
debianBuildDepsIndep control
control)]
      bins :: [BinPkgName]
bins = control -> [BinPkgName]
forall a. HasDebianControl a => a -> [BinPkgName]
debianBinaryPackageNames control
control
  DepInfo { sourceName :: SrcPkgName
sourceName = control -> SrcPkgName
forall a. HasDebianControl a => a -> SrcPkgName
debianSourcePackageName control
control
          , relations :: Relations
relations = Relations
rels
          , binaryNames :: [BinPkgName]
binaryNames = [BinPkgName]
bins
          , depSet :: Set BinPkgName
depSet = [BinPkgName] -> Set BinPkgName
forall a. Ord a => [a] -> Set a
Set.fromList ((Relation -> BinPkgName) -> OrRelation -> [BinPkgName]
forall a b. (a -> b) -> [a] -> [b]
List.map (\(Rel BinPkgName
x Maybe VersionReq
_ Maybe ArchitectureReq
_) -> BinPkgName
x) (Relations -> OrRelation
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Relations
rels))
          , binSet :: Set BinPkgName
binSet = [BinPkgName] -> Set BinPkgName
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 = control -> SrcPkgName
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 = [Relations] -> Relations
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Relations -> Maybe Relations -> Relations
forall a. a -> Maybe a -> a
fromMaybe [] (control -> Maybe Relations
forall a. HasDebianControl a => a -> Maybe Relations
debianBuildDeps control
control),
                            Relations -> Maybe Relations -> Relations
forall a. a -> Maybe a -> a
fromMaybe [] (control -> Maybe Relations
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 = control -> [BinPkgName]
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]
(Vertex -> OldRelaxInfo -> ShowS)
-> (OldRelaxInfo -> [Char])
-> ([OldRelaxInfo] -> ShowS)
-> Show OldRelaxInfo
forall a.
(Vertex -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Vertex -> OldRelaxInfo -> ShowS
showsPrec :: Vertex -> OldRelaxInfo -> ShowS
$cshow :: OldRelaxInfo -> [Char]
show :: OldRelaxInfo -> [Char]
$cshowList :: [OldRelaxInfo] -> ShowS
showList :: [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 =
    (DepInfo -> DepInfo) -> [DepInfo] -> [DepInfo]
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 = (OrRelation -> Bool) -> Relations -> Relations
forall a. (a -> Bool) -> [a] -> [a]
filter (OrRelation -> OrRelation -> Bool
forall a. Eq a => a -> a -> Bool
/= []) ((OrRelation -> OrRelation) -> Relations -> Relations
forall a b. (a -> b) -> [a] -> [b]
List.map ((Relation -> Bool) -> OrRelation -> OrRelation
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 (Vertex -> Bool) -> [Vertex] -> ([Vertex], [Vertex])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\ Vertex
x -> Graph -> Vertex -> [Vertex]
reachable Graph
hasDep Vertex
x [Vertex] -> [Vertex] -> Bool
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 = ((Vertex, Vertex) -> (a, a)) -> [(Vertex, Vertex)] -> [(a, a)]
forall a b. (a -> b) -> [a] -> [b]
List.map (Vertex, Vertex) -> (a, a)
ofEdge ([(Vertex, Vertex)] -> [(a, a)]) -> [(Vertex, Vertex)] -> [(a, a)]
forall a b. (a -> b) -> a -> b
$ [[(Vertex, Vertex)]] -> [(Vertex, Vertex)]
forall a. HasCallStack => [a] -> a
head ([[(Vertex, Vertex)]] -> [(Vertex, Vertex)])
-> [[(Vertex, Vertex)]] -> [(Vertex, Vertex)]
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 = (Vertex -> ReadyTarget a) -> [Vertex] -> [ReadyTarget a]
forall a b. (a -> b) -> [a] -> [b]
List.map ([Vertex] -> [Vertex] -> Vertex -> ReadyTarget a
makeReady [Vertex]
blocked [Vertex]
allReady) [Vertex]
allReady
                        , allBlocked :: [a]
allBlocked = (Vertex -> a) -> [Vertex] -> [a]
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 = (Vertex -> Bool) -> [Vertex] -> [Vertex]
forall a. (a -> Bool) -> [a] -> [a]
filter (Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
/= Vertex
thisReady) [Vertex]
ready
              ([Vertex]
directlyBlocked, [Vertex]
otherBlocked) = (Vertex -> Bool) -> [Vertex] -> ([Vertex], [Vertex])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\ Vertex
x -> Vertex -> [Vertex] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 = (Vertex -> a) -> [Vertex] -> [a]
forall a b. (a -> b) -> [a] -> [b]
List.map Vertex -> a
ofVertex [Vertex]
directlyBlocked
                      , other :: [a]
other = (Vertex -> a) -> [Vertex] -> [a]
forall a b. (a -> b) -> [a] -> [b]
List.map Vertex -> a
ofVertex ([Vertex]
otherReady [Vertex] -> [Vertex] -> [Vertex]
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, [a] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length [a]
packages Vertex -> Vertex -> Vertex
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
          [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. Eq a => [a] -> [a]
nub (State (Map (Vertex, Vertex) Ordering) [(Vertex, Vertex)]
-> Map (Vertex, Vertex) Ordering -> [(Vertex, Vertex)]
forall s a. State s a -> s -> a
evalState (([(Vertex, Vertex)]
 -> [(Vertex, DepInfo)]
 -> State (Map (Vertex, Vertex) Ordering) [(Vertex, Vertex)])
-> [(Vertex, Vertex)]
-> [[(Vertex, DepInfo)]]
-> State (Map (Vertex, Vertex) Ordering) [(Vertex, Vertex)]
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 [] ([(Vertex, DepInfo)] -> [[(Vertex, DepInfo)]]
forall a. [a] -> [[a]]
tails [(Vertex, DepInfo)]
vertPairs)) Map (Vertex, Vertex) Ordering
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 [] = [(Vertex, Vertex)]
-> State (Map (Vertex, Vertex) Ordering) [(Vertex, Vertex)]
forall a. a -> StateT (Map (Vertex, Vertex) Ordering) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Vertex, Vertex)]
es
                f [(Vertex, Vertex)]
es ((Vertex, DepInfo)
x : [(Vertex, DepInfo)]
xs) = ((Vertex, DepInfo)
 -> StateT
      (Map (Vertex, Vertex) Ordering) Identity (Maybe (Vertex, Vertex)))
-> [(Vertex, DepInfo)]
-> StateT
     (Map (Vertex, Vertex) Ordering) Identity [Maybe (Vertex, Vertex)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Vertex, DepInfo)
-> (Vertex, DepInfo)
-> StateT
     (Map (Vertex, Vertex) Ordering) Identity (Maybe (Vertex, Vertex))
toEdge (Vertex, DepInfo)
x) [(Vertex, DepInfo)]
xs StateT
  (Map (Vertex, Vertex) Ordering) Identity [Maybe (Vertex, Vertex)]
-> ([Maybe (Vertex, Vertex)]
    -> State (Map (Vertex, Vertex) Ordering) [(Vertex, Vertex)])
-> State (Map (Vertex, Vertex) Ordering) [(Vertex, Vertex)]
forall a b.
StateT (Map (Vertex, Vertex) Ordering) Identity a
-> (a -> StateT (Map (Vertex, Vertex) Ordering) Identity b)
-> StateT (Map (Vertex, Vertex) Ordering) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Maybe (Vertex, Vertex)]
es' -> [(Vertex, Vertex)]
-> State (Map (Vertex, Vertex) Ordering) [(Vertex, Vertex)]
forall a. a -> StateT (Map (Vertex, Vertex) Ordering) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe (Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Vertex, Vertex)]
es' [(Vertex, Vertex)] -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
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)
-> StateT
     (Map (Vertex, Vertex) Ordering) Identity (Maybe (Vertex, Vertex))
toEdge (Vertex
xv, DepInfo
xa) (Vertex
yv, DepInfo
ya) = do
                  Map (Vertex, Vertex) Ordering
mp <- StateT
  (Map (Vertex, Vertex) Ordering)
  Identity
  (Map (Vertex, Vertex) Ordering)
forall s (m :: * -> *). MonadState s m => m s
get
                  Ordering
r <- case (Vertex, Vertex) -> Map (Vertex, Vertex) Ordering -> Maybe Ordering
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' -> Ordering
-> StateT (Map (Vertex, Vertex) Ordering) Identity Ordering
forall a. a -> StateT (Map (Vertex, Vertex) Ordering) Identity a
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 ())
                           (Map (Vertex, Vertex) Ordering -> Map (Vertex, Vertex) Ordering)
-> StateT (Map (Vertex, Vertex) Ordering) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Vertex, Vertex)
-> Ordering
-> Map (Vertex, Vertex) Ordering
-> Map (Vertex, Vertex) Ordering
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Vertex
xv, Vertex
yv) Ordering
r')
                           Ordering
-> StateT (Map (Vertex, Vertex) Ordering) Identity Ordering
forall a. a -> StateT (Map (Vertex, Vertex) Ordering) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
r'
                  case Ordering
r of
                    Ordering
EQ -> Maybe (Vertex, Vertex)
-> StateT
     (Map (Vertex, Vertex) Ordering) Identity (Maybe (Vertex, Vertex))
forall a. a -> StateT (Map (Vertex, Vertex) Ordering) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Vertex, Vertex)
forall a. Maybe a
Nothing
                    Ordering
LT -> Maybe (Vertex, Vertex)
-> StateT
     (Map (Vertex, Vertex) Ordering) Identity (Maybe (Vertex, Vertex))
forall a. a -> StateT (Map (Vertex, Vertex) Ordering) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Vertex, Vertex)
 -> StateT
      (Map (Vertex, Vertex) Ordering) Identity (Maybe (Vertex, Vertex)))
-> Maybe (Vertex, Vertex)
-> StateT
     (Map (Vertex, Vertex) Ordering) Identity (Maybe (Vertex, Vertex))
forall a b. (a -> b) -> a -> b
$ (Vertex, Vertex) -> Maybe (Vertex, Vertex)
forall a. a -> Maybe a
Just (Vertex
yv, Vertex
xv)
                    Ordering
GT -> Maybe (Vertex, Vertex)
-> StateT
     (Map (Vertex, Vertex) Ordering) Identity (Maybe (Vertex, Vertex))
forall a. a -> StateT (Map (Vertex, Vertex) Ordering) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Vertex, Vertex)
 -> StateT
      (Map (Vertex, Vertex) Ordering) Identity (Maybe (Vertex, Vertex)))
-> Maybe (Vertex, Vertex)
-> StateT
     (Map (Vertex, Vertex) Ordering) Identity (Maybe (Vertex, Vertex))
forall a b. (a -> b) -> a -> b
$ (Vertex, Vertex) -> Maybe (Vertex, Vertex)
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 = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> Vertex -> Map Vertex (Maybe a) -> Maybe a
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Maybe a
forall a. Maybe a
Nothing Vertex
n ([(Vertex, Maybe a)] -> Map Vertex (Maybe a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Vertex] -> [Maybe a] -> [(Vertex, Maybe a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Vertex
0..] ((a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
forall a. a -> Maybe a
Just [a]
packages))))
      verts :: [Int]
      verts :: [Vertex]
verts = ((Vertex, DepInfo) -> Vertex) -> [(Vertex, DepInfo)] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map (Vertex, DepInfo) -> Vertex
forall a b. (a, b) -> a
fst [(Vertex, DepInfo)]
vertPairs
      vertPairs :: [(Int, DepInfo)]
      vertPairs :: [(Vertex, DepInfo)]
vertPairs = [Vertex] -> [DepInfo] -> [(Vertex, DepInfo)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Vertex
0..] ([DepInfo] -> [(Vertex, DepInfo)])
-> [DepInfo] -> [(Vertex, DepInfo)]
forall a b. (a -> b) -> a -> b
$ (a -> DepInfo) -> [a] -> [DepInfo]
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.
    (Tree Vertex -> [[(Vertex, Vertex)]])
-> [Tree Vertex] -> [[(Vertex, Vertex)]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree Vertex -> [[(Vertex, Vertex)]]
sccCycles (Graph -> [Tree 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 = ([Vertex] -> Maybe [(Vertex, Vertex)])
-> [[Vertex]] -> [[(Vertex, Vertex)]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Vertex] -> Maybe [(Vertex, Vertex)]
addBackEdge (Tree Vertex -> [[Vertex]]
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 = ([Vertex] -> Vertex
forall a. HasCallStack => [a] -> a
last [Vertex]
path, Vertex
root) in
          if (Vertex, Vertex) -> [(Vertex, Vertex)] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Vertex, Vertex)
back (Graph -> [(Vertex, Vertex)]
edges Graph
g) then [(Vertex, Vertex)] -> Maybe [(Vertex, Vertex)]
forall a. a -> Maybe a
Just ([Vertex] -> [(Vertex, Vertex)]
forall a. [a] -> [(a, a)]
pathEdges ([Vertex]
path [Vertex] -> [Vertex] -> [Vertex]
forall a. [a] -> [a] -> [a]
++ [Vertex
root])) else Maybe [(Vertex, Vertex)]
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}) = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
r a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ((Tree a -> [[a]]) -> [Tree a] -> [[a]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree a -> [[a]]
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) (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
: [a] -> [(a, a)]
forall a. [a] -> [(a, a)]
pathEdges (a
v2 a -> [a] -> [a]
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 = (a -> a -> Ordering) -> [a] -> Graph
forall a. (a -> a -> Ordering) -> [a] -> Graph
buildGraph a -> a -> Ordering
cmp [a]
packages in
    let root :: Maybe Vertex
root = a -> [a] -> Maybe Vertex
forall a. Eq a => a -> [a] -> Maybe Vertex
elemIndex a
failed [a]
packages in
    let victims :: [a]
victims = [a] -> (Vertex -> [a]) -> Maybe Vertex -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Vertex -> a) -> [Vertex] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (Vertex -> Maybe a) -> Vertex -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex -> Maybe a
vertex) ([Vertex] -> [a]) -> (Vertex -> [Vertex]) -> Vertex -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> Vertex -> [Vertex]
reachable Graph
graph) Maybe Vertex
root in
    (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\ a
x -> Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
x ([a] -> Bool) -> [a] -> Bool
forall a b. (a -> b) -> a -> b
$ [a]
victims) [a]
packages
    where
      vertex :: Vertex -> Maybe a
vertex Vertex
n = Maybe a -> Vertex -> Map Vertex (Maybe a) -> Maybe a
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Maybe a
forall a. Maybe a
Nothing Vertex
n Map Vertex (Maybe a)
vertexMap
      vertexMap :: Map Vertex (Maybe a)
vertexMap = [(Vertex, Maybe a)] -> Map Vertex (Maybe a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Vertex] -> [Maybe a] -> [(Vertex, Maybe a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Vertex
0..] ((a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
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 =
    (Vertex -> a) -> [Vertex] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (Vertex -> Maybe a) -> Vertex -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex -> Maybe a
vertex) (Graph -> [Vertex]
topSort Graph
graph)
    where
      graph :: Graph
graph = (a -> a -> Ordering) -> [a] -> Graph
forall a. (a -> a -> Ordering) -> [a] -> Graph
buildGraph a -> a -> Ordering
cmp [a]
packages
      vertex :: Vertex -> Maybe a
vertex Vertex
n = Maybe a -> Vertex -> Map Vertex (Maybe a) -> Maybe a
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Maybe a
forall a. Maybe a
Nothing Vertex
n Map Vertex (Maybe a)
vertexMap
      vertexMap :: Map Vertex (Maybe a)
vertexMap = [(Vertex, Maybe a)] -> Map Vertex (Maybe a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Vertex] -> [Maybe a] -> [(Vertex, Maybe a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Vertex
0..] ((a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
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 = [(a, Vertex)] -> [(Vertex, Vertex)]
forall {a}. [(a, a)] -> [(a, a)]
someEdges ([a] -> [Vertex] -> [(a, Vertex)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
packages [Vertex
0..]) in
    (Vertex, Vertex) -> [(Vertex, Vertex)] -> Graph
buildG (Vertex
0, [a] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length [a]
packages Vertex -> Vertex -> Vertex
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) = (a, a) -> [(a, a)] -> [(a, a)]
forall {a}. (a, a) -> [(a, a)] -> [(a, a)]
aEdges (a, a)
a [(a, a)]
etc [(a, a)] -> [(a, a)] -> [(a, a)]
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 =
          [[(a, a)]] -> [(a, a)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (((a, a) -> [(a, a)]) -> [(a, a)] -> [[(a, a)]]
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 (Set BinPkgName -> Bool
forall a. Set a -> Bool
Set.null (Set BinPkgName -> Set BinPkgName -> Set BinPkgName
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 (Set BinPkgName -> Bool
forall a. Set a -> Bool
Set.null (Set BinPkgName -> Set BinPkgName -> Set BinPkgName
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
    | (Relation -> Bool) -> OrRelation -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Relation
rel -> Maybe BinPkgName -> Bool
forall a. Maybe a -> Bool
isJust ((BinPkgName -> Bool) -> [BinPkgName] -> Maybe BinPkgName
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Relation -> BinPkgName -> Bool
checkPackageNameReq Relation
rel) [BinPkgName]
bins2)) (Relations -> OrRelation
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Relations
depends1) = Ordering
GT
    | (Relation -> Bool) -> OrRelation -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Relation
rel -> Maybe BinPkgName -> Bool
forall a. Maybe a -> Bool
isJust ((BinPkgName -> Bool) -> [BinPkgName] -> Maybe BinPkgName
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Relation -> BinPkgName -> Bool
checkPackageNameReq Relation
rel) [BinPkgName]
bins1)) (Relations -> OrRelation
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Relations
depends2) = Ordering
LT
    | Bool
otherwise = Ordering
EQ
    where
      bins1 :: [BinPkgName]
bins1 = control -> [BinPkgName]
forall a. HasDebianControl a => a -> [BinPkgName]
binaryNames' control
control1
      bins2 :: [BinPkgName]
bins2 = control -> [BinPkgName]
forall a. HasDebianControl a => a -> [BinPkgName]
binaryNames' control
control2
      depends1 :: Relations
depends1 = control -> Relations
forall control. HasDebianControl control => control -> Relations
relations' control
control1
      depends2 :: Relations
depends2 = control -> Relations
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 BinPkgName -> BinPkgName -> Bool
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
  (DebianControl -> DebianControl -> Ordering)
-> [DebianControl] -> [DebianControl]
forall a. (a -> a -> Ordering) -> [a] -> [a]
orderSource DebianControl -> DebianControl -> Ordering
forall control.
HasDebianControl control =>
control -> control -> Ordering
compareSource' ([DebianControl] -> [DebianControl])
-> IO [DebianControl] -> IO [DebianControl]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> IO DebianControl) -> [[Char]] -> IO [DebianControl]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 = [Char] -> IO (Either ParseError (Control' Text))
forall a.
ControlFunctions a =>
[Char] -> IO (Either ParseError (Control' a))
parseControlFromFile [Char]
controlPath IO (Either ParseError (Control' Text))
-> (Either ParseError (Control' Text) -> IO DebianControl)
-> IO DebianControl
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                            (ParseError -> IO DebianControl)
-> (Control' Text -> IO DebianControl)
-> Either ParseError (Control' Text)
-> IO DebianControl
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ ParseError
x -> ControlFileError -> IO DebianControl
forall a e. Exception e => e -> a
throw ([Loc] -> ParseError -> ControlFileError
ParseRelationsError [$Vertex
[Char]
[Char]
-> [Char] -> [Char] -> (Vertex, Vertex) -> (Vertex, Vertex) -> Loc
loc_filename :: [Char]
loc_package :: [Char]
loc_module :: [Char]
loc_start :: (Vertex, Vertex)
loc_end :: (Vertex, Vertex)
__LOC__] ParseError
x))
                                   (\ Control' Text
x -> Control' Text -> IO (Either ControlFileError DebianControl)
forall (m :: * -> *).
MonadCatch m =>
Control' Text -> m (Either ControlFileError DebianControl)
validateDebianControl Control' Text
x {- `mapExn` (pushLoc $__LOC__) -} IO (Either ControlFileError DebianControl)
-> (Either ControlFileError DebianControl -> IO DebianControl)
-> IO DebianControl
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ControlFileError -> IO DebianControl)
-> (DebianControl -> IO DebianControl)
-> Either ControlFileError DebianControl
-> IO DebianControl
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ControlFileError -> IO DebianControl
forall a e. Exception e => e -> a
throw DebianControl -> IO DebianControl
forall a. a -> IO a
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 IO [[Char]]
-> ([[Char]] -> IO [DebianControl]) -> IO [DebianControl]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [[Char]] -> IO [DebianControl]
genDeps IO [DebianControl]
-> ([DebianControl] -> IO [SrcPkgName]) -> IO [SrcPkgName]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [SrcPkgName] -> IO [SrcPkgName]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SrcPkgName] -> IO [SrcPkgName])
-> ([DebianControl] -> [SrcPkgName])
-> [DebianControl]
-> IO [SrcPkgName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DebianControl -> SrcPkgName) -> [DebianControl] -> [SrcPkgName]
forall a b. (a -> b) -> [a] -> [b]
map DebianControl -> SrcPkgName
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 IO [[Char]] -> ([[Char]] -> IO [[Char]]) -> IO [[Char]]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          ([Char] -> IO [Char]) -> [[Char]] -> IO [[Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\ [Char]
x -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
root [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"/" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"/debian/control") IO [[Char]] -> ([[Char]] -> IO [[Char]]) -> IO [[Char]]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [Char] -> IO Bool
doesFileExist