{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

{-|
This module provides simple dependency graph making for rpm packages:

@
import "Distribution.RPM.Build.Graph"

graph <- 'createGraph' ["pkg1", "pkg2", "../pkg3"]
@
-}

module Distribution.RPM.Build.Graph
  (PackageGraph,
   createGraph,
   createGraphRpmOpts,
   createGraph',
   createGraph'',
   createGraph''',
   createGraph'''',
   dependencyNodes,
   subgraph',
   packageLayers,
   lowestLayer,
   lowestLayer',
   packageLeaves,
   separatePackages,
   printGraph,
   renderGraph
  ) where

import qualified Data.CaseInsensitive as CI
import Data.Graph.Inductive.Query.DFS (scc, xdfsWith)
import Data.Graph.Inductive.Query.SP (sp)
import Data.Graph.Inductive.PatriciaTree (Gr)
import qualified Data.Graph.Inductive.Graph as G

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Monad (forM_, guard, when, unless)
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
import Data.List.Extra (dropSuffix, find, intercalate, nub, nubOrdOn, sort, sortOn)
import Data.GraphViz
import System.Directory (doesDirectoryExist, doesFileExist,
#if MIN_VERSION_directory(1,2,5)
                         listDirectory
#else
                         getDirectoryContents
#endif
                        )
import System.Exit (ExitCode (..), exitFailure)
import System.FilePath
-- replace with warning
import System.IO (hPutStrLn, stderr)
import System.Process (readProcessWithExitCode)

#if !MIN_VERSION_directory(1,2,5)
listDirectory :: FilePath -> IO [FilePath]
listDirectory path =
  filter f <$> getDirectoryContents path
  where f filename = filename /= "." && filename /= ".."
#endif

data SourcePackage =
  SourcePackage {
    SourcePackage -> FilePath
packagePath :: FilePath,
    SourcePackage -> [FilePath]
dependencies :: [FilePath]
   }
   deriving SourcePackage -> SourcePackage -> Bool
(SourcePackage -> SourcePackage -> Bool)
-> (SourcePackage -> SourcePackage -> Bool) -> Eq SourcePackage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourcePackage -> SourcePackage -> Bool
$c/= :: SourcePackage -> SourcePackage -> Bool
== :: SourcePackage -> SourcePackage -> Bool
$c== :: SourcePackage -> SourcePackage -> Bool
Eq

-- | alias for a package dependency graph
type PackageGraph = Gr FilePath ()

-- | Get all of the dependencies of a subset of one or more packages within full PackageGraph.
-- The subset paths should be written in the same way as for the graph.
dependencyNodes :: [FilePath] -- ^ subset of packages to start from
                -> PackageGraph -- ^ dependency graph
                -> [FilePath] -- ^ dependencies of subset
dependencyNodes :: [FilePath] -> PackageGraph -> [FilePath]
dependencyNodes [FilePath]
subset PackageGraph
graph =
  let nodes :: [LNode FilePath]
nodes = PackageGraph -> [LNode FilePath]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
G.labNodes PackageGraph
graph
      subnodes :: [Int]
subnodes = (FilePath -> Maybe Int) -> [FilePath] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([LNode FilePath] -> FilePath -> Maybe Int
pkgNode [LNode FilePath]
nodes) [FilePath]
subset
  in CFun FilePath () [Int]
-> CFun FilePath () FilePath -> [Int] -> PackageGraph -> [FilePath]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Int] -> CFun a b c -> [Int] -> gr a b -> [c]
xdfsWith CFun FilePath () [Int]
forall a b. Context a b -> [Int]
G.pre' CFun FilePath () FilePath
forall a b c d. (a, b, c, d) -> c
third [Int]
subnodes PackageGraph
graph
  where
    pkgNode :: [G.LNode FilePath] -> FilePath -> Maybe Int
    pkgNode :: [LNode FilePath] -> FilePath -> Maybe Int
pkgNode [] FilePath
_ = Maybe Int
forall a. Maybe a
Nothing
    pkgNode ((Int
i,FilePath
l):[LNode FilePath]
ns) FilePath
p = if FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a]
dropSuffix FilePath
"/" FilePath
p FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a]
dropSuffix FilePath
"/" FilePath
l then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i else [LNode FilePath] -> FilePath -> Maybe Int
pkgNode [LNode FilePath]
ns FilePath
p

    third :: (a, b, c, d) -> c
third (a
_, b
_, c
c, d
_) = c
c

-- | Create a directed dependency graph for a set of packages
-- This is a convenience wrapper for createGraph' False False True Nothing
createGraph :: [FilePath] -- ^ package paths (directories or spec filepaths)
            -> IO PackageGraph -- ^ dependency graph labelled by package paths
createGraph :: [FilePath] -> IO PackageGraph
createGraph = Bool
-> Bool -> Bool -> Maybe FilePath -> [FilePath] -> IO PackageGraph
createGraph' Bool
False Bool
False Bool
True Maybe FilePath
forall a. Maybe a
Nothing

-- | Create a directed dependency graph for a set of packages setting rpm options
-- This is a convenience wrapper for @createGraph'' rpmopts False False True Nothing@
--
-- @since 0.4.2
createGraphRpmOpts :: [String] -- ^ rpmspec options
                   -> [FilePath] -- ^ package paths (directories or spec filepaths)
                   -> IO PackageGraph -- ^ dependency graph labelled by package paths
createGraphRpmOpts :: [FilePath] -> [FilePath] -> IO PackageGraph
createGraphRpmOpts [FilePath]
rpmopts =
  [FilePath]
-> Bool
-> Bool
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
createGraph'' [FilePath]
rpmopts Bool
False Bool
False Bool
True Maybe FilePath
forall a. Maybe a
Nothing

-- | Create a directed dependency graph for a set of packages
-- For the (createGraph default) reverse deps graph the arrows point back
-- from the dependencies to the dependendent (parent/consumer) packages,
-- and this allows forward sorting by dependencies (ie lowest deps first).
--
-- This is the same as @createGraph'' []@
createGraph' :: Bool -- ^ verbose
             -> Bool -- ^ lenient (skip rpmspec failures)
             -> Bool -- ^ reverse dependency graph
             -> Maybe FilePath -- ^ look for spec file in a subdirectory
             -> [FilePath] -- ^ package paths (directories or spec filepaths)
             -> IO PackageGraph -- ^ dependency graph labelled by package paths
createGraph' :: Bool
-> Bool -> Bool -> Maybe FilePath -> [FilePath] -> IO PackageGraph
createGraph' = [FilePath]
-> Bool
-> Bool
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
createGraph'' []

-- | Create a directed dependency graph for a set of packages
-- For the (createGraph default) reverse deps graph the arrows point back
-- from the dependencies to the dependendent (parent/consumer) packages,
-- and this allows forward sorting by dependencies (ie lowest deps first).
--
-- Additionally this function allows passing options to rpmspec:
-- eg `--with bootstrap` etc
--
-- @since 0.4.2
createGraph'' :: [String] -- ^ rpmspec options
              -> Bool -- ^ verbose
              -> Bool -- ^ lenient (skip rpmspec failures)
              -> Bool -- ^ reverse dependency graph
              -> Maybe FilePath -- ^ look for spec file in a subdirectory
              -> [FilePath] -- ^ package paths (directories or spec filepaths)
              -> IO PackageGraph -- ^ dependency graph labelled by package paths
createGraph'' :: [FilePath]
-> Bool
-> Bool
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
createGraph'' = [FilePath]
-> [FilePath]
-> Bool
-> Bool
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
createGraph''' []

-- | Create a directed dependency graph for a set of packages
--
-- Like createGraph'' but with additional parameter for any BRs to be ignored.
--
-- @since 0.4.3
createGraph''' :: [String] -- ^ ignored BuildRequires
               -> [String] -- ^ rpmspec options
               -> Bool -- ^ verbose
               -> Bool -- ^ lenient (skip rpmspec failures)
               -> Bool -- ^ reverse dependency graph
               -> Maybe FilePath -- ^ look for spec file in a subdirectory
               -> [FilePath] -- ^ package paths (directories or spec filepaths)
               -> IO PackageGraph -- ^ dependency graph labelled by package paths
createGraph''' :: [FilePath]
-> [FilePath]
-> Bool
-> Bool
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
createGraph''' = Bool
-> [FilePath]
-> [FilePath]
-> Bool
-> Bool
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
createGraph'''' Bool
True

-- | Create a directed dependency graph for a set of packages
--
-- Like createGraph''' but can disable check for cycles
--
-- @since 0.4.4
createGraph'''' :: Bool -- ^ check for cycles
                -> [String] -- ^ ignored BuildRequires
                -> [String] -- ^ rpmspec options
                -> Bool -- ^ verbose
                -> Bool -- ^ lenient (skip rpmspec failures)
                -> Bool -- ^ reverse dependency graph
                -> Maybe FilePath -- ^ look for spec file in a subdirectory
                -> [FilePath] -- ^ package paths (directories or spec filepaths)
                -> IO PackageGraph -- ^ dependency graph labelled by package paths
createGraph'''' :: Bool
-> [FilePath]
-> [FilePath]
-> Bool
-> Bool
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
createGraph'''' Bool
checkcycles [FilePath]
ignoredBRs [FilePath]
rpmopts Bool
verbose Bool
lenient Bool
rev Maybe FilePath
mdir [FilePath]
paths = do
  [(FilePath, [FilePath], [FilePath])]
metadata <- [Maybe (FilePath, [FilePath], [FilePath])]
-> [(FilePath, [FilePath], [FilePath])]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (FilePath, [FilePath], [FilePath])]
 -> [(FilePath, [FilePath], [FilePath])])
-> IO [Maybe (FilePath, [FilePath], [FilePath])]
-> IO [(FilePath, [FilePath], [FilePath])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO (Maybe (FilePath, [FilePath], [FilePath])))
-> [FilePath] -> IO [Maybe (FilePath, [FilePath], [FilePath])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO (Maybe (FilePath, [FilePath], [FilePath]))
readSpecMetadata [FilePath]
paths
  let realpkgs :: [FilePath]
realpkgs = ((FilePath, [FilePath], [FilePath]) -> FilePath)
-> [(FilePath, [FilePath], [FilePath])] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, [FilePath], [FilePath]) -> FilePath
forall a b c. (a, b, c) -> a
fst3 [(FilePath, [FilePath], [FilePath])]
metadata
      deps :: [[FilePath]]
deps = (FilePath -> Maybe [FilePath]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([(FilePath, [FilePath], [FilePath])]
-> FilePath -> Maybe [FilePath]
getDepsSrcResolved [(FilePath, [FilePath], [FilePath])]
metadata) [FilePath]
realpkgs
      spkgs :: [SourcePackage]
spkgs = (FilePath -> [FilePath] -> SourcePackage)
-> [FilePath] -> [[FilePath]] -> [SourcePackage]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith FilePath -> [FilePath] -> SourcePackage
SourcePackage [FilePath]
realpkgs [[FilePath]]
deps
      graph :: PackageGraph
graph = [SourcePackage] -> PackageGraph
getBuildGraph [SourcePackage]
spkgs
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
checkcycles (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    PackageGraph -> IO ()
checkForCycles PackageGraph
graph
  PackageGraph -> IO PackageGraph
forall (m :: * -> *) a. Monad m => a -> m a
return PackageGraph
graph
  where
    readSpecMetadata :: FilePath -> IO (Maybe (FilePath,[String],[String]))
    readSpecMetadata :: FilePath -> IO (Maybe (FilePath, [FilePath], [FilePath]))
readSpecMetadata FilePath
path = do
      Maybe FilePath
mspec <- IO (Maybe FilePath)
findSpec
      case Maybe FilePath
mspec of
        Maybe FilePath
Nothing -> Maybe (FilePath, [FilePath], [FilePath])
-> IO (Maybe (FilePath, [FilePath], [FilePath]))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (FilePath, [FilePath], [FilePath])
forall a. Maybe a
Nothing
        Just FilePath
spec -> do
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
warn FilePath
spec
          Maybe FilePath
mcontent <- FilePath -> IO (Maybe FilePath)
rpmspecParse FilePath
spec
          case Maybe FilePath
mcontent of
            Maybe FilePath
Nothing -> Maybe (FilePath, [FilePath], [FilePath])
-> IO (Maybe (FilePath, [FilePath], [FilePath]))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (FilePath, [FilePath], [FilePath])
forall a. Maybe a
Nothing
            Just FilePath
content ->
              let pkg :: FilePath
pkg = FilePath -> FilePath
takeBaseName FilePath
spec
                  ([FilePath]
provs,[FilePath]
brs) = FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> ([FilePath], [FilePath])
extractMetadata FilePath
pkg ([],[]) ([FilePath] -> ([FilePath], [FilePath]))
-> [FilePath] -> ([FilePath], [FilePath])
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
lines FilePath
content
              in Maybe (FilePath, [FilePath], [FilePath])
-> IO (Maybe (FilePath, [FilePath], [FilePath]))
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath, [FilePath], [FilePath])
-> Maybe (FilePath, [FilePath], [FilePath])
forall a. a -> Maybe a
Just (FilePath
path, [FilePath]
provs, [FilePath]
brs))
      where
        findSpec :: IO (Maybe FilePath)
        findSpec :: IO (Maybe FilePath)
findSpec =
          if FilePath -> FilePath
takeExtension FilePath
path FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".spec"
            then Bool -> FilePath -> IO (Maybe FilePath)
checkFile Bool
lenient FilePath
path
            else do
            Bool
dirp <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
            if Bool
dirp
              then do
              let dir :: FilePath
dir = FilePath -> (FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
path (FilePath
path FilePath -> FilePath -> FilePath
</>) Maybe FilePath
mdir
                  dirname :: FilePath
dirname = FilePath -> FilePath
takeFileName (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a]
dropSuffix FilePath
"/" FilePath
path
              Maybe FilePath
mspec <- Bool -> FilePath -> IO (Maybe FilePath)
checkFile Bool
True (FilePath -> IO (Maybe FilePath))
-> FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
dirname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".spec"
              case Maybe FilePath
mspec of
                Just FilePath
spec -> Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
spec
                Maybe FilePath
Nothing -> do
                  Bool
dead <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"dead.package"
                  if Bool
dead then Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
                    else do
                    [FilePath]
specs <- FilePath -> FilePath -> IO [FilePath]
filesWithExtension FilePath
dir FilePath
".spec"
                    case [FilePath]
specs of
                      [FilePath
spec] -> Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
spec
                      [FilePath]
_ -> if Bool
lenient then Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
                           else FilePath -> IO (Maybe FilePath)
forall a. FilePath -> a
errorWithoutStackTrace (FilePath -> IO (Maybe FilePath))
-> FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$
                                if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
specs
                                then FilePath
"No spec file found in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path
                                else FilePath
"More than one .spec file found in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
dir
              else FilePath -> IO (Maybe FilePath)
forall a. FilePath -> a
errorWithoutStackTrace (FilePath -> IO (Maybe FilePath))
-> FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
"No spec file found for " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path
          where
            checkFile :: Bool -> FilePath -> IO (Maybe FilePath)
            checkFile :: Bool -> FilePath -> IO (Maybe FilePath)
checkFile Bool
may FilePath
f = do
              Bool
e <- FilePath -> IO Bool
doesFileExist FilePath
f
              if Bool
e
                then Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
f
                else Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ if Bool
may
                              then Maybe FilePath
forall a. Maybe a
Nothing
                              else FilePath -> Maybe FilePath
forall a. FilePath -> a
errorWithoutStackTrace (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" not found"

            filesWithExtension :: FilePath -> String -> IO [FilePath]
            filesWithExtension :: FilePath -> FilePath -> IO [FilePath]
filesWithExtension FilePath
dir FilePath
ext =
              (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
dir FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ FilePath
f -> FilePath -> FilePath
takeExtension FilePath
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
ext) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
              FilePath -> IO [FilePath]
listDirectory FilePath
dir

        extractMetadata :: FilePath -> ([String],[String]) -> [String] -> ([String],[String])
        extractMetadata :: FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> ([FilePath], [FilePath])
extractMetadata FilePath
_ ([FilePath], [FilePath])
acc [] = ([FilePath], [FilePath])
acc
        extractMetadata FilePath
pkg acc :: ([FilePath], [FilePath])
acc@([FilePath]
provs,[FilePath]
brs) (FilePath
l:[FilePath]
ls) =
          let ws :: [FilePath]
ws = FilePath -> [FilePath]
words FilePath
l in
            if [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
ws Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 then FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> ([FilePath], [FilePath])
extractMetadata FilePath
pkg ([FilePath], [FilePath])
acc [FilePath]
ls
            else case FilePath -> CI FilePath
forall s. FoldCase s => s -> CI s
CI.mk ([FilePath] -> FilePath
forall a. [a] -> a
head [FilePath]
ws) of
              CI FilePath
"BuildRequires:" ->
                let br :: FilePath
br = ([FilePath] -> FilePath
forall a. [a] -> a
head ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. [a] -> [a]
tail) [FilePath]
ws
                    brs' :: [FilePath]
brs' = if FilePath
br FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
ignoredBRs then [FilePath]
brs else FilePath
brFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
brs
                in FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> ([FilePath], [FilePath])
extractMetadata FilePath
pkg ([FilePath]
provs, [FilePath]
brs') [FilePath]
ls
              CI FilePath
"Name:" -> FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> ([FilePath], [FilePath])
extractMetadata FilePath
pkg (([FilePath] -> FilePath
forall a. [a] -> a
head ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. [a] -> [a]
tail) [FilePath]
ws FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
provs, [FilePath]
brs) [FilePath]
ls
              CI FilePath
"Provides:" -> FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> ([FilePath], [FilePath])
extractMetadata FilePath
pkg (([FilePath] -> FilePath
forall a. [a] -> a
head ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. [a] -> [a]
tail) [FilePath]
ws FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
provs, [FilePath]
brs) [FilePath]
ls
              CI FilePath
"%package" ->
                let subpkg :: FilePath
subpkg =
                      let sub :: FilePath
sub = [FilePath] -> FilePath
forall a. [a] -> a
last [FilePath]
ws in
                        if [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
ws Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
                        then FilePath
pkg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char
'-' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
sub
                        else FilePath
sub
                in FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> ([FilePath], [FilePath])
extractMetadata FilePath
pkg (FilePath
subpkg FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
provs, [FilePath]
brs) [FilePath]
ls
              CI FilePath
_ -> FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> ([FilePath], [FilePath])
extractMetadata FilePath
pkg ([FilePath], [FilePath])
acc [FilePath]
ls

    getBuildGraph :: [SourcePackage] -> PackageGraph
    getBuildGraph :: [SourcePackage] -> PackageGraph
getBuildGraph [SourcePackage]
srcPkgs =
       let nodes :: [(Int, SourcePackage)]
nodes = [Int] -> [SourcePackage] -> [(Int, SourcePackage)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [SourcePackage]
srcPkgs
           nodeDict :: [(FilePath, Int)]
nodeDict = [FilePath] -> [Int] -> [(FilePath, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((SourcePackage -> FilePath) -> [SourcePackage] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SourcePackage -> FilePath
packagePath [SourcePackage]
srcPkgs) [Int
0..]
           edges :: [(Int, Int, ())]
edges = do
              (Int
srcNode,SourcePackage
srcPkg) <- [(Int, SourcePackage)]
nodes
              Int
dstNode <- (FilePath -> Maybe Int) -> [FilePath] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FilePath -> [(FilePath, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(FilePath, Int)]
nodeDict) (SourcePackage -> [FilePath]
dependencies SourcePackage
srcPkg)
              Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
dstNode Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
srcNode)
              (Int, Int, ()) -> [(Int, Int, ())]
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, Int, ()) -> [(Int, Int, ())])
-> (Int, Int, ()) -> [(Int, Int, ())]
forall a b. (a -> b) -> a -> b
$ if Bool
rev
                       then (Int
dstNode, Int
srcNode, ())
                       else (Int
srcNode, Int
dstNode,  ())
       in [LNode FilePath] -> [(Int, Int, ())] -> PackageGraph
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
G.mkGraph (((Int, SourcePackage) -> LNode FilePath)
-> [(Int, SourcePackage)] -> [LNode FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((SourcePackage -> FilePath)
-> (Int, SourcePackage) -> LNode FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SourcePackage -> FilePath
packagePath) [(Int, SourcePackage)]
nodes) ([(Int, Int, ())] -> PackageGraph)
-> [(Int, Int, ())] -> PackageGraph
forall a b. (a -> b) -> a -> b
$ [(Int, Int, ())] -> [(Int, Int, ())]
forall a. Eq a => [a] -> [a]
nub [(Int, Int, ())]
edges

    checkForCycles :: PackageGraph -> IO ()
    checkForCycles :: PackageGraph -> IO ()
checkForCycles PackageGraph
graph = do
      let cycles :: [[Int]]
cycles = ([Int] -> Bool) -> [[Int]] -> [[Int]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2) (Int -> Bool) -> ([Int] -> Int) -> [Int] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) (PackageGraph -> [[Int]]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [[Int]]
scc PackageGraph
graph)
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([[Int]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Int]]
cycles) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        let plural :: FilePath
plural = if [[Int]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Int]]
cycles Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then FilePath
"s" else FilePath
""
        FilePath -> IO ()
forall a. FilePath -> a
errorWithoutStackTrace (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$
          (FilePath
"ordering not possible due to build dependency cycle" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
plural FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":\n") FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [[FilePath]] -> [FilePath]
forall a. [a] -> [[a]] -> [a]
intercalate [FilePath
""] (([Int] -> [FilePath]) -> [[Int]] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map (([FilePath], [[FilePath]]) -> [FilePath]
renderCycles (([FilePath], [[FilePath]]) -> [FilePath])
-> ([Int] -> ([FilePath], [[FilePath]])) -> [Int] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ([FilePath], [[FilePath]])
subcycles) [[Int]]
cycles)
      where
        -- shortest subcycle
        subcycles :: [G.Node] -> ([FilePath],[[FilePath]])
        subcycles :: [Int] -> ([FilePath], [[FilePath]])
subcycles [] = FilePath -> ([FilePath], [[FilePath]])
forall a. HasCallStack => FilePath -> a
error FilePath
"cyclic graph with no nodes!"
        subcycles [Int]
cycle' =
          let shorter :: [[Int]]
shorter = ([Int] -> [Int]) -> [[Int]] -> [[Int]]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ ([Int] -> Int) -> [[Int]] -> [[Int]]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ ([Int] -> Bool) -> [[Int]] -> [[Int]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
cycle') (Int -> Bool) -> ([Int] -> Int) -> [Int] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ ((Int, Int, Int) -> Maybe [Int]) -> [(Int, Int, Int)] -> [[Int]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int, Int, Int) -> Maybe [Int]
forall c. (Int, Int, c) -> Maybe [Int]
findSp ([(Int, Int, Int)] -> [[Int]]) -> [(Int, Int, Int)] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ Gr FilePath Int -> [(Int, Int, Int)]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
G.labEdges Gr FilePath Int
sg
          in (PackageGraph -> [Int] -> [FilePath]
forall a b. Gr a b -> [Int] -> [a]
nodeLabels PackageGraph
graph [Int]
cycle', ([Int] -> [FilePath]) -> [[Int]] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map (Gr FilePath Int -> [Int] -> [FilePath]
forall a b. Gr a b -> [Int] -> [a]
nodeLabels Gr FilePath Int
sg) [[Int]]
shorter)
          where
            sg :: Gr FilePath Int
sg = (() -> Int) -> PackageGraph -> Gr FilePath Int
forall (gr :: * -> * -> *) b c a.
DynGraph gr =>
(b -> c) -> gr a b -> gr a c
G.emap (Int -> () -> Int
forall a b. a -> b -> a
const (Int
1 :: Int)) (PackageGraph -> Gr FilePath Int)
-> PackageGraph -> Gr FilePath Int
forall a b. (a -> b) -> a -> b
$ [Int] -> PackageGraph -> PackageGraph
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[Int] -> gr a b -> gr a b
G.subgraph [Int]
cycle' PackageGraph
graph

            findSp :: (Int, Int, c) -> Maybe [Int]
findSp (Int
i,Int
j,c
_) | Gr FilePath Int -> Edge -> Bool
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Edge -> Bool
G.hasEdge Gr FilePath Int
sg (Int
i,Int
j) = Int -> Int -> Gr FilePath Int -> Maybe [Int]
forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Int -> Int -> gr a b -> Maybe [Int]
sp Int
j Int
i Gr FilePath Int
sg
                           | Gr FilePath Int -> Edge -> Bool
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Edge -> Bool
G.hasEdge Gr FilePath Int
sg (Int
j,Int
i) = Int -> Int -> Gr FilePath Int -> Maybe [Int]
forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Int -> Int -> gr a b -> Maybe [Int]
sp Int
i Int
j Gr FilePath Int
sg
                           | Bool
otherwise = Maybe [Int]
forall a. Maybe a
Nothing

        renderCycles :: ([FilePath],[[FilePath]]) -> [String]
        renderCycles :: ([FilePath], [[FilePath]]) -> [FilePath]
renderCycles ([FilePath]
c,[[FilePath]]
sc) =
          [FilePath] -> FilePath
unwords [FilePath]
c FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: if [[FilePath]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[FilePath]]
sc then [] else FilePath
"\nShortest path subcycles: " FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: ([FilePath] -> FilePath) -> [[FilePath]] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map [FilePath] -> FilePath
unwords [[FilePath]]
sc

    getDepsSrcResolved :: [(FilePath,[String],[String])] -> FilePath -> Maybe [FilePath]
    getDepsSrcResolved :: [(FilePath, [FilePath], [FilePath])]
-> FilePath -> Maybe [FilePath]
getDepsSrcResolved [(FilePath, [FilePath], [FilePath])]
metadata FilePath
pkg =
      (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
resolveBase ([FilePath] -> [FilePath])
-> ((FilePath, [FilePath], [FilePath]) -> [FilePath])
-> (FilePath, [FilePath], [FilePath])
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, [FilePath], [FilePath]) -> [FilePath]
forall a b c. (a, b, c) -> c
thd ((FilePath, [FilePath], [FilePath]) -> [FilePath])
-> Maybe (FilePath, [FilePath], [FilePath]) -> Maybe [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((FilePath, [FilePath], [FilePath]) -> Bool)
-> [(FilePath, [FilePath], [FilePath])]
-> Maybe (FilePath, [FilePath], [FilePath])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
pkg) (FilePath -> Bool)
-> ((FilePath, [FilePath], [FilePath]) -> FilePath)
-> (FilePath, [FilePath], [FilePath])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, [FilePath], [FilePath]) -> FilePath
forall a b c. (a, b, c) -> a
fst3) [(FilePath, [FilePath], [FilePath])]
metadata
      where
        resolveBase :: FilePath -> FilePath
        resolveBase :: FilePath -> FilePath
resolveBase FilePath
br =
          case ((FilePath, [FilePath], [FilePath]) -> Maybe FilePath)
-> [(FilePath, [FilePath], [FilePath])] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\ (FilePath
p,[FilePath]
provs,[FilePath]
_) -> if FilePath
br FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
provs then FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
p else Maybe FilePath
forall a. Maybe a
Nothing) [(FilePath, [FilePath], [FilePath])]
metadata of
            [] -> FilePath
br
            [FilePath
p] -> FilePath
p
            [FilePath]
ps -> FilePath -> FilePath
forall a. FilePath -> a
errorWithoutStackTrace (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
pkg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
br FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is provided by: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
ps

        thd :: (a, b, c) -> c
thd (a
_,b
_,c
c) = c
c

    fst3 :: (a,b,c) -> a
    fst3 :: (a, b, c) -> a
fst3 (a
a,b
_,c
_) = a
a

    nodeLabels :: Gr a b -> [G.Node] -> [a]
    nodeLabels :: Gr a b -> [Int] -> [a]
nodeLabels Gr a b
graph =
       (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> a
forall a. HasCallStack => FilePath -> a
error FilePath
"node not found in graph") (Maybe a -> a) -> (Int -> Maybe a) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            Gr a b -> Int -> Maybe a
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
G.lab Gr a b
graph)

    rpmspecParse :: FilePath -> IO (Maybe String)
    rpmspecParse :: FilePath -> IO (Maybe FilePath)
rpmspecParse FilePath
spec = do
      (ExitCode
res, FilePath
out, FilePath
err) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode FilePath
"rpmspec" ([FilePath
"-P", FilePath
"--define", FilePath
"ghc_version any"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
rpmopts [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
spec]) FilePath
""
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
warn FilePath
err
      case ExitCode
res of
        ExitFailure Int
_ -> if Bool
lenient then Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing else IO (Maybe FilePath)
forall a. IO a
exitFailure
        ExitCode
ExitSuccess -> Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
out

    warn :: String -> IO ()
    warn :: FilePath -> IO ()
warn = Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr

-- | A flipped version of subgraph
subgraph' :: Gr a b -> [G.Node] -> Gr a b
subgraph' :: Gr a b -> [Int] -> Gr a b
subgraph' = ([Int] -> Gr a b -> Gr a b) -> Gr a b -> [Int] -> Gr a b
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Int] -> Gr a b -> Gr a b
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[Int] -> gr a b -> gr a b
G.subgraph

-- | Return the bottom-up list of dependency layers of a graph
packageLayers :: PackageGraph -> [[FilePath]]
packageLayers :: PackageGraph -> [[FilePath]]
packageLayers PackageGraph
graph =
  if PackageGraph -> Bool
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
G.isEmpty PackageGraph
graph then []
  else
    let layer :: [LNode FilePath]
layer = PackageGraph -> [LNode FilePath]
lowestLayer' PackageGraph
graph
    in (LNode FilePath -> FilePath) -> [LNode FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map LNode FilePath -> FilePath
forall a b. (a, b) -> b
snd [LNode FilePath]
layer [FilePath] -> [[FilePath]] -> [[FilePath]]
forall a. a -> [a] -> [a]
: PackageGraph -> [[FilePath]]
packageLayers ([Int] -> PackageGraph -> PackageGraph
forall (gr :: * -> * -> *) a b.
Graph gr =>
[Int] -> gr a b -> gr a b
G.delNodes ((LNode FilePath -> Int) -> [LNode FilePath] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map LNode FilePath -> Int
forall a b. (a, b) -> a
fst [LNode FilePath]
layer) PackageGraph
graph)

-- | The lowest dependencies of a PackageGraph
lowestLayer :: PackageGraph -> [FilePath]
lowestLayer :: PackageGraph -> [FilePath]
lowestLayer PackageGraph
graph =
  (LNode FilePath -> FilePath) -> [LNode FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map LNode FilePath -> FilePath
forall a b. (a, b) -> b
snd ([LNode FilePath] -> [FilePath]) -> [LNode FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ PackageGraph -> [LNode FilePath]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
G.labNodes (PackageGraph -> [LNode FilePath])
-> PackageGraph -> [LNode FilePath]
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> PackageGraph -> PackageGraph
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
(Int -> Bool) -> gr a b -> gr a b
G.nfilter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0) (Int -> Bool) -> (Int -> Int) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageGraph -> Int -> Int
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Int
G.indeg PackageGraph
graph) PackageGraph
graph

-- | The lowest dependency nodes of a PackageGraph
lowestLayer' :: PackageGraph -> [G.LNode FilePath]
lowestLayer' :: PackageGraph -> [LNode FilePath]
lowestLayer' PackageGraph
graph =
  PackageGraph -> [LNode FilePath]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
G.labNodes (PackageGraph -> [LNode FilePath])
-> PackageGraph -> [LNode FilePath]
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> PackageGraph -> PackageGraph
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
(Int -> Bool) -> gr a b -> gr a b
G.nfilter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0) (Int -> Bool) -> (Int -> Int) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageGraph -> Int -> Int
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Int
G.indeg PackageGraph
graph) PackageGraph
graph

-- | The leaf (outer) packages of a PackageGraph
packageLeaves :: PackageGraph -> [FilePath]
packageLeaves :: PackageGraph -> [FilePath]
packageLeaves PackageGraph
graph =
  (LNode FilePath -> FilePath) -> [LNode FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map LNode FilePath -> FilePath
forall a b. (a, b) -> b
snd ([LNode FilePath] -> [FilePath]) -> [LNode FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ PackageGraph -> [LNode FilePath]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
G.labNodes (PackageGraph -> [LNode FilePath])
-> PackageGraph -> [LNode FilePath]
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> PackageGraph -> PackageGraph
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
(Int -> Bool) -> gr a b -> gr a b
G.nfilter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0) (Int -> Bool) -> (Int -> Int) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageGraph -> Int -> Int
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Int
G.outdeg PackageGraph
graph) PackageGraph
graph

-- | Returns packages independent of all the rest of the graph
separatePackages :: PackageGraph -> [FilePath]
separatePackages :: PackageGraph -> [FilePath]
separatePackages PackageGraph
graph =
  (LNode FilePath -> FilePath) -> [LNode FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map LNode FilePath -> FilePath
forall a b. (a, b) -> b
snd ([LNode FilePath] -> [FilePath]) -> [LNode FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ PackageGraph -> [LNode FilePath]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
G.labNodes (PackageGraph -> [LNode FilePath])
-> PackageGraph -> [LNode FilePath]
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> PackageGraph -> PackageGraph
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
(Int -> Bool) -> gr a b -> gr a b
G.nfilter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0) (Int -> Bool) -> (Int -> Int) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageGraph -> Int -> Int
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Int
G.deg PackageGraph
graph) PackageGraph
graph

-- | Return graphviz dot format of graph
printGraph :: PackageGraph -> IO ()
printGraph :: PackageGraph -> IO ()
printGraph PackageGraph
g = do
  FilePath -> IO ()
putStrLn FilePath
"digraph {"
  [LNode FilePath] -> (LNode FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (PackageGraph -> [LNode FilePath]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
G.labNodes PackageGraph
g) ((LNode FilePath -> IO ()) -> IO ())
-> (LNode FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ (Int
n,FilePath
l) -> do
    FilePath -> IO ()
putStr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
l
    FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
renderDeps ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
forall a. Show a => a -> FilePath
show ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ((Int, ()) -> Maybe FilePath) -> [(Int, ())] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PackageGraph -> Int -> Maybe FilePath
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
G.lab PackageGraph
g (Int -> Maybe FilePath)
-> ((Int, ()) -> Int) -> (Int, ()) -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ()) -> Int
forall a b. (a, b) -> a
fst) ([(Int, ())] -> [FilePath]) -> [(Int, ())] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ PackageGraph -> Int -> [(Int, ())]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [(Int, b)]
G.lsuc PackageGraph
g Int
n
  FilePath -> IO ()
putStrLn FilePath
"}"
  where
    renderDeps :: [String] -> String
    renderDeps :: [FilePath] -> FilePath
renderDeps [] = FilePath
""
    renderDeps [FilePath
d] = FilePath
" -> " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
d
    renderDeps [FilePath]
ds = FilePath
" -> {" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
ds FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"}"

-- | Render graph with graphviz X11 preview
renderGraph :: PackageGraph -> IO ()
renderGraph :: PackageGraph -> IO ()
renderGraph PackageGraph
graph =
  let g :: Gr FilePath FilePath
g = (() -> FilePath) -> PackageGraph -> Gr FilePath FilePath
forall (gr :: * -> * -> *) b c a.
DynGraph gr =>
(b -> c) -> gr a b -> gr a c
G.emap (FilePath -> () -> FilePath
forall a b. a -> b -> a
const (FilePath
"" :: String)) PackageGraph
graph
  in DotGraph Int -> GraphvizCanvas -> IO ()
forall (dg :: * -> *) n.
PrintDotRepr dg n =>
dg n -> GraphvizCanvas -> IO ()
runGraphvizCanvas' ((GraphvizParams Int FilePath FilePath () FilePath
 -> Gr FilePath FilePath -> DotGraph Int)
-> GraphvizParams Int FilePath FilePath () FilePath
-> Gr FilePath FilePath
-> DotGraph Int
forall el (gr :: * -> * -> *) nl cl l a.
(Ord el, Graph gr) =>
(GraphvizParams Int nl el cl l -> gr nl el -> a)
-> GraphvizParams Int nl el cl l -> gr nl el -> a
setDirectedness GraphvizParams Int FilePath FilePath () FilePath
-> Gr FilePath FilePath -> DotGraph Int
forall cl (gr :: * -> * -> *) nl el l.
(Ord cl, Graph gr) =>
GraphvizParams Int nl el cl l -> gr nl el -> DotGraph Int
graphToDot GraphvizParams Int FilePath FilePath () FilePath
forall nl el n.
(Labellable nl, Labellable el) =>
GraphvizParams n nl el () nl
quickParams Gr FilePath FilePath
g) GraphvizCanvas
Xlib