{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Distribution.RPM.Build.Graph
(PackageGraph,
createGraph,
createGraphRpmOpts,
createGraph1,
createGraph2,
createGraph3,
createGraph4,
createGraph',
createGraph'',
createGraph''',
createGraph'''',
dependencyNodes,
subgraph',
packageLayers,
lowestLayer,
lowestLayer',
packageLeaves,
separatePackages,
printGraph,
renderGraph,
depsGraph,
depsGraphDeps,
Components (..),
topsortGraph,
) where
import qualified Data.CaseInsensitive as CI
import Data.Graph.Inductive.Query.DFS (components, scc, topsort', 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.Extra (forM_, guard, when, unless, unlessM)
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
import Data.List.Extra
import Data.GraphViz
import SimpleCmd
import System.Directory (doesDirectoryExist, doesFileExist,
getCurrentDirectory, withCurrentDirectory,
listDirectory
)
import System.Exit (exitFailure)
import System.FilePath
import System.IO.Extra (withTempDir)
data SourcePackage =
SourcePackage {
SourcePackage -> String
packagePath :: FilePath,
SourcePackage -> [String]
dependencies :: [FilePath]
}
deriving SourcePackage -> SourcePackage -> Bool
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 :: [String] -> PackageGraph -> [String]
dependencyNodes [String]
subset PackageGraph
graph =
let nodes :: [LNode String]
nodes = forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
G.labNodes PackageGraph
graph
subnodes :: [Node]
subnodes = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([LNode String] -> String -> Maybe Node
pkgNode [LNode String]
nodes) [String]
subset
in forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [c]
xdfsWith forall a b. Context a b -> [Node]
G.pre' forall {a} {b} {c} {d}. (a, b, c, d) -> c
third [Node]
subnodes PackageGraph
graph
where
pkgNode :: [G.LNode FilePath] -> FilePath -> Maybe Int
pkgNode :: [LNode String] -> String -> Maybe Node
pkgNode [] String
_ = forall a. Maybe a
Nothing
pkgNode ((Node
i,String
l):[LNode String]
ns) String
p = if forall a. Eq a => [a] -> [a] -> [a]
dropSuffix String
"/" String
p forall a. Eq a => a -> a -> Bool
== forall a. Eq a => [a] -> [a] -> [a]
dropSuffix String
"/" String
l then forall a. a -> Maybe a
Just Node
i else [LNode String] -> String -> Maybe Node
pkgNode [LNode String]
ns String
p
third :: (a, b, c, d) -> c
third (a
_, b
_, c
c, d
_) = c
c
createGraph :: [FilePath]
-> IO PackageGraph
createGraph :: [String] -> IO PackageGraph
createGraph = Bool -> Bool -> Bool -> Maybe String -> [String] -> IO PackageGraph
createGraph1 Bool
False Bool
False Bool
True forall a. Maybe a
Nothing
createGraphRpmOpts :: [String]
-> [FilePath]
-> IO PackageGraph
createGraphRpmOpts :: [String] -> [String] -> IO PackageGraph
createGraphRpmOpts [String]
rpmopts =
[String]
-> Bool
-> Bool
-> Bool
-> Maybe String
-> [String]
-> IO PackageGraph
createGraph2 [String]
rpmopts Bool
False Bool
False Bool
True forall a. Maybe a
Nothing
createGraph1 :: Bool
-> Bool
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
createGraph1 :: Bool -> Bool -> Bool -> Maybe String -> [String] -> IO PackageGraph
createGraph1 = [String]
-> Bool
-> Bool
-> Bool
-> Maybe String
-> [String]
-> IO PackageGraph
createGraph2 []
createGraph' :: Bool
-> Bool
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
createGraph' :: Bool -> Bool -> Bool -> Maybe String -> [String] -> IO PackageGraph
createGraph' = Bool -> Bool -> Bool -> Maybe String -> [String] -> IO PackageGraph
createGraph1
createGraph2 :: [String]
-> Bool
-> Bool
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
createGraph2 :: [String]
-> Bool
-> Bool
-> Bool
-> Maybe String
-> [String]
-> IO PackageGraph
createGraph2 = [String]
-> [String]
-> Bool
-> Bool
-> Bool
-> Maybe String
-> [String]
-> IO PackageGraph
createGraph3 []
createGraph'' :: [String]
-> Bool
-> Bool
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
createGraph'' :: [String]
-> Bool
-> Bool
-> Bool
-> Maybe String
-> [String]
-> IO PackageGraph
createGraph'' = [String]
-> Bool
-> Bool
-> Bool
-> Maybe String
-> [String]
-> IO PackageGraph
createGraph2
createGraph3 :: [String]
-> [String]
-> Bool
-> Bool
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
createGraph3 :: [String]
-> [String]
-> Bool
-> Bool
-> Bool
-> Maybe String
-> [String]
-> IO PackageGraph
createGraph3 = Bool
-> [String]
-> [String]
-> Bool
-> Bool
-> Bool
-> Maybe String
-> [String]
-> IO PackageGraph
createGraph4 Bool
True
createGraph''' :: [String]
-> [String]
-> Bool
-> Bool
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
createGraph''' :: [String]
-> [String]
-> Bool
-> Bool
-> Bool
-> Maybe String
-> [String]
-> IO PackageGraph
createGraph''' = [String]
-> [String]
-> Bool
-> Bool
-> Bool
-> Maybe String
-> [String]
-> IO PackageGraph
createGraph3
createGraph4 :: Bool
-> [String]
-> [String]
-> Bool
-> Bool
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
createGraph4 :: Bool
-> [String]
-> [String]
-> Bool
-> Bool
-> Bool
-> Maybe String
-> [String]
-> IO PackageGraph
createGraph4 Bool
checkcycles [String]
ignoredBRs [String]
rpmopts Bool
verbose Bool
lenient Bool
rev Maybe String
mdir [String]
paths =
do
[(String, [String], [String])]
metadata <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (Maybe (String, [String], [String]))
readSpecMetadata [String]
paths
let realpkgs :: [String]
realpkgs = forall a b. (a -> b) -> [a] -> [b]
map forall a b c. (a, b, c) -> a
fst3 [(String, [String], [String])]
metadata
deps :: [[String]]
deps = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([(String, [String], [String])] -> String -> Maybe [String]
getDepsSrcResolved [(String, [String], [String])]
metadata) [String]
realpkgs
spkgs :: [SourcePackage]
spkgs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> [String] -> SourcePackage
SourcePackage [String]
realpkgs [[String]]
deps
graph :: PackageGraph
graph = [SourcePackage] -> PackageGraph
getBuildGraph [SourcePackage]
spkgs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
checkcycles forall a b. (a -> b) -> a -> b
$
PackageGraph -> IO ()
checkForCycles PackageGraph
graph
forall (m :: * -> *) a. Monad m => a -> m a
return PackageGraph
graph
where
readSpecMetadata :: FilePath -> IO (Maybe (FilePath,[String],[String]))
readSpecMetadata :: String -> IO (Maybe (String, [String], [String]))
readSpecMetadata String
path = do
Maybe (String, String)
mspecdir <- IO (Maybe (String, String))
findSpec
case Maybe (String, String)
mspecdir of
Maybe (String, String)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just (String
dir,String
spec) -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose forall a b. (a -> b) -> a -> b
$ String -> IO ()
warning String
spec
forall a. String -> IO a -> IO a
withCurrentDirectory String
dir forall a b. (a -> b) -> a -> b
$ do
Bool
dynbr <- String -> String -> IO Bool
egrep_ String
"^\\(%generate_buildrequires\\|%gometa\\)" String
spec
Maybe ([String], [String])
mprovbrs <-
if Bool
dynbr
then do
[String]
brs <- String -> IO [String]
rpmspecDynBuildRequires String
spec
[String]
provs <- do
[String]
dynprovs <-
if String
"golang-" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String -> String
takeBaseName String
spec
then do
[String]
macro <- String -> String -> IO [String]
grep String
"%global goipath" String
spec
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
case [String]
macro of
[String
def] -> [String
"golang(" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> a
last (String -> [String]
words String
def) forall a. [a] -> [a] -> [a]
++ String
")"]
[String]
_ -> forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ String
"failed to find %goipath in " forall a. [a] -> [a] -> [a]
++ String
spec
else forall (m :: * -> *) a. Monad m => a -> m a
return []
[String]
prs <- String -> IO [String]
rpmspecProvides String
spec
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String]
dynprovs forall a. [a] -> [a] -> [a]
++ [String]
prs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ([String]
provs,[String]
brs)
else do
Maybe String
mcontent <- String -> IO (Maybe String)
rpmspecParse String
spec
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe String
mcontent of
Maybe String
Nothing -> forall a. Maybe a
Nothing
Just String
content ->
let pkg :: String
pkg = String -> String
takeBaseName String
spec
in forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ([String], [String]) -> [String] -> ([String], [String])
extractMetadata String
pkg ([],[]) forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
content
case Maybe ([String], [String])
mprovbrs of
Maybe ([String], [String])
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just ([String]
provs,[String]
brs) -> do
let provs' :: [String]
provs' = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"(x86-64)" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`)) [String]
provs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
warning forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort [String]
provs'
String -> IO ()
warning forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe String
simplifyDep forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort [String]
brs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (String
path,
forall a. Eq a => [a] -> [a]
nub [String]
provs',
forall a. Eq a => [a] -> [a]
nub (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe String
simplifyDep [String]
brs) forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
ignoredBRs)
where
findSpec :: IO (Maybe (FilePath,FilePath))
findSpec :: IO (Maybe (String, String))
findSpec =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> (String, String)
splitFileName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
if String -> String
takeExtension String
path forall a. Eq a => a -> a -> Bool
== String
".spec"
then Bool -> String -> IO (Maybe String)
checkFile Bool
lenient String
path
else do
Bool
dirp <- String -> IO Bool
doesDirectoryExist String
path
if Bool
dirp
then do
let dir :: String
dir = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
path (String
path String -> String -> String
</>) Maybe String
mdir
dirname :: String
dirname = String -> String
takeFileName forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [a]
dropSuffix String
"/" String
path
Maybe String
mspec <- Bool -> String -> IO (Maybe String)
checkFile Bool
True forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
dirname forall a. [a] -> [a] -> [a]
++ String
".spec"
case Maybe String
mspec of
Just String
spec -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
spec
Maybe String
Nothing -> do
Bool
dead <- String -> IO Bool
doesFileExist forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"dead.package"
if Bool
dead then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else do
[String]
specs <- String -> String -> IO [String]
filesWithExtension String
dir String
".spec"
case [String]
specs of
[String
spec] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
spec
[String]
_ -> if Bool
lenient then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
specs
then String
"No spec file found in " forall a. [a] -> [a] -> [a]
++ String
path
else String
"More than one .spec file found in " forall a. [a] -> [a] -> [a]
++ String
dir
else forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ String
"No spec file found for " forall a. [a] -> [a] -> [a]
++ String
path
where
checkFile :: Bool -> FilePath -> IO (Maybe FilePath)
checkFile :: Bool -> String -> IO (Maybe String)
checkFile Bool
may String
f = do
Bool
e <- String -> IO Bool
doesFileExist String
f
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
e
then forall a. a -> Maybe a
Just String
f
else if Bool
may
then forall a. Maybe a
Nothing
else forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ String
f forall a. [a] -> [a] -> [a]
++ String
" not found"
extractMetadata :: FilePath -> ([String],[String]) -> [String] -> ([String],[String])
extractMetadata :: String -> ([String], [String]) -> [String] -> ([String], [String])
extractMetadata String
_ ([String], [String])
acc [] = ([String], [String])
acc
extractMetadata String
pkg acc :: ([String], [String])
acc@([String]
provs,[String]
brs) (String
l:[String]
ls) =
let ws :: [String]
ws = String -> [String]
words String
l in
if forall (t :: * -> *) a. Foldable t => t a -> Node
length [String]
ws forall a. Ord a => a -> a -> Bool
< Node
2 then String -> ([String], [String]) -> [String] -> ([String], [String])
extractMetadata String
pkg ([String], [String])
acc [String]
ls
else case forall s. FoldCase s => s -> CI s
CI.mk (forall a. [a] -> a
head [String]
ws) of
CI String
"BuildRequires:" ->
let br :: String
br = (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
tail) [String]
ws
brs' :: [String]
brs' = if String
br forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ignoredBRs then [String]
brs else String
brforall a. a -> [a] -> [a]
:[String]
brs
in String -> ([String], [String]) -> [String] -> ([String], [String])
extractMetadata String
pkg ([String]
provs, [String]
brs') [String]
ls
CI String
"Name:" -> String -> ([String], [String]) -> [String] -> ([String], [String])
extractMetadata String
pkg ((forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
tail) [String]
ws forall a. a -> [a] -> [a]
: [String]
provs, [String]
brs) [String]
ls
CI String
"Provides:" -> String -> ([String], [String]) -> [String] -> ([String], [String])
extractMetadata String
pkg ((forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
tail) [String]
ws forall a. a -> [a] -> [a]
: [String]
provs, [String]
brs) [String]
ls
CI String
"%package" ->
let subpkg :: String
subpkg =
let sub :: String
sub = forall a. [a] -> a
last [String]
ws in
if forall (t :: * -> *) a. Foldable t => t a -> Node
length [String]
ws forall a. Eq a => a -> a -> Bool
== Node
2
then String
pkg forall a. [a] -> [a] -> [a]
++ Char
'-' forall a. a -> [a] -> [a]
: String
sub
else String
sub
in String -> ([String], [String]) -> [String] -> ([String], [String])
extractMetadata String
pkg (String
subpkg forall a. a -> [a] -> [a]
: [String]
provs, [String]
brs) [String]
ls
CI String
_ -> String -> ([String], [String]) -> [String] -> ([String], [String])
extractMetadata String
pkg ([String], [String])
acc [String]
ls
getBuildGraph :: [SourcePackage] -> PackageGraph
getBuildGraph :: [SourcePackage] -> PackageGraph
getBuildGraph [SourcePackage]
srcPkgs =
let nodes :: [(Node, SourcePackage)]
nodes = forall a b. [a] -> [b] -> [(a, b)]
zip [Node
0..] [SourcePackage]
srcPkgs
nodeDict :: [(String, Node)]
nodeDict = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map SourcePackage -> String
packagePath [SourcePackage]
srcPkgs) [Node
0..]
edges :: [LEdge ()]
edges = do
(Node
srcNode,SourcePackage
srcPkg) <- [(Node, SourcePackage)]
nodes
Node
dstNode <- forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(String, Node)]
nodeDict) (SourcePackage -> [String]
dependencies SourcePackage
srcPkg)
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Node
dstNode forall a. Eq a => a -> a -> Bool
/= Node
srcNode)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
rev
then (Node
dstNode, Node
srcNode, ())
else (Node
srcNode, Node
dstNode, ())
in forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
G.mkGraph (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SourcePackage -> String
packagePath) [(Node, SourcePackage)]
nodes) forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub [LEdge ()]
edges
checkForCycles :: PackageGraph -> IO ()
checkForCycles :: PackageGraph -> IO ()
checkForCycles PackageGraph
graph = do
let cycles :: [[Node]]
cycles = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
>= Node
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Node
length) (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [[Node]]
scc PackageGraph
graph)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Node]]
cycles) forall a b. (a -> b) -> a -> b
$ do
let plural :: String
plural = if forall (t :: * -> *) a. Foldable t => t a -> Node
length [[Node]]
cycles forall a. Ord a => a -> a -> Bool
> Node
1 then String
"s" else String
""
forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
(String
"ordering not possible due to build dependency cycle" forall a. [a] -> [a] -> [a]
++ String
plural forall a. [a] -> [a] -> [a]
++ String
":\n") forall a. a -> [a] -> [a]
: forall a. [a] -> [[a]] -> [a]
intercalate [String
""] (forall a b. (a -> b) -> [a] -> [b]
map (([String], [[String]]) -> [String]
renderCycles forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> ([String], [[String]])
subcycles) [[Node]]
cycles)
where
subcycles :: [G.Node] -> ([FilePath],[[FilePath]])
subcycles :: [Node] -> ([String], [[String]])
subcycles [] = forall a. HasCallStack => String -> a
error String
"cyclic graph with no nodes!"
subcycles [Node]
cycle' =
let shorter :: [[Node]]
shorter = forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall (t :: * -> *) a. Foldable t => t a -> Node
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Node
length [Node]
cycle') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Node
length) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {c}. (Node, Node, c) -> Maybe [Node]
findSp forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
G.labEdges Gr String Node
sg
in (forall a b. Gr a b -> [Node] -> [a]
nodeLabels PackageGraph
graph [Node]
cycle', forall a b. (a -> b) -> [a] -> [b]
map (forall a b. Gr a b -> [Node] -> [a]
nodeLabels Gr String Node
sg) [[Node]]
shorter)
where
sg :: Gr String Node
sg = forall (gr :: * -> * -> *) b c a.
DynGraph gr =>
(b -> c) -> gr a b -> gr a c
G.emap (forall a b. a -> b -> a
const (Node
1 :: Int)) forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[Node] -> gr a b -> gr a b
G.subgraph [Node]
cycle' PackageGraph
graph
findSp :: (Node, Node, c) -> Maybe [Node]
findSp (Node
i,Node
j,c
_) | forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Edge -> Bool
G.hasEdge Gr String Node
sg (Node
i,Node
j) = forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Node -> Node -> gr a b -> Maybe [Node]
sp Node
j Node
i Gr String Node
sg
| forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Edge -> Bool
G.hasEdge Gr String Node
sg (Node
j,Node
i) = forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Node -> Node -> gr a b -> Maybe [Node]
sp Node
i Node
j Gr String Node
sg
| Bool
otherwise = forall a. Maybe a
Nothing
renderCycles :: ([FilePath],[[FilePath]]) -> [String]
renderCycles :: ([String], [[String]]) -> [String]
renderCycles ([String]
c,[[String]]
sc) =
[String] -> String
unwords [String]
c forall a. a -> [a] -> [a]
: if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[String]]
sc then [] else String
"\nShortest path subcycles: " forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unwords [[String]]
sc
getDepsSrcResolved :: [(FilePath,[String],[String])] -> FilePath -> Maybe [FilePath]
getDepsSrcResolved :: [(String, [String], [String])] -> String -> Maybe [String]
getDepsSrcResolved [(String, [String], [String])]
metadata String
pkg =
forall a b. (a -> b) -> [a] -> [b]
map String -> String
resolveBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b} {c}. (a, b, c) -> c
thd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== String
pkg) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a, b, c) -> a
fst3) [(String, [String], [String])]
metadata
where
resolveBase :: FilePath -> FilePath
resolveBase :: String -> String
resolveBase String
br =
case forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\ (String
p,[String]
provs,[String]
_) -> if String
br forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
provs then forall a. a -> Maybe a
Just String
p else forall a. Maybe a
Nothing) [(String, [String], [String])]
metadata of
[] -> String
br
[String
p] -> String
p
[String]
ps -> forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ String
pkg forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
br forall a. [a] -> [a] -> [a]
++ String
" is provided by: " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
ps
thd :: (a, b, c) -> c
thd (a
_,b
_,c
c) = c
c
fst3 :: (a,b,c) -> a
fst3 :: forall a b c. (a, b, c) -> a
fst3 (a
a,b
_,c
_) = a
a
nodeLabels :: Gr a b -> [G.Node] -> [a]
nodeLabels :: forall a b. Gr a b -> [Node] -> [a]
nodeLabels Gr a b
graph =
forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"node not found in graph") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> Maybe a
G.lab Gr a b
graph)
rpmspecParse :: FilePath -> IO (Maybe String)
rpmspecParse :: String -> IO (Maybe String)
rpmspecParse String
spec = do
(Bool
ok, String
out, String
err) <- String -> [String] -> String -> IO (Bool, String, String)
cmdFull String
"rpmspec" ([String
"-P", String
"--define", String
"ghc_version any"] forall a. [a] -> [a] -> [a]
++ [String]
rpmopts forall a. [a] -> [a] -> [a]
++ [String
spec]) String
""
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
err) forall a b. (a -> b) -> a -> b
$ String -> IO ()
warning forall a b. (a -> b) -> a -> b
$ String
spec String -> String -> String
+-+ String
err
if Bool
ok
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
out
else if Bool
lenient then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else forall a. IO a
exitFailure
rpmspecProvides :: FilePath -> IO [String]
rpmspecProvides :: String -> IO [String]
rpmspecProvides String
spec = do
(Bool
ok, String
out, String
err) <- String -> [String] -> String -> IO (Bool, String, String)
cmdFull String
"rpmspec" ([String
"--define", String
"ghc_version any", String
"-q", String
"--provides"] forall a. [a] -> [a] -> [a]
++ [String]
rpmopts forall a. [a] -> [a] -> [a]
++ [String
spec]) String
""
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
err) forall a b. (a -> b) -> a -> b
$ String -> IO ()
warning String
err
if Bool
ok
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
out
else if Bool
lenient then forall (m :: * -> *) a. Monad m => a -> m a
return [] else forall a. IO a
exitFailure
rpmspecDynBuildRequires :: FilePath -> IO [String]
rpmspecDynBuildRequires :: String -> IO [String]
rpmspecDynBuildRequires String
spec = do
String
cwd <- IO String
getCurrentDirectory
forall a. (String -> IO a) -> IO a
withTempDir forall a b. (a -> b) -> a -> b
$ \String
tmpdir -> do
(String
out,String
err) <- String -> [String] -> IO (String, String)
cmdStdErr String
"rpmbuild" [String
"-br", String
"--nodeps", String
"--define", String
"_srcrpmdir " forall a. [a] -> [a] -> [a]
++ String
tmpdir, String
cwd String -> String -> String
</> String
spec]
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
err) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose forall a b. (a -> b) -> a -> b
$ String -> IO ()
warning String
err
case String -> [String]
words String
out of
[] -> forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ String
spec String -> String -> String
+-+ String
"could not generate source rpm for dynamic buildrequires"
[String]
ws -> String -> [String] -> IO [String]
cmdLines String
"rpm" [String
"-qp", String
"--requires", forall a. [a] -> a
last [String]
ws]
simplifyDep :: String -> Maybe String
simplifyDep String
br =
case (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) String
br of
Char
'(':String
dep -> String -> Maybe String
simplifyDep String
dep
String
dep -> case forall a. (HasCallStack, Eq a) => [a] -> [a] -> [[a]]
splitOn String
"(" (forall a. Eq a => [a] -> [a] -> [a]
dropSuffix String
")" String
dep) of
(String
"rpmlib":[String]
_) -> forall a. Maybe a
Nothing
(String
"crate":[String
crate]) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
"rust-" forall a. [a] -> [a] -> [a]
++ forall a. (HasCallStack, Eq a) => [a] -> [a] -> [a] -> [a]
replace String
"/" String
"+" String
crate forall a. [a] -> [a] -> [a]
++ String
"-devel"
(String
"rubygem":[String
gem]) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
"rubygem-" forall a. [a] -> [a] -> [a]
++ String
gem
[String]
_ -> forall a. a -> Maybe a
Just String
dep
createGraph'''' :: Bool
-> [String]
-> [String]
-> Bool
-> Bool
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
createGraph'''' :: Bool
-> [String]
-> [String]
-> Bool
-> Bool
-> Bool
-> Maybe String
-> [String]
-> IO PackageGraph
createGraph'''' = Bool
-> [String]
-> [String]
-> Bool
-> Bool
-> Bool
-> Maybe String
-> [String]
-> IO PackageGraph
createGraph4
subgraph' :: Gr a b -> [G.Node] -> Gr a b
subgraph' :: forall a b. Gr a b -> [Node] -> Gr a b
subgraph' = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[Node] -> gr a b -> gr a b
G.subgraph
packageLayers :: PackageGraph -> [[FilePath]]
packageLayers :: PackageGraph -> [[String]]
packageLayers PackageGraph
graph =
if forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
G.isEmpty PackageGraph
graph then []
else
let layer :: [LNode String]
layer = PackageGraph -> [LNode String]
lowestLayer' PackageGraph
graph
in forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [LNode String]
layer forall a. a -> [a] -> [a]
: PackageGraph -> [[String]]
packageLayers (forall (gr :: * -> * -> *) a b.
Graph gr =>
[Node] -> gr a b -> gr a b
G.delNodes (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [LNode String]
layer) PackageGraph
graph)
lowestLayer :: PackageGraph -> [FilePath]
lowestLayer :: PackageGraph -> [String]
lowestLayer PackageGraph
graph =
forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
G.labNodes forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b.
DynGraph gr =>
(Node -> Bool) -> gr a b -> gr a b
G.nfilter ((forall a. Eq a => a -> a -> Bool
==Node
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Node -> Node
G.indeg PackageGraph
graph) PackageGraph
graph
lowestLayer' :: PackageGraph -> [G.LNode FilePath]
lowestLayer' :: PackageGraph -> [LNode String]
lowestLayer' PackageGraph
graph =
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
G.labNodes forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b.
DynGraph gr =>
(Node -> Bool) -> gr a b -> gr a b
G.nfilter ((forall a. Eq a => a -> a -> Bool
==Node
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Node -> Node
G.indeg PackageGraph
graph) PackageGraph
graph
packageLeaves :: PackageGraph -> [FilePath]
packageLeaves :: PackageGraph -> [String]
packageLeaves PackageGraph
graph =
forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
G.labNodes forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b.
DynGraph gr =>
(Node -> Bool) -> gr a b -> gr a b
G.nfilter ((forall a. Eq a => a -> a -> Bool
==Node
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Node -> Node
G.outdeg PackageGraph
graph) PackageGraph
graph
separatePackages :: PackageGraph -> [FilePath]
separatePackages :: PackageGraph -> [String]
separatePackages PackageGraph
graph =
forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
G.labNodes forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b.
DynGraph gr =>
(Node -> Bool) -> gr a b -> gr a b
G.nfilter ((forall a. Eq a => a -> a -> Bool
==Node
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Node -> Node
G.deg PackageGraph
graph) PackageGraph
graph
printGraph :: PackageGraph -> IO ()
printGraph :: PackageGraph -> IO ()
printGraph PackageGraph
g = do
String -> IO ()
putStrLn String
"digraph {"
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
G.labNodes PackageGraph
g) forall a b. (a -> b) -> a -> b
$ \ (Node
n,String
l) -> do
String -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show String
l
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [String] -> String
renderDeps forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> Maybe a
G.lab PackageGraph
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> [(Node, b)]
G.lsuc PackageGraph
g Node
n
String -> IO ()
putStrLn String
"}"
where
renderDeps :: [String] -> String
renderDeps :: [String] -> String
renderDeps [] = String
""
renderDeps [String
d] = String
" -> " forall a. [a] -> [a] -> [a]
++ String
d
renderDeps [String]
ds = String
" -> {" forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
ds forall a. [a] -> [a] -> [a]
++ String
"}"
renderGraph :: PackageGraph -> IO ()
renderGraph :: PackageGraph -> IO ()
renderGraph PackageGraph
graph = do
Bool
gv <- IO Bool
isGraphvizInstalled
if Bool
gv
then do
let g :: Gr String String
g = forall (gr :: * -> * -> *) b c a.
DynGraph gr =>
(b -> c) -> gr a b -> gr a c
G.emap (forall a b. a -> b -> a
const (String
"" :: String)) PackageGraph
graph
forall (dg :: * -> *) n.
PrintDotRepr dg n =>
dg n -> GraphvizCanvas -> IO ()
runGraphvizCanvas' (forall el (gr :: * -> * -> *) nl cl l a.
(Ord el, Graph gr) =>
(GraphvizParams Node nl el cl l -> gr nl el -> a)
-> GraphvizParams Node nl el cl l -> gr nl el -> a
setDirectedness forall cl (gr :: * -> * -> *) nl el l.
(Ord cl, Graph gr) =>
GraphvizParams Node nl el cl l -> gr nl el -> DotGraph Node
graphToDot forall nl el n.
(Labellable nl, Labellable el) =>
GraphvizParams n nl el () nl
quickParams Gr String String
g) GraphvizCanvas
Xlib
else forall a. String -> a
error' String
"please install graphviz first"
depsGraph :: Bool
-> [String]
-> Bool
-> [String]
-> [String]
-> Bool
-> Maybe FilePath
-> [FilePath]
-> IO PackageGraph
depsGraph :: Bool
-> [String]
-> Bool
-> [String]
-> [String]
-> Bool
-> Maybe String
-> [String]
-> IO PackageGraph
depsGraph Bool
rev [String]
rpmopts Bool
verbose [String]
excludedPkgs [String]
ignoredBRs Bool
lenient Maybe String
mdir [String]
pkgs =
String -> IO [String]
listDirectory String
"." forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Bool
-> [String]
-> Bool
-> [String]
-> [String]
-> Bool
-> Maybe String
-> [String]
-> [String]
-> IO PackageGraph
depsGraphDeps Bool
rev [String]
rpmopts Bool
verbose [String]
excludedPkgs [String]
ignoredBRs Bool
lenient Maybe String
mdir [String]
pkgs
depsGraphDeps :: Bool
-> [String]
-> Bool
-> [String]
-> [String]
-> Bool
-> Maybe FilePath
-> [FilePath]
-> [FilePath]
-> IO PackageGraph
depsGraphDeps :: Bool
-> [String]
-> Bool
-> [String]
-> [String]
-> Bool
-> Maybe String
-> [String]
-> [String]
-> IO PackageGraph
depsGraphDeps Bool
rev [String]
rpmopts Bool
verbose [String]
excludedPkgs [String]
ignoredBRs Bool
lenient Maybe String
mdir [String]
pkgs [String]
deps = do
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO Bool
doesDirectoryExist [String]
pkgs) forall a b. (a -> b) -> a -> b
$
forall a. String -> a
errorWithoutStackTrace String
"Please use package directory paths"
[String]
-> [String]
-> Bool
-> Bool
-> Bool
-> Maybe String
-> [String]
-> IO PackageGraph
createGraph3 [String]
ignoredBRs [String]
rpmopts Bool
verbose Bool
lenient (Bool -> Bool
not Bool
rev) Maybe String
mdir (forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= Char
'.') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head) (forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
excludedPkgs) [String]
deps)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
[String]
-> Bool
-> Bool
-> Bool
-> Maybe String
-> [String]
-> IO PackageGraph
createGraph2 [String]
rpmopts Bool
verbose Bool
lenient Bool
True Maybe String
mdir forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> PackageGraph -> [String]
dependencyNodes [String]
pkgs
data Components = Parallel
| Combine
| Connected
| Separate
topsortGraph :: Components -> PackageGraph -> [[String]]
topsortGraph :: Components -> PackageGraph -> [[String]]
topsortGraph Components
opt PackageGraph
graph =
case Components
opt of
Components
Parallel -> forall a b. (a -> b) -> [a] -> [b]
map (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [a]
topsort' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Gr a b -> [Node] -> Gr a b
subgraph' PackageGraph
graph) (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [[Node]]
components PackageGraph
graph)
Components
Combine -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [a]
topsort' PackageGraph
graph
Components
Connected ->
forall a b. (a -> b) -> [a] -> [b]
map (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [a]
topsort' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Gr a b -> [Node] -> Gr a b
subgraph' PackageGraph
graph) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
>Node
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Node
length) (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [[Node]]
components PackageGraph
graph)
Components
Separate -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PackageGraph -> [String]
separatePackages PackageGraph
graph
#if !MIN_VERSION_simple_cmd(0,2,4)
filesWithExtension :: FilePath -> String -> IO [FilePath]
filesWithExtension dir ext =
filter (ext `isExtensionOf`) <$> listDirectory dir
#if !MIN_VERSION_filepath(1,4,2)
isExtensionOf :: String -> FilePath -> Bool
isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions
isExtensionOf ext = isSuffixOf ('.':ext) . takeExtensions
#endif
#endif