cabal-sort 0.1.1.1 → 0.1.1.2
raw patch · 2 files changed
+30/−46 lines, 2 files
Files
- cabal-sort.cabal +2/−2
- src/CabalSort.hs +28/−44
cabal-sort.cabal view
@@ -1,6 +1,6 @@ Cabal-Version: 2.2 Name: cabal-sort-Version: 0.1.1.1+Version: 0.1.1.2 License: BSD-3-Clause License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -90,7 +90,7 @@ Source-Repository this type: darcs location: http://code.haskell.org/~thielema/cabal-sort/- tag: 0.1.1.1+ tag: 0.1.1.2 Executable cabal-sort
src/CabalSort.hs view
@@ -16,9 +16,9 @@ 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.Query.DFS (topsort', scc, components, )-import Data.Graph.Inductive.Tree (Gr, )+import Data.Graph.Inductive.Tree (Gr) import qualified Control.Monad.Exception.Synchronous as Exc import qualified Control.Monad.Trans.Class as Trans@@ -26,11 +26,12 @@ import Control.Monad (guard, when) import Control.Applicative (pure, (<*>), (<|>)) +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.Map (Map)-import Data.Maybe (fromMaybe, mapMaybe, )+import Data.Maybe (fromMaybe, maybeToList) main :: IO ()@@ -61,8 +62,7 @@ infoMap :: Map String (SourcePackage -> String) infoMap = Map.fromList $- ("name",- unPackageName . pkgName . package . packageDescription . description) :+ ("name", unPackageName . pkgNameFromDescription . description) : ("path", location) : ("dir", FilePath.takeDirectory . location) : []@@ -122,6 +122,8 @@ } deriving (Show, Eq) +type DependencyGraph = Gr SourcePackage ()+ sortCabalFiles :: Flags -> [FilePath] -> Exc.ExceptionalT String IO () sortCabalFiles flags cabalPaths = do pkgDescs <-@@ -129,28 +131,24 @@ mapM (readGenericPackageDescription (optVerbosity flags)) cabalPaths when (optVerbosity flags >= Verbosity.verbose) $ Trans.lift $- flip mapM_ pkgDescs $ \pkgDesc -> do- putStrLn- ((unPackageName . pkgName . package . packageDescription $- pkgDesc)- ++ ":")+ Fold.for_ pkgDescs $ \pkgDesc -> do+ putStrLn $ unPackageName (pkgNameFromDescription pkgDesc) ++ ":" let deps = Set.toAscList $ Set.fromList $ map (unPackageName . depName) $ allDependencies pkgDesc- flip mapM_ deps $ \dep ->- putStrLn $ " " ++ dep- let pkgs = zipWith SourcePackage cabalPaths pkgDescs- graph = getBuildGraph pkgs+ Fold.for_ deps $ \dep -> putStrLn $ " " ++ dep+ let graph = dependencyGraph $ zipWith SourcePackage cabalPaths pkgDescs checkForCycles graph Trans.lift $ case optOutputFormat flags of Makefile -> printMakefile flags $ getDeps graph- Serial -> mapM_ (putStrLn . optInfo flags) $ topsort' graph+ Serial ->+ mapM_ (putStrLn . optInfo flags) $ GraphQuery.topsort' graph Parallel ->- mapM_ (putStrLn . unwords . map (optInfo flags)) $- map (topsort' . subgraph graph) $- components graph+ mapM_ (putStrLn . unwords . map (optInfo flags)) $+ map (GraphQuery.topsort' . flip Graph.subgraph graph) $+ GraphQuery.components graph printMakefile :: Flags -> [(SourcePackage, [SourcePackage])] -> IO ()@@ -172,7 +170,7 @@ putStrLn "" mapM_ (printDep . (stamp *** map stamp)) deps -getDeps :: Gr SourcePackage () -> [(SourcePackage, [SourcePackage])]+getDeps :: DependencyGraph -> [(SourcePackage, [SourcePackage])] getDeps gr = let c2dep :: Graph.Context SourcePackage () -> (SourcePackage, [SourcePackage])@@ -182,29 +180,22 @@ (Graph.pre gr . Graph.node' $ ctx)) in Graph.ufold (\ctx ds -> c2dep ctx : ds) [] gr -getBuildGraph :: [SourcePackage] -> Gr SourcePackage ()-getBuildGraph srcPkgs =+dependencyGraph :: [SourcePackage] -> DependencyGraph+dependencyGraph srcPkgs = let nodes = zip [0..] srcPkgs nodeDict =- zip- (map (pkgName . package . packageDescription . description)- srcPkgs)- [0..]+ Map.fromList $+ zip (map (pkgNameFromDescription . description) srcPkgs) [0..] edges = do (srcNode,desc) <- nodes- dstNode <-- mapMaybe- (flip lookup nodeDict . depName)- (allDependencies $ description desc)+ dependency <- allDependencies $ description desc+ dstNode <- maybeToList $ Map.lookup (depName dependency) nodeDict guard (dstNode /= srcNode) return (dstNode, srcNode, ()) in Graph.mkGraph nodes edges -checkForCycles ::- Monad m =>- Gr SourcePackage () ->- Exc.ExceptionalT String m ()+checkForCycles :: (Monad m) => DependencyGraph -> Exc.ExceptionalT String m () checkForCycles graph = case getCycles graph of [] -> return ()@@ -217,20 +208,10 @@ 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+ GraphQuery.scc allDependencies :: GenericPackageDescription -> [Dependency]@@ -250,3 +231,6 @@ depName :: Dependency -> PackageName depName (Dependency name _ _) = name++pkgNameFromDescription :: GenericPackageDescription -> PackageName+pkgNameFromDescription = pkgName . package . packageDescription