cabal-sort 0.1.1.2 → 0.1.2
raw patch · 2 files changed
+40/−49 lines, 2 filesdep +comfort-graphdep −fgldep ~Cabaldep ~containersdep ~filepath
Dependencies added: comfort-graph
Dependencies removed: fgl
Dependency ranges changed: Cabal, containers, filepath
Files
- cabal-sort.cabal +6/−6
- src/CabalSort.hs +34/−43
cabal-sort.cabal view
@@ -1,11 +1,11 @@ Cabal-Version: 2.2 Name: cabal-sort-Version: 0.1.1.2+Version: 0.1.2 License: BSD-3-Clause License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de> Maintainer: Henning Thielemann <haskell@henning-thielemann.de>--- Homepage: http://www.haskell.org/haskellwiki/Cabal+Homepage: https://hub.darcs.net/thielema/cabal-sort/ Category: Distribution Synopsis: Topologically sort cabal packages Description:@@ -85,18 +85,18 @@ Build-Type: Simple Source-Repository head type: darcs- location: http://code.haskell.org/~thielema/cabal-sort/+ location: https://hub.darcs.net/thielema/cabal-sort/ Source-Repository this type: darcs- location: http://code.haskell.org/~thielema/cabal-sort/- tag: 0.1.1.2+ location: https://hub.darcs.net/thielema/cabal-sort/+ tag: 0.1.2 Executable cabal-sort Build-Depends: Cabal >=3.8 && <3.11,- fgl >=5.4.2 && <5.9,+ comfort-graph >=0.0.4 && <0.1, shell-utility >=0.1 && <0.2, optparse-applicative >=0.18 && <0.19, directory >=1 && <1.4,
src/CabalSort.hs view
@@ -16,22 +16,20 @@ import qualified System.FilePath as FilePath import System.FilePath ((</>)) -import qualified Data.Graph.Inductive.Query.DFS as GraphQuery-import qualified Data.Graph.Inductive.Graph as Graph-import Data.Graph.Inductive.Tree (Gr)- import qualified Control.Monad.Exception.Synchronous as Exc import qualified Control.Monad.Trans.Class as Trans import Control.Arrow ((***)) import Control.Monad (guard, when) import Control.Applicative (pure, (<*>), (<|>)) +import qualified Data.Graph.Comfort as Graph import qualified Data.Foldable as Fold import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Set as Set+import Data.Graph.Comfort (Graph) import Data.Map (Map)-import Data.Maybe (fromMaybe, maybeToList)+import Data.Maybe (fromMaybe) main :: IO ()@@ -122,7 +120,7 @@ } deriving (Show, Eq) -type DependencyGraph = Gr SourcePackage ()+type DependencyGraph = Graph Graph.DirEdge PackageName () SourcePackage sortCabalFiles :: Flags -> [FilePath] -> Exc.ExceptionalT String IO () sortCabalFiles flags cabalPaths =@@ -139,16 +137,21 @@ allDependencies pkgDesc Fold.for_ deps $ \dep -> putStrLn $ " " ++ dep let graph = dependencyGraph $ zipWith SourcePackage cabalPaths pkgDescs- checkForCycles graph+ let lookupSrcPkg =+ fromMaybe (error "package not found anymore") .+ flip Graph.lookupNode graph+ let (sorted, cyclicPart) = Graph.topologicalSort graph+ when (not $ Graph.isEmpty cyclicPart) $+ Exc.throwT $ unlines $+ "Cycles in dependencies:" : showCycles cyclicPart Trans.lift $ case optOutputFormat flags of Makefile -> printMakefile flags $ getDeps graph- Serial ->- mapM_ (putStrLn . optInfo flags) $ GraphQuery.topsort' graph+ Serial -> mapM_ (putStrLn . optInfo flags . lookupSrcPkg) sorted Parallel -> mapM_ (putStrLn . unwords . map (optInfo flags)) $- map (GraphQuery.topsort' . flip Graph.subgraph graph) $- GraphQuery.components graph+ map (map lookupSrcPkg . fst . Graph.topologicalSort) $+ Graph.components graph printMakefile :: Flags -> [(SourcePackage, [SourcePackage])] -> IO ()@@ -172,46 +175,34 @@ getDeps :: DependencyGraph -> [(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+ let nodes = Graph.nodeLabels gr in+ Map.elems .+ Map.mapWithKey+ (\pName srcPkg ->+ (srcPkg,+ Map.elems $ Map.restrictKeys nodes $+ Set.fromList $ Graph.predecessors gr pName))+ $ nodes dependencyGraph :: [SourcePackage] -> DependencyGraph dependencyGraph srcPkgs =- let nodes = zip [0..] srcPkgs- nodeDict =- Map.fromList $- zip (map (pkgNameFromDescription . description) srcPkgs) [0..]+ let nodes =+ map (\pkg -> (pkgNameFromDescription (description pkg), pkg)) srcPkgs+ nodeMap = Map.fromList nodes edges = do (srcNode,desc) <- nodes- dependency <- allDependencies $ description desc- dstNode <- maybeToList $ Map.lookup (depName dependency) nodeDict+ dstNode <- map depName $ allDependencies $ description desc+ guard (Map.member dstNode nodeMap) guard (dstNode /= srcNode)- return (dstNode, srcNode, ())- in Graph.mkGraph nodes edges+ return (Graph.DirEdge dstNode srcNode, ())+ in Graph.fromMap nodeMap $ Map.fromList edges -checkForCycles :: (Monad m) => DependencyGraph -> 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)--getCycles :: Gr a b -> [[Graph.Node]]-getCycles =- filter (\component -> case component of _:_:_ -> True; _ -> False) .- GraphQuery.scc+showCycles :: DependencyGraph -> [String]+showCycles graph =+ map (unwords . Map.elems . Map.map location .+ Map.restrictKeys (Graph.nodeLabels graph)) .+ filter ((>=2) . Set.size) . Graph.stronglyConnectedComponents $ graph allDependencies :: GenericPackageDescription -> [Dependency]