cabal-sort 0.0.3.1 → 0.0.4
raw patch · 2 files changed
+135/−30 lines, 2 files
Files
- cabal-sort.cabal +11/−5
- src/CabalSort.hs +124/−25
cabal-sort.cabal view
@@ -1,5 +1,5 @@ Name: cabal-sort-Version: 0.0.3.1+Version: 0.0.4 License: BSD3 License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -42,17 +42,23 @@ Problem 2: We ignore flags and merge all dependencies. This may lead to dependency cycles that cannot occur for any flag assignment. .+ You also have options @--parallel@ and @--makefile@+ that support parallel compilation.+ The first option is for manual parallelization+ and the second one allows you to compile parallelly using+ @make@'s @-j@/@--jobs@ option.+ . There is a second program called @ghc-pkg-dep@ that finds recursively all packages that a set of packages depends on. Duplicates are eliminated and the packages are given topologically sorted, such that you can use this for recompilation of the packages.+ The packages must already be registered with @ghc-pkg@. . > ghc-pkg-dep pkgA-0.1 pkgB-2.3 pkgC-0.1.2 .- Unfortunately ghc-pkg runs quite slowly.+ On GHC versions before 7.0 ghc-pkg runs quite slowly. In order to not get bored you may run the program with @--verbose=2@ option.- Maybe there is a way to query the complete GHC package database at once.-Tested-With: GHC==6.10.4+Tested-With: GHC==6.10.4, GHC==6.12.3 Cabal-Version: >=1.6 Build-Type: Simple Source-Repository head@@ -62,7 +68,7 @@ Source-Repository this type: darcs location: http://code.haskell.org/~thielema/cabal-sort/- tag: 0.0.3.1+ tag: 0.0.4 Executable cabal-sort
src/CabalSort.hs view
@@ -13,25 +13,27 @@ import System.Console.GetOpt (getOpt, ArgOrder(..), OptDescr(..), ArgDescr(..), usageInfo, )-import System.Exit (exitWith, ExitCode(..), )+import System.Exit (exitSuccess, exitFailure, ) import qualified System.Environment as Env+import System.FilePath ((</>)) import qualified System.FilePath as FilePath -import Data.Graph.Inductive.Query.DFS (topsort', scc, )+import Data.Graph.Inductive.Query.DFS (topsort', scc, components, ) import Data.Graph.Inductive.Tree (Gr, ) import qualified Data.Graph.Inductive.Graph as Graph +import Control.Arrow ((***)) import qualified Control.Monad.Exception.Synchronous as Exc import qualified Control.Monad.Trans.Class as Trans import qualified Data.Set as Set-import Control.Monad (when, )-import Data.Maybe (mapMaybe, )+import Control.Monad (guard, when, )+import Data.Maybe (fromMaybe, mapMaybe, ) main :: IO () main =- Exc.resolveT (\e -> putStr $ "Aborted: " ++ e ++ "\n") $ do+ Exc.resolveT handleException $ do argv <- Trans.lift Env.getArgs let (opts, cabalPaths, errors) = getOpt RequireOrder options argv@@ -42,7 +44,11 @@ (return $ Flags {optHelp = False, optVerbosity = Verbosity.silent,- optInfo = location})+ optInfo = location,+ optParallel = False,+ optMakefile = False,+ optBuilddir = ".",+ optInstall = "cabal install"}) opts when (optHelp flags) (Trans.lift $@@ -50,16 +56,25 @@ putStrLn (usageInfo ("Usage: " ++ programName ++ " [OPTIONS] CABAL-FILES ...") options) >>- exitWith ExitSuccess)+ exitSuccess) - Trans.lift $ sortCabalFiles flags cabalPaths+ sortCabalFiles flags cabalPaths +handleException :: String -> IO ()+handleException msg = do+ putStrLn $ "Aborted: " ++ msg+ exitFailure + data Flags = Flags { optHelp :: Bool, optVerbosity :: Verbosity.Verbosity,- optInfo :: SourcePackage -> String+ optInfo :: SourcePackage -> String,+ optParallel :: Bool,+ optMakefile :: Bool,+ optBuilddir :: FilePath,+ optInstall :: String } options :: [OptDescr (Flags -> Exc.Exceptional String Flags)]@@ -90,6 +105,24 @@ "unknown info type " ++ str) "KIND") "kind of output: name, path, dir" :+ Option ['p'] ["parallel"]+ (NoArg (\flags -> return $ flags{optParallel = True}))+ "Display independently buildable groups of packages" :+ Option ['m'] ["makefile"]+ (NoArg (\flags -> return $ flags{optMakefile = True}))+ "Generate a makefile of package dependencies" :+ Option [] ["builddir"]+ (ReqArg+ (\str flags ->+ fmap (\dir -> flags{optBuilddir = dir}) (Exc.Success str))+ "PATH")+ "Specify the build dir to use for generated makefile" :+ Option [] ["install-cmd"]+ (ReqArg+ (\str flags ->+ fmap (\cmd -> flags{optInstall = cmd}) (Exc.Success str))+ "CMD")+ "Specify the install command to use in generated makefile" : [] @@ -99,12 +132,15 @@ location :: FilePath, description :: GenericPackageDescription }+ deriving (Show, Eq) -sortCabalFiles :: Flags -> [FilePath] -> IO ()+sortCabalFiles :: Flags -> [FilePath] -> Exc.ExceptionalT String IO () sortCabalFiles flags cabalPaths = do pkgDescs <-+ Trans.lift $ mapM (readPackageDescription (optVerbosity flags)) cabalPaths when (optVerbosity flags >= Verbosity.verbose) $+ Trans.lift $ flip mapM_ pkgDescs $ \pkgDesc -> do putStrLn ((getPkgName . pkgName . package . packageDescription $ pkgDesc) ++ ":")@@ -114,15 +150,52 @@ allDependencies pkgDesc flip mapM_ deps $ \dep -> putStrLn $ " " ++ dep- mapM_ (putStrLn . optInfo flags) $- getBuildOrder $- zipWith SourcePackage cabalPaths pkgDescs+ let pkgs = zipWith SourcePackage cabalPaths pkgDescs+ graph = getBuildGraph pkgs+ checkForCycles graph+ Trans.lift $+ if optMakefile flags+ then printMakefile flags $ getDeps graph+ else if optParallel flags+ then+ mapM_ (putStrLn . unwords . map (optInfo flags)) $+ map (topsort' . subgraph graph) $+ components graph+ else+ mapM_ (putStrLn . optInfo flags) $ topsort' graph -getBuildOrder ::+printMakefile :: Flags -> [(SourcePackage, [SourcePackage])] -> IO ()+printMakefile flags deps = do+ let printDep (l, ls) = putStrLn (l ++ ": " ++ unwords ls)+ stamp =+ (optBuilddir flags </>) .+ flip FilePath.replaceExtension "cstamp" . location+ allDeps = unwords (map (stamp . fst) deps)+ putStrLn (optBuilddir flags </> "%.cstamp:")+ putStrLn ("\t" ++ optInstall flags ++ " `dirname $*`")+ putStrLn "\tmkdir -p `dirname $@`"+ putStrLn "\ttouch $@"+ putStrLn ""+ putStrLn ("all: " ++ allDeps)+ putStrLn ""+ putStrLn "clean:"+ putStrLn ("\t$(RM) " ++ allDeps)+ putStrLn ""+ mapM_ (printDep . (stamp *** map stamp)) deps++getDeps :: Gr SourcePackage () -> [(SourcePackage, [SourcePackage])]+getDeps gr =+ let c2dep :: Graph.Context SourcePackage () -> (SourcePackage, [SourcePackage])+ c2dep ctx =+ (Graph.lab' ctx,+ map (Graph.lab' . Graph.context gr) (Graph.pre gr . Graph.node' $ ctx))+ in Graph.ufold (\ctx ds -> c2dep ctx : ds) [] gr++getBuildGraph :: [SourcePackage] ->- [SourcePackage]-getBuildOrder srcPkgs =+ Gr SourcePackage ()+getBuildGraph srcPkgs = let nodes = zip [0..] srcPkgs nodeDict = zip@@ -135,14 +208,44 @@ mapMaybe (flip lookup nodeDict . depName) (allDependencies $ description desc)+ guard (dstNode /= srcNode) return (dstNode, srcNode, ())- graph :: Gr SourcePackage ()- graph = Graph.mkGraph nodes edges+ in Graph.mkGraph nodes edges - in if hasCycle graph- then error "cycle in dependencies"- else topsort' graph +checkForCycles ::+ Monad m =>+ Gr SourcePackage () ->+ Exc.ExceptionalT String m ()+checkForCycles graph =+ case getCycles graph of+ [] -> return ()+ cycles ->+ Exc.throwT $ 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 (\component -> case component of _:_:_ -> True; _ -> False) .+ scc++ allDependencies :: GenericPackageDescription -> [Dependency] allDependencies pkg = P.buildDepends (packageDescription pkg) ++@@ -163,7 +266,3 @@ getPkgName :: PackageName -> String getPkgName (PackageName name) = name--hasCycle :: Gr a b -> Bool-hasCycle graph =- length (scc graph) < length (Graph.nodes graph)