{-# 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
  (createGraph,
   createGraph',
   dependencyNodes,
   subgraph',
   packageLayers,
   lowestLayer,
   lowestLayer',
   packageLeaves,
   separatePackages,
   PackageGraph
  ) 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 (guard, when, unless)
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
import Data.List.Extra (dropSuffix, find, nubOrdOn, sort, sortOn)
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 subset :: [FilePath]
subset graph :: 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 [] _ = Maybe Int
forall a. Maybe a
Nothing
    pkgNode ((i :: Int
i,l :: FilePath
l):ns :: [LNode FilePath]
ns) p :: FilePath
p = if FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a]
dropSuffix "/" FilePath
p FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a]
dropSuffix "/" 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 (_, _, c :: c
c, _) = 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
-- 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).
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' verbose :: Bool
verbose lenient :: Bool
lenient rev :: Bool
rev mdir :: Maybe FilePath
mdir paths :: [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
  PackageGraph -> IO ()
forall (m :: * -> *). Monad m => PackageGraph -> m ()
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 path :: FilePath
path = do
      Maybe FilePath
mspec <- IO (Maybe FilePath)
findSpec
      case Maybe FilePath
mspec of
        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 spec :: 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
            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 content :: FilePath
content ->
              let pkg :: FilePath
pkg = FilePath -> FilePath
takeBaseName FilePath
spec
                  (provs :: [FilePath]
provs,brs :: [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
== ".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
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]
++ ".spec"
              case Maybe FilePath
mspec of
                Just spec :: 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
                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
</> "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 ".spec"
                    case [FilePath]
specs of
                      [spec :: 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
                      _ -> 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. HasCallStack => FilePath -> a
error (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 "No spec file found in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path
                                        else "More than one .spec file found in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
dir
              else FilePath -> IO (Maybe FilePath)
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO (Maybe FilePath))
-> FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ "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 may :: Bool
may f :: 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. HasCallStack => FilePath -> a
error (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " not found"

            filesWithExtension :: FilePath -> String -> IO [FilePath]
            filesWithExtension :: FilePath -> FilePath -> IO [FilePath]
filesWithExtension dir :: FilePath
dir ext :: 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 (\ f :: 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 _ acc :: ([FilePath], [FilePath])
acc [] = ([FilePath], [FilePath])
acc
        extractMetadata pkg :: FilePath
pkg acc :: ([FilePath], [FilePath])
acc@(provs :: [FilePath]
provs,brs :: [FilePath]
brs) (l :: FilePath
l:ls :: [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
< 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
              "BuildRequires:" -> FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> ([FilePath], [FilePath])
extractMetadata FilePath
pkg ([FilePath]
provs,([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]
brs) [FilePath]
ls
              "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
              "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
              "%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
== 2
                        then FilePath
pkg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ '-' 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
              _ -> FilePath
-> ([FilePath], [FilePath])
-> [FilePath]
-> ([FilePath], [FilePath])
extractMetadata FilePath
pkg ([FilePath], [FilePath])
acc [FilePath]
ls

    getBuildGraph :: [SourcePackage] -> PackageGraph
    getBuildGraph :: [SourcePackage] -> PackageGraph
getBuildGraph srcPkgs :: [SourcePackage]
srcPkgs =
       let nodes :: [(Int, SourcePackage)]
nodes = [Int] -> [SourcePackage] -> [(Int, SourcePackage)]
forall a b. [a] -> [b] -> [(a, b)]
zip [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) [0..]
           edges :: [(Int, Int, ())]
edges = do
              (srcNode :: Int
srcNode,srcPkg :: 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, ())]
edges

    checkForCycles :: Monad m => PackageGraph -> m ()
    checkForCycles :: PackageGraph -> m ()
checkForCycles graph :: PackageGraph
graph =
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([[Int]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Int]]
cycles) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        FilePath -> m ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$
        "Cycles in dependencies:" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:
        ([Int] -> [FilePath]) -> [[Int]] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (([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
        cycles :: [[G.Node]]
        cycles :: [[Int]]
cycles =
           (([Int] -> Bool) -> [[Int]] -> [[Int]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 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) ([[Int]] -> [[Int]])
-> (PackageGraph -> [[Int]]) -> PackageGraph -> [[Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageGraph -> [[Int]]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [[Int]]
scc) PackageGraph
graph

        -- shortest subcycle
        subcycles :: [G.Node] -> ([FilePath],[[FilePath]])
        subcycles :: [Int] -> ([FilePath], [[FilePath]])
subcycles [] = FilePath -> ([FilePath], [[FilePath]])
forall a. HasCallStack => FilePath -> a
error "cyclic graph with no nodes!"
        subcycles cycle' :: [Int]
cycle'@(n :: Int
n:ns :: [Int]
ns) =
          let 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 (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
              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]
ns) (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
$ [Maybe [Int]] -> [[Int]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [Int]] -> [[Int]]) -> [Maybe [Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Maybe [Int]) -> [Int] -> [Maybe [Int]]
forall a b. (a -> a -> b) -> [a] -> [b]
mapAdjacent (\ i :: Int
i j :: 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) ([Int]
cycle' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
n])
          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)

        mapAdjacent :: (a -> a -> b) -> [a] -> [b]
        mapAdjacent :: (a -> a -> b) -> [a] -> [b]
mapAdjacent f :: a -> a -> b
f xs :: [a]
xs = (a -> a -> b) -> [a] -> [a] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> b
f [a]
xs ([a] -> [a]
forall a. [a] -> [a]
tail [a]
xs)

        renderCycles :: ([FilePath],[[FilePath]]) -> [String]
        renderCycles :: ([FilePath], [[FilePath]]) -> [FilePath]
renderCycles (c :: [FilePath]
c,sc :: [[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 "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 metadata :: [(FilePath, [FilePath], [FilePath])]
metadata pkg :: 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 br :: FilePath
br =
          case ((FilePath, [FilePath], [FilePath]) -> Maybe FilePath)
-> [(FilePath, [FilePath], [FilePath])] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\ (p :: FilePath
p,provs :: [FilePath]
provs,_) -> 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
            [p :: FilePath
p] -> FilePath
p
            ps :: [FilePath]
ps -> FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
pkg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
br FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " is provided by: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
ps

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

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

    nodeLabels :: Gr a b -> [G.Node] -> [a]
    nodeLabels :: Gr a b -> [Int] -> [a]
nodeLabels graph :: 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 "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 spec :: FilePath
spec = do
      (res :: ExitCode
res, out :: FilePath
out, err :: FilePath
err) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode "rpmspec" ["-P", "--define", "ghc_version any", FilePath
spec] ""
      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 _ -> 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
        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 graph :: 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 graph :: 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
==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' graph :: 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
==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 graph :: 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
==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 graph :: 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
==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