rpmbuild-order 0.3.1 → 0.4.0
raw patch · 14 files changed
+691/−221 lines, 14 filesdep +case-insensitivedep +extradep +hspecdep ~base
Dependencies added: case-insensitive, extra, hspec, rpmbuild-order
Dependency ranges changed: base
Files
- ChangeLog.md +18/−0
- Main.hs +0/−200
- README.md +12/−8
- TODO +13/−1
- rpmbuild-order.1 +15/−3
- rpmbuild-order.cabal +64/−9
- src/Distribution/RPM/Build/Graph.hs +253/−0
- src/Distribution/RPM/Build/Order.hs +81/−0
- src/Main.hs +113/−0
- test/Spec.hs +46/−0
- test/pkgs/A/A.spec +19/−0
- test/pkgs/B/B.spec +27/−0
- test/pkgs/C/C.spec +15/−0
- test/pkgs/D1.0/D1.0.spec +15/−0
ChangeLog.md view
@@ -1,3 +1,21 @@+# 0.4.0 (2020-07-29)+- performance: rework just to use String and only parse spec files once+ and also use faster PatriciaTree.Gr+ On about 500 packages roughly twice as fast as 0.3.1+- sort now defaults to outputting separate dependency stacks, with options for combined, connected, and independent packages only+- new 'layers' command outputs packages in ordered dependency independent layers+- new 'chain' command outputs Fedora chain-build format+- new 'leaves' commands to list outer leaf packages+- new 'roots' commands lists lowest dependencies+- new library exposed with 2 modules: low-level Graph and high-level Order:+ - Distribution.RPM.Build.Order provides: dependencySort, dependencySortParallel,+ dependencyLayers, sortGraph output+ - Distribution.RPM.Build.Graph provides: createGraph, dependencyNodes,+ subgraph', packageLayers, etc+- graph Nodes are now only labelled by package/spec filepath+ and no longer carry redundant dependency lists+- add a basic testsuite for the library+ # 0.3.1 (2020-07-04) - fix detection of circular dependencies (bug introduced in 0.3)
− Main.hs
@@ -1,200 +0,0 @@-{-# LANGUAGE CPP #-}--import Data.Graph.Inductive.Query.DFS (xdfsWith, topsort', scc, components)-import Data.Graph.Inductive.Tree (Gr)-import qualified Data.Graph.Inductive.Graph as Graph--import qualified Data.Set as Set-import Control.Applicative (some,-#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))-#else- (<$>), (<*>)-#endif- )-import Control.Monad (guard, when, unless)-import qualified Data.ByteString.Char8 as B-import Data.Maybe (catMaybes, fromMaybe, mapMaybe)-import Data.List (delete)-import Options.Applicative (str)-import System.Directory (doesDirectoryExist, doesFileExist,-#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,5))- listDirectory-#else- getDirectoryContents-#endif- )-import System.Exit (ExitCode (..), exitFailure)-import System.FilePath--- replace with warning-import System.IO (hPutStrLn, stderr)-import System.Process (readProcessWithExitCode)--import SimpleCmdArgs-import Paths_rpmbuild_order (version)--#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,5))-#else-listDirectory :: FilePath -> IO [FilePath]-listDirectory path =- filter f <$> getDirectoryContents path- where f filename = filename /= "." && filename /= ".."-#endif--main :: IO ()-main =- simpleCmdArgs (Just version) "Order packages by build dependencies"- "Sort package sources (spec files) in build dependency order" $- subcommands- [ Subcommand "sort" "sort packages" $- sortSpecFiles <$> verboseOpt <*> lenientOpt <*> parallelOpt <*> subdirOpt <*> pkgArgs- , Subcommand "deps" "sort dependencies" $- depsSpecFiles False <$> verboseOpt <*> lenientOpt <*> parallelOpt <*> subdirOpt <*> pkgArgs- , Subcommand "rdeps" "sort dependents" $- depsSpecFiles True <$> verboseOpt <*> lenientOpt <*> parallelOpt <*> subdirOpt <*> pkgArgs- ]- where- verboseOpt = switchWith 'v' "verbose" "Verbose output for debugging"- lenientOpt = switchWith 'l' "lenient" "Ignore rpmspec errors"- parallelOpt = switchWith 'p' "parallel" "Separate independent packages"- subdirOpt = optional (strOptionWith 'd' "dir" "SUBDIR" "Branch directory")- pkgArgs = some (argumentWith str "PKG...")--findSpec :: Maybe FilePath -> FilePath -> IO (Maybe FilePath)-findSpec mdir file =- if takeExtension file == ".spec"- then checkFile file- else do- dirp <- doesDirectoryExist file- if dirp- then- let dir = maybe file (file </>) mdir- pkg = takeBaseName file in- checkFile $ dir </> pkg ++ ".spec"- else error $ "No spec file found for " ++ file- where- checkFile :: FilePath -> IO (Maybe FilePath)- checkFile f = do- e <- doesFileExist f- if e- then return $ Just f- else return Nothing--type Package = B.ByteString--data SourcePackage =- SourcePackage {- location :: FilePath,- package :: Package,- dependencies :: [Package]- }- deriving (Show, Eq)--createGraphNodes :: Bool -> Bool -> Maybe FilePath -> [Package] -> [Package] ->- IO (Gr SourcePackage (), [Graph.Node])-createGraphNodes verbose lenient mdir pkgs subset = do- unless (all (`elem` pkgs) subset) $- error "Packages must be in the current directory"- specPaths <- catMaybes <$> mapM (findSpec mdir . B.unpack) pkgs- let names = map (B.pack . takeBaseName) specPaths- resolves <- catMaybes <$> mapM (readProvides verbose lenient) specPaths- deps <- catMaybes <$> mapM (getDepsSrcResolved verbose lenient resolves) specPaths- let spkgs = zipWith3 SourcePackage specPaths names deps- graph = getBuildGraph spkgs- checkForCycles graph- let nodes = Graph.labNodes graph- subnodes = mapMaybe (pkgNode nodes) subset- return (graph, subnodes)- where- pkgNode [] _ = Nothing- pkgNode ((i,l):ns) p = if p == package l then Just i else pkgNode ns p--sortSpecFiles :: Bool -> Bool -> Bool -> Maybe FilePath -> [Package] -> IO ()-sortSpecFiles verbose lenient parallel mdir pkgs = do- (graph, _) <- createGraphNodes verbose lenient mdir pkgs []- if parallel then- mapM_ ((B.putStrLn . B.cons '\n' . B.unwords . map package) . topsort' . subgraph graph) (components graph)- else mapM_ (B.putStrLn . package) $ topsort' graph--depsSpecFiles :: Bool -> Bool -> Bool -> Bool -> Maybe FilePath -> [Package] -> IO ()-depsSpecFiles rev verbose lenient parallel mdir pkgs = do- allpkgs <- map B.pack . filter (\ f -> head f /= '.') <$> listDirectory "."- (graph, nodes) <- createGraphNodes verbose lenient mdir allpkgs pkgs- let direction = if rev then Graph.suc' else Graph.pre'- sortSpecFiles verbose lenient parallel mdir $ map package $ xdfsWith direction third nodes graph- where- third (_, _, c, _) = c--readProvides :: Bool -> Bool -> FilePath -> IO (Maybe (Package,[Package]))-readProvides verbose lenient file = do- when verbose $ hPutStrLn stderr file- mpkgs <- rpmspecQuery lenient ["-q", "--provides", "--define", "ghc_version any"] file- case mpkgs of- Nothing -> return Nothing- Just pkgs ->- let pkg = B.pack $ takeBaseName file in- return $ Just (pkg, delete pkg pkgs)--getDepsSrcResolved :: Bool -> Bool -> [(Package,[Package])] -> FilePath -> IO (Maybe [Package])-getDepsSrcResolved verbose lenient provides file = do- when verbose $ hPutStrLn stderr file- fmap (map resolveBase) <$>- rpmspecQuery lenient ["--buildrequires", "--define", "ghc_version any"] file- where- resolveBase :: Package -> Package- resolveBase br =- case mapMaybe (\ (pkg,subs) -> if br `elem` subs then Just pkg else Nothing) provides of- [] -> br- [p] -> p- ps -> error $ B.unpack br ++ " is provided by: " ++ (B.unpack . B.unwords) ps--getBuildGraph :: [SourcePackage] -> Gr SourcePackage ()-getBuildGraph srcPkgs =- let nodes = zip [0..] srcPkgs- nodeDict = zip (map package srcPkgs) [0..]- edges = do- (srcNode,srcPkg) <- nodes- dstNode <- mapMaybe (`lookup` nodeDict) (dependencies srcPkg)- guard (dstNode /= srcNode)- return (dstNode, srcNode, ())- in Graph.mkGraph nodes edges--checkForCycles :: Monad m => Gr SourcePackage () -> m ()-checkForCycles graph =- case getCycles graph of- [] -> return ()- cycles ->- error $ unlines $- "Cycles in dependencies:" :- map (unwords . map location . nodeLabels graph) cycles--nodeLabels :: Gr a b -> [Graph.Node] -> [a]-nodeLabels graph =- map (fromMaybe (error "node not found in graph") .- Graph.lab graph)--subgraph :: Gr a b -> [Graph.Node] -> Gr a b-subgraph graph nodes =- let nodeSet = Set.fromList nodes- edges = do- from <- nodes- (to, lab) <- Graph.lsuc graph from- guard $ Set.member from nodeSet && Set.member to nodeSet- return (from,to,lab)- in Graph.mkGraph (zip nodes $ nodeLabels graph nodes) edges--getCycles :: Gr a b -> [[Graph.Node]]-getCycles =- filter ((>= 2) . length) . scc---- returns the first word for each line-rpmspecQuery :: Bool -> [String] -> FilePath -> IO (Maybe [B.ByteString])-rpmspecQuery lenient args spec = do- (res, out, err) <- readProcessWithExitCode "rpmspec" (["-q"] ++ args ++ [spec]) ""- unless (null err) $ hPutStrLn stderr err- case res of- ExitFailure _ -> if lenient then return Nothing else exitFailure- ExitSuccess -> return $ Just $ map takeFirst $ B.lines (B.pack out)- where- -- ignore version bounds- takeFirst :: B.ByteString -> B.ByteString- takeFirst = head . B.words
README.md view
@@ -4,7 +4,7 @@ # rpmbuild-order -This package based on code from [cabal-sort](http://hackage.haskell.org/package/cabal-sort), sorts rpm package spec files by build order.+This package originally based on code from [cabal-sort](http://hackage.haskell.org/package/cabal-sort), sorts rpm package spec files by build order. $ rpmbuild-order --help $ rpmbuild-order sort mycore mylib myapp@@ -12,16 +12,16 @@ mycore myapp -The arguments passed can either be directories named after the package, or spec files.--By default it outputs the package names, but it can also output-the spec filenames or directory paths for easier scripting.+The arguments passed can either be directories containing the package, or spec files. Using the rpmbuild-order `deps` and `rdeps` commands the ordered dependencies and reverse dependencies of a package can be obtained from the current set of checked out package sources. -## Known problems+As of version 0.4, a library is also provided.+See the modules' documentation for details.++## Notes and known problems 1. Given packages A, B, C, where C depends on B, and B depends on A, and you call @@ -35,6 +35,10 @@ However the `deps` and `rdeps` commands take other neighbouring package directories into account. -2. repoquery is not used to resolve Requires or filelists for Provides.+2. repoquery is not used to resolve meta-dependencies or files to packages. So if a package BuildRequires a file, it will not be resolved to a package.-This may get addressed in a future version.+This may get addressed some day, but file dependencies seem less common for+BuildRequires than Requires.++3. rpmspec is used to parse spec files (for macro expansion etc):+so missing macros packages may lead to erroneous results.
TODO view
@@ -1,2 +1,14 @@-- add leaf command+- try topograph+ - better graph output+- Tests!!+ - testcase for circular deps: eg+ hspec -> hspec-core -> tf-random -> primitive -> base-orphans(tests) -> hspec++- use Set?++- warn about uninstalled macros packages++- handle duplicate packages?++- (r)deps: optimize using actual deps
rpmbuild-order.1 view
@@ -1,7 +1,7 @@-.\" DO NOT MODIFY THIS FILE! It was generated by help2man 1.47.11.-.TH RPMBUILD-ORDER "1" "October 2019" "rpmbuild-order 0.3" "User Commands"+.\" DO NOT MODIFY THIS FILE! It was generated by help2man 1.47.14.+.TH RPMBUILD-ORDER "1" "July 2020" "rpmbuild-order 0.4.0" "User Commands" .SH NAME-rpmbuild-order \- manual page for rpmbuild-order 0.3+rpmbuild-order \- manual page for rpmbuild-order 0.4.0 .SH SYNOPSIS .B rpmbuild-order [\fI\,--version\/\fR] \fI\,COMMAND\/\fR@@ -26,3 +26,15 @@ .TP rdeps sort dependents+.TP+layers+ordered output suitable for a chain\-build+.TP+chain+ordered output suitable for a chain\-build+.TP+leaves+List of the top leaves of package graph+.TP+roots+List lowest root packages
rpmbuild-order.cabal view
@@ -1,5 +1,5 @@ Name: rpmbuild-order-Version: 0.3.1+Version: 0.4.0 License: BSD3 License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -19,13 +19,19 @@ for one or more packages, provided all the packages are checked out in neighboring directories. This is also useful to see what packages are affected when a low-level package changes.++ Since version 0.4 there is a library too. Tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2,- GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.3+ GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.1 Cabal-Version: >=1.10 Build-Type: Simple Extra-source-files: README.md TODO ChangeLog.md rpmbuild-order.1+ test/pkgs/A/A.spec+ test/pkgs/B/B.spec+ test/pkgs/C/C.spec+ test/pkgs/D1.0/D1.0.spec source-repository head type: git@@ -34,16 +40,65 @@ Executable rpmbuild-order Build-Depends: base < 5, bytestring,- Cabal,- containers, directory,- filepath,+ extra, fgl, optparse-applicative,- process,+ rpmbuild-order, simple-cmd-args - GHC-Options: -Wall- Main-Is: Main.hs+ Main-Is: src/Main.hs Other-modules: Paths_rpmbuild_order- Default-language: Haskell2010+ GHC-Options: -Wall+ if impl(ghc >= 8.0)+ ghc-options: -Wcompat+ -Widentities+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wredundant-constraints+ if impl(ghc >= 8.2)+ ghc-options: -fhide-source-paths+ if impl(ghc >= 8.4)+ ghc-options: -Wmissing-export-lists+ -Wpartial-fields+ default-language: Haskell2010++Library+ Exposed-Modules: Distribution.RPM.Build.Graph+ Distribution.RPM.Build.Order+ Build-Depends: base < 5,+ Cabal,+ case-insensitive,+ containers,+ directory,+ extra,+ filepath,+ fgl,+ process+ HS-Source-Dirs: src+ GHC-Options: -Wall+ if impl(ghc >= 8.0)+ ghc-options: -Wcompat+ -Widentities+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wredundant-constraints+ if impl(ghc >= 8.2)+ ghc-options: -fhide-source-paths+ if impl(ghc >= 8.4)+ ghc-options: -Wmissing-export-lists+ -Wpartial-fields++ default-language: Haskell2010++test-suite test+ main-is: Spec.hs+ type: exitcode-stdio-1.0+ hs-source-dirs: test++ default-language: Haskell2010++ ghc-options: -Wall+ build-depends: base >= 4 && < 5+ , hspec >= 1.3+ , rpmbuild-order
+ src/Distribution/RPM/Build/Graph.hs view
@@ -0,0 +1,253 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+This module provides simple dependency graph making for rpm packages:++@+import "Distribution.RPM.Build.Graph"++graph <- 'createGraph' ["pkg1", "pkg2", "../pkg3"]+@+-}++module Distribution.RPM.Build.Graph+ (createGraph,+ createGraph',+ dependencyNodes,+ subgraph',+ packageLayers,+ lowestLayer,+ lowestLayer',+ packageLeaves,+ separatePackages,+ PackageGraph+ ) where++import qualified Data.CaseInsensitive as CI+import Data.Graph.Inductive.Query.DFS (scc, xdfsWith)+import Data.Graph.Inductive.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)+import System.Directory (doesDirectoryExist, doesFileExist,+#if !MIN_VERSION_directory(1,2,5)+ getDirectoryContents+#endif+ )+import System.Exit (ExitCode (..), exitFailure)+import System.FilePath+-- replace with warning+import System.IO (hPutStrLn, stderr)+import System.Process (readProcessWithExitCode)++#if !MIN_VERSION_directory(1,2,5)+listDirectory :: FilePath -> IO [FilePath]+listDirectory path =+ filter f <$> getDirectoryContents path+ where f filename = filename /= "." && filename /= ".."+#endif++data SourcePackage =+ SourcePackage {+ packagePath :: FilePath,+ dependencies :: [FilePath]+ }+ deriving Eq++-- | alias for a package dependency graph+type PackageGraph = Gr FilePath ()++-- | Get all of the dependencies of a subset of one or more packages within full PackageGraph.+-- The subset paths should be written in the same way as for the graph.+dependencyNodes :: [FilePath] -- ^ subset of packages to start from+ -> PackageGraph -- ^ dependency graph+ -> [FilePath] -- ^ dependencies of subset+dependencyNodes subset graph =+ let nodes = G.labNodes graph+ subnodes = mapMaybe (pkgNode nodes) subset+ in xdfsWith G.pre' third subnodes graph+ where+ pkgNode :: [G.LNode FilePath] -> FilePath -> Maybe Int+ pkgNode [] _ = Nothing+ pkgNode ((i,l):ns) p = if dropSuffix "/" p == dropSuffix "/" l then Just i else pkgNode ns p++ third (_, _, c, _) = c++-- | Create a directed dependency graph for a set of packages+-- This is a convenience wrapper for createGraph' False False True Nothing+createGraph :: [FilePath] -- ^ package paths (directories or spec filepaths)+ -> IO PackageGraph -- ^ dependency graph labelled by package paths+createGraph = createGraph' False False True Nothing++-- | Create a directed dependency graph for a set of packages+-- For the (createGraph default) reverse deps graph the arrows point back+-- from the dependencies to the dependendent (parent/consumer) packages,+-- and this allows forward sorting by dependencies (ie lowest deps first).+createGraph' :: Bool -- ^ verbose+ -> Bool -- ^ lenient (skip rpmspec failures)+ -> Bool -- ^ reverse dependency graph+ -> Maybe FilePath -- ^ look for spec file in a subdirectory+ -> [FilePath] -- ^ package paths (directories or spec filepaths)+ -> IO PackageGraph -- ^ dependency graph labelled by package paths+createGraph' verbose lenient rev mdir paths = do+ metadata <- catMaybes <$> mapM readSpecMetadata paths+ let realpkgs = map fst3 metadata+ deps = mapMaybe (getDepsSrcResolved metadata) realpkgs+ spkgs = zipWith SourcePackage realpkgs deps+ graph = getBuildGraph spkgs+ checkForCycles graph+ return graph+ where+ readSpecMetadata :: FilePath -> IO (Maybe (FilePath,[String],[String]))+ readSpecMetadata path = do+ mspec <- findSpec+ case mspec of+ Nothing -> return Nothing+ Just spec -> do+ when verbose $ hPutStrLn stderr spec+ mcontent <- rpmspecParse spec+ case mcontent of+ Nothing -> return Nothing+ Just content ->+ let pkg = takeBaseName spec+ (provs,brs) = extractMetadata pkg ([],[]) $ lines content+ in return (Just (path, provs, brs))+ where+ findSpec :: IO (Maybe FilePath)+ findSpec =+ if takeExtension path == ".spec"+ then checkFile lenient path+ else do+ dirp <- doesDirectoryExist path+ if dirp+ then do+ let dir = maybe path (path </>) mdir+ pkg = takeFileName $ dropSuffix "/" path+ mspec <- checkFile True $ dir </> pkg ++ ".spec"+ case mspec of+ Nothing -> do+ dead <- doesFileExist $ dir </> "dead.package"+ return $ if dead || lenient then Nothing+ else error $ "No spec file found in " ++ path+ Just spec -> return $ Just spec+ else error $ "No spec file found for " ++ path+ where+ checkFile :: Bool -> FilePath -> IO (Maybe FilePath)+ checkFile may f = do+ e <- doesFileExist f+ if e+ then return $ Just f+ else return $ if may+ then Nothing+ else error $ f ++ " not found"++ extractMetadata :: FilePath -> ([String],[String]) -> [String] -> ([String],[String])+ extractMetadata _ acc [] = acc+ extractMetadata pkg acc@(provs,brs) (l:ls) =+ let ws = words l in+ if length ws < 2 then extractMetadata pkg acc ls+ else case CI.mk (head ws) of+ "BuildRequires:" -> extractMetadata pkg (provs,(head . tail) ws : brs) ls+ "Name:" -> extractMetadata pkg ((head . tail) ws : provs, brs) ls+ "Provides:" -> extractMetadata pkg ((head . tail) ws : provs, brs) ls+ "%package" ->+ let subpkg =+ let sub = last ws in+ if length ws == 2+ then pkg ++ '-' : sub+ else sub+ in extractMetadata pkg (subpkg : provs, brs) ls+ _ -> extractMetadata pkg acc ls++ getBuildGraph :: [SourcePackage] -> PackageGraph+ getBuildGraph srcPkgs =+ let nodes = zip [0..] srcPkgs+ nodeDict = zip (map packagePath srcPkgs) [0..]+ edges = do+ (srcNode,srcPkg) <- nodes+ dstNode <- mapMaybe (`lookup` nodeDict) (dependencies srcPkg)+ guard (dstNode /= srcNode)+ return $ if rev+ then (dstNode, srcNode, ())+ else (srcNode, dstNode, ())+ in G.mkGraph (map (fmap packagePath) nodes) edges++ checkForCycles :: Monad m => PackageGraph -> m ()+ checkForCycles graph =+ case getCycles graph of+ [] -> return ()+ cycles ->+ error $ unlines $+ "Cycles in dependencies:" :+ map (unwords . nodeLabels graph) cycles+ where+ getCycles :: Gr a b -> [[G.Node]]+ getCycles =+ filter ((>= 2) . length) . scc++ getDepsSrcResolved :: [(FilePath,[String],[String])] -> FilePath -> Maybe [FilePath]+ getDepsSrcResolved metadata pkg =+ map resolveBase . thd <$> find ((== pkg) . fst3) metadata+ where+ resolveBase :: FilePath -> FilePath+ resolveBase br =+ case mapMaybe (\ (p,provs,_) -> if br `elem` provs then Just p else Nothing) metadata of+ [] -> br+ [p] -> p+ ps -> error $ pkg ++ ": " ++ br ++ " is provided by: " ++ unwords ps++ thd (_,_,c) = c++ fst3 :: (a,b,c) -> a+ fst3 (a,_,_) = a++ nodeLabels :: Gr a b -> [G.Node] -> [a]+ nodeLabels graph =+ map (fromMaybe (error "node not found in graph") .+ G.lab graph)++ rpmspecParse :: FilePath -> IO (Maybe String)+ rpmspecParse spec = do+ (res, out, err) <- readProcessWithExitCode "rpmspec" ["-P", "--define", "ghc_version any", spec] ""+ unless (null err) $ hPutStrLn stderr err+ case res of+ ExitFailure _ -> if lenient then return Nothing else exitFailure+ ExitSuccess -> return $ Just out++-- | A flipped version of subgraph+subgraph' :: Gr a b -> [G.Node] -> Gr a b+subgraph' = flip G.subgraph++-- | Return the bottom-up list of dependency layers of a graph+packageLayers :: PackageGraph -> [[FilePath]]+packageLayers graph =+ if G.isEmpty graph then []+ else+ let layer = lowestLayer' graph+ in map snd layer : packageLayers (G.delNodes (map fst layer) graph)++-- | The lowest dependencies of a PackageGraph+lowestLayer :: PackageGraph -> [FilePath]+lowestLayer graph =+ map snd $ G.labNodes $ G.nfilter ((==0) . G.indeg graph) graph++-- | The lowest dependency nodes of a PackageGraph+lowestLayer' :: PackageGraph -> [G.LNode FilePath]+lowestLayer' graph =+ G.labNodes $ G.nfilter ((==0) . G.indeg graph) graph++-- | The leaf (outer) packages of a PackageGraph+packageLeaves :: PackageGraph -> [FilePath]+packageLeaves graph =+ map snd $ G.labNodes $ G.nfilter ((==0) . G.outdeg graph) graph++-- | Returns packages independent of all the rest of the graph+separatePackages :: PackageGraph -> [FilePath]+separatePackages graph =+ map snd $ G.labNodes $ G.nfilter ((==0) . G.deg graph) graph
+ src/Distribution/RPM/Build/Order.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE CPP #-}++{-|+This module provides dependency sorting functions++@+import "Distribution.RPM.Build.Order"++'dependencySort' ["pkg1", "pkg2", "../pkg3"]++=> ["pkg2", "../pkg3", "pkg1"]+@+where pkg1 depends on pkg3, which depends on pkg2 say.++Package paths can be directories or spec files.+-}++module Distribution.RPM.Build.Order+ (dependencySort,+ dependencySortParallel,+ dependencyLayers,+ leafPackages,+ independentPackages,+ Components (..),+ sortGraph)+where++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>))+#endif+import Data.Graph.Inductive.Query.DFS (topsort', components)++import Distribution.RPM.Build.Graph++-- | sort packages by dependencies+dependencySort :: [FilePath] -> IO [FilePath]+dependencySort pkgs = do+ topsort' <$> createGraph pkgs++-- | dependency sort of packages in graph components+dependencySortParallel :: [FilePath] -> IO [[FilePath]]+dependencySortParallel pkgs = do+ graph <- createGraph pkgs+ return $ map (topsort' . subgraph' graph) (components graph)++-- | group packages in dependency layers, lowest first+dependencyLayers :: [FilePath] -> IO [[FilePath]]+dependencyLayers pkgs = do+ graph <- createGraph pkgs+ return $ packageLayers graph++-- | returns the leaves of a set of packages+leafPackages :: [FilePath] -> IO [FilePath]+leafPackages pkgs = do+ graph <- createGraph pkgs+ return $ packageLeaves graph++-- | returns independent packages among a set of packages+independentPackages :: [FilePath] -> IO [FilePath]+independentPackages pkgs = do+ graph <- createGraph pkgs+ return $ separatePackages graph++-- | Used to control the output from sortGraph+data Components = Parallel -- ^ separate independent stacks+ | Combine -- ^ combine indepdendent stacks together+ | Connected -- ^ only stack of pacakges+ | Separate -- ^ only independent packages in the package set++-- | output sorted packages from a PackageGraph arrange by Components+sortGraph :: Components -> PackageGraph -> IO ()+sortGraph opt graph = do+ case opt of+ Parallel ->+ mapM_ ((putStrLn . ('\n':) . unwords) . topsort' . subgraph' graph) (components graph)+ Combine -> (putStrLn . unwords . topsort') graph+ Connected ->+ mapM_ ((putStrLn . ('\n':) . unwords) . topsort' . subgraph' graph) $ filter ((>1) . length) (components graph)+ Separate ->+ let independent = separatePackages graph+ in mapM_ putStrLn independent
+ src/Main.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE CPP #-}++import Control.Applicative (+#if !MIN_VERSION_simple_cmd_args(0,1,3)+ (<|>),+#endif+#if !MIN_VERSION_simple_cmd_args(0,1,4)+ some,+#endif+#if !MIN_VERSION_base(4,8,0)+ (<$>), (<*>)+#endif+ )+import Control.Monad.Extra+import Data.Graph.Inductive.Query.DFS (components)+import Data.List++#if !MIN_VERSION_simple_cmd_args(0,1,4)+import Options.Applicative (str)+#endif+import SimpleCmdArgs+import System.Directory (doesDirectoryExist,+#if MIN_VERSION_directory(1,2,5)+ listDirectory+#else+ getDirectoryContents+#endif+ )++import Distribution.RPM.Build.Graph+import Distribution.RPM.Build.Order+import Paths_rpmbuild_order (version)++main :: IO ()+main =+ simpleCmdArgs (Just version) "Order packages by build dependencies"+ "Sort package sources (spec files) in build dependency order" $+ subcommands+ [ Subcommand "sort" "sort packages" $+ sortPackages <$> verboseOpt <*> lenientOpt <*> componentsOpt <*> subdirOpt <*> pkgArgs+ , Subcommand "deps" "sort dependencies" $+ depsPackages False <$> verboseOpt <*> lenientOpt <*> combineOpt <*> subdirOpt <*> pkgArgs+ , Subcommand "rdeps" "sort dependents" $+ depsPackages True <$> verboseOpt <*> lenientOpt <*> combineOpt <*> subdirOpt <*> pkgArgs+ , Subcommand "layers" "ordered output suitable for a chain-build" $+ layerPackages <$> verboseOpt <*> lenientOpt <*> combineOpt <*> subdirOpt <*> pkgArgs+ , Subcommand "chain" "ordered output suitable for a chain-build" $+ chainPackages <$> verboseOpt <*> lenientOpt <*> combineOpt <*> subdirOpt <*> pkgArgs+ , Subcommand "leaves" "List of the top leaves of package graph" $+ leavesPackages <$> verboseOpt <*> lenientOpt <*> subdirOpt <*> pkgArgs+ , Subcommand "roots" "List lowest root packages" $+ rootPackages <$> verboseOpt <*> lenientOpt <*> subdirOpt <*> pkgArgs+ ]+ where+ verboseOpt = switchWith 'v' "verbose" "Verbose output for debugging"+ lenientOpt = switchWith 'l' "lenient" "Ignore rpmspec errors"+ combineOpt = switchWith 'c' "combine" "Combine independent packages"+ subdirOpt = optional (strOptionWith 'd' "dir" "SUBDIR" "Branch directory")+ pkgArgs = some (argumentWith str "PKG...")+ componentsOpt =+ flagWith' Connected 'C' "connected" "Only include connected packages" <|>+ flagWith' Separate 'i' "independent" "Only list independent packages" <|>+ flagWith Parallel Combine 'c' "combine" "Combine connected and independent packages"++sortPackages :: Bool -> Bool -> Components -> Maybe FilePath -> [FilePath] -> IO ()+sortPackages verbose lenient opts mdir pkgs = do+ createGraph' verbose lenient True mdir pkgs >>= sortGraph opts++depsPackages :: Bool -> Bool -> Bool -> Bool -> Maybe FilePath -> [FilePath] -> IO ()+depsPackages rev verbose lenient parallel mdir pkgs = do+ unlessM (and <$> mapM doesDirectoryExist pkgs) $+ error "Please use package directory paths"+ listDirectory "." >>=+ -- filter out dotfiles+ createGraph' verbose lenient (not rev) mdir . filter ((/= '.') . head) >>=+ createGraph' verbose lenient True mdir . dependencyNodes pkgs >>=+ sortGraph (if parallel then Parallel else Combine)++#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,5))+#else+listDirectory :: FilePath -> IO [FilePath]+listDirectory path =+ filter f <$> getDirectoryContents path+ where f filename = filename /= "." && filename /= ".."+#endif++layerPackages :: Bool -> Bool -> Bool -> Maybe FilePath -> [FilePath] -> IO ()+layerPackages verbose lenient combine mdir pkgs = do+ graph <- createGraph' verbose lenient True mdir pkgs+ if combine then printLayers graph+ else mapM_ (printLayers . subgraph' graph) (components graph)+ where+ printLayers = putStrLn . unlines . map unwords . packageLayers++chainPackages :: Bool -> Bool -> Bool -> Maybe FilePath -> [FilePath] -> IO ()+chainPackages verbose lenient combine mdir pkgs = do+ graph <- createGraph' verbose lenient True mdir pkgs+ if combine then doChain graph+ else mapM_ (doChain . subgraph' graph) (components graph)+ where+ doChain graph =+ let chain = intercalate [":"] $ packageLayers graph+ in putStrLn $ unwords chain++leavesPackages :: Bool -> Bool -> Maybe FilePath -> [FilePath] -> IO ()+leavesPackages verbose lenient mdir pkgs = do+ graph <- createGraph' verbose lenient True mdir pkgs+ mapM_ putStrLn $ packageLeaves graph++rootPackages :: Bool -> Bool -> Maybe FilePath -> [FilePath] -> IO ()+rootPackages verbose lenient mdir pkgs = do+ graph <- createGraph' verbose lenient True mdir pkgs+ mapM_ putStrLn $ lowestLayer graph
+ test/Spec.hs view
@@ -0,0 +1,46 @@+import Test.Hspec+--import Distribution.RPM.Build.Graph+import Distribution.RPM.Build.Order++main :: IO ()+main = hspec spec++pkg :: FilePath -> FilePath+pkg = ("test/pkgs/" ++)++spec :: Spec+spec = do+ describe "sorting" $ do+ it "sort A B" $+ dependencySort [pkg "A", pkg "B"] >>=+ (`shouldBe` [pkg "B", pkg "A"])++ it "sort A/ B/" $+ dependencySort [pkg "A/", pkg "B/"] >>=+ (`shouldBe` [pkg "B/", pkg "A/"])++ it "sort A.spec B.spec" $+ dependencySort [pkg "A/A.spec", pkg "B/B.spec"] >>=+ (`shouldBe` [pkg "B/B.spec", pkg "A/A.spec"])++ it "sort A/ B.spec" $+ dependencySort [pkg "A/", pkg "B/B.spec"] >>=+ (`shouldBe` [pkg "B/B.spec", pkg "A/"])++ it "circular A B C" $+ dependencySort [pkg "A", pkg "B", pkg "C"]+ `shouldThrow` anyException++ it "sort A B D1.0" $+ dependencySort [pkg "A", pkg "B/", pkg "D1.0"] >>=+ (`shouldBe` [pkg "B/", pkg "D1.0", pkg "A"])++ describe "layers" $+ it "layers A B" $+ dependencyLayers [pkg "A", pkg "B"] >>=+ (`shouldBe` [[pkg "B"], [pkg "A"]])++ describe "leaves" $+ it "leaves A B D" $+ leafPackages [pkg "A", pkg "B", pkg "D1.0"] >>=+ (`shouldBe` [pkg "A", pkg "D1.0"])
+ test/pkgs/A/A.spec view
@@ -0,0 +1,19 @@+Name: A+Version: 1+Release: 1%{?dist}+Summary: package A+License: GPL+BuildRequires: B++%description+Test package A++%package -n C-A+Summary: A for C++%description -n C-A+A support for C++%changelog+* Wed Jul 29 13:38:27 +08 2020 Jens Petersen <petersen@redhat.com>+-
+ test/pkgs/B/B.spec view
@@ -0,0 +1,27 @@+Name: B+Version: 1+Release: 1%{?dist}+Summary: package B+License: GPL+BuildRequires: C++%description+Test package B++%package devel+Summary: B development++%description devel+B development files.++%prep++%build++%install++%files++%changelog+* Wed Jul 29 13:38:27 +08 2020 Jens Petersen <petersen@redhat.com>+-
+ test/pkgs/C/C.spec view
@@ -0,0 +1,15 @@+Name: C+Version: 1+Release: 1%{?dist}+Summary: package C+License: GPL+BuildRequires: C-A++%description+Circular dep++%files++%changelog+* Wed Jul 29 13:38:27 +08 2020 Jens Petersen <petersen@redhat.com>+-
+ test/pkgs/D1.0/D1.0.spec view
@@ -0,0 +1,15 @@+Name: D1.0+Version: 1+Release: 1%{?dist}+Summary: package D 1.0+License: GPL+BuildRequires: B-devel++%description+Package with dot++%files++%changelog+* Wed Jul 29 13:38:27 +08 2020 Jens Petersen <petersen@redhat.com>+-