diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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) diff --git a/Main.hs b/Main.hs deleted file mode 100644 --- a/Main.hs +++ /dev/null @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -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 diff --git a/rpmbuild-order.1 b/rpmbuild-order.1 --- a/rpmbuild-order.1 +++ b/rpmbuild-order.1 @@ -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 diff --git a/rpmbuild-order.cabal b/rpmbuild-order.cabal --- a/rpmbuild-order.cabal +++ b/rpmbuild-order.cabal @@ -1,5 +1,5 @@ Name: rpmbuild-order -Version: 0.3.1 +Version: 0.4.0 License: BSD3 License-File: LICENSE Author: Henning Thielemann @@ -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 diff --git a/src/Distribution/RPM/Build/Graph.hs b/src/Distribution/RPM/Build/Graph.hs new file mode 100644 --- /dev/null +++ b/src/Distribution/RPM/Build/Graph.hs @@ -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 diff --git a/src/Distribution/RPM/Build/Order.hs b/src/Distribution/RPM/Build/Order.hs new file mode 100644 --- /dev/null +++ b/src/Distribution/RPM/Build/Order.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -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"]) diff --git a/test/pkgs/A/A.spec b/test/pkgs/A/A.spec new file mode 100644 --- /dev/null +++ b/test/pkgs/A/A.spec @@ -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 +- diff --git a/test/pkgs/B/B.spec b/test/pkgs/B/B.spec new file mode 100644 --- /dev/null +++ b/test/pkgs/B/B.spec @@ -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 +- diff --git a/test/pkgs/C/C.spec b/test/pkgs/C/C.spec new file mode 100644 --- /dev/null +++ b/test/pkgs/C/C.spec @@ -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 +- diff --git a/test/pkgs/D1.0/D1.0.spec b/test/pkgs/D1.0/D1.0.spec new file mode 100644 --- /dev/null +++ b/test/pkgs/D1.0/D1.0.spec @@ -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 +-