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