{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Distribution.RPM.Build.Graph
(PackageGraph,
createGraph,
createGraphRpmOpts,
createGraph',
createGraph'',
dependencyNodes,
subgraph',
packageLayers,
lowestLayer,
lowestLayer',
packageLeaves,
separatePackages
) 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
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
type PackageGraph = Gr FilePath ()
dependencyNodes :: [FilePath]
-> PackageGraph
-> [FilePath]
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
createGraph :: [FilePath]
-> IO PackageGraph
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
createGraphRpmOpts :: [String]
-> [FilePath]
-> IO PackageGraph
createGraphRpmOpts :: [FilePath] -> [FilePath] -> IO PackageGraph
createGraphRpmOpts rpmopts :: [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
createGraph' :: Bool
-> Bool
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
createGraph' :: Bool
-> Bool -> Bool -> Maybe FilePath -> [FilePath] -> IO PackageGraph
createGraph' = [FilePath]
-> Bool
-> Bool
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
createGraph'' []
createGraph'' :: [String]
-> Bool
-> Bool
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
createGraph'' :: [FilePath]
-> Bool
-> Bool
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
createGraph'' rpmopts :: [FilePath]
rpmopts 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]
forall a. [a] -> [a] -> [a]
++ [""]) ([FilePath] -> [FilePath])
-> ([Int] -> [FilePath]) -> [Int] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([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
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] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
rpmopts [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [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
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
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)
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
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
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
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