cabal-sort 0.1 → 0.1.1
raw patch · 3 files changed
+133/−153 lines, 3 filesdep +optparse-applicativedep +shell-utility
Dependencies added: optparse-applicative, shell-utility
Files
- cabal-sort.cabal +6/−2
- src/CabalSort.hs +77/−89
- src/GhcPkgDep.hs +50/−62
cabal-sort.cabal view
@@ -1,6 +1,6 @@ Cabal-Version: 2.2 Name: cabal-sort-Version: 0.1+Version: 0.1.1 License: BSD-3-Clause License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -90,13 +90,15 @@ Source-Repository this type: darcs location: http://code.haskell.org/~thielema/cabal-sort/- tag: 0.1+ tag: 0.1.1 Executable cabal-sort Build-Depends: Cabal >=3.8 && <3.11, fgl >=5.4.2 && <5.9,+ shell-utility >=0.1 && <0.2,+ optparse-applicative >=0.18 && <0.19, directory >=1 && <1.4, filepath >=1.1 && <1.5, containers >=0.2 && <0.7,@@ -112,6 +114,8 @@ Executable ghc-pkg-dep Build-Depends: Cabal >=1.22 && <3.11,+ shell-utility >=0.1 && <0.2,+ optparse-applicative >=0.18 && <0.19, process >=1.0 && <1.7, containers >=0.2 && <0.7, explicit-exception >=0.1.6 && <0.3,
src/CabalSort.hs view
@@ -10,64 +10,37 @@ import Distribution.Types.PackageName (PackageName, unPackageName) import Distribution.Types.PackageId (pkgName) -import System.Console.GetOpt- (getOpt, ArgOrder(..), OptDescr(..), ArgDescr(..), usageInfo, )-import System.Exit (exitSuccess, exitFailure, )-import qualified System.Environment as Env-import System.FilePath ((</>))+import qualified Options.Applicative as OP+import Shell.Utility.Exit (exitFailureMsg)+ import qualified System.FilePath as FilePath+import System.FilePath ((</>)) +import qualified Data.Graph.Inductive.Graph as Graph 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 Control.Arrow ((***))+import Control.Monad (guard, when) +import qualified Data.List as List+import qualified Data.Map as Map import qualified Data.Set as Set-import Control.Monad (guard, when, )+import Data.Map (Map) import Data.Maybe (fromMaybe, mapMaybe, ) main :: IO ()-main =- Exc.resolveT handleException $ do- argv <- Trans.lift Env.getArgs- let (opts, cabalPaths, errors) =- getOpt RequireOrder options argv- when (not (null errors)) $ Exc.throwT $ concat $ errors- flags <-- Exc.ExceptionalT $ return $- foldr (flip (>>=))- (return $- Flags {optHelp = False,- optVerbosity = Verbosity.silent,- optInfo = location,- optParallel = False,- optMakefile = False,- optBuilddir = ".",- optInstall = "cabal v1-install"})- opts- when (optHelp flags)- (Trans.lift $- Env.getProgName >>= \programName ->- putStrLn- (usageInfo ("Usage: " ++ programName ++- " [OPTIONS] CABAL-FILES ...") options) >>- exitSuccess)-+main = do+ (flags, cabalPaths) <- OP.execParser $ info options+ Exc.resolveT (\e -> exitFailureMsg $ "Aborted: " ++ e) $ sortCabalFiles flags cabalPaths -handleException :: String -> IO ()-handleException msg = do- putStrLn $ "Aborted: " ++ msg- exitFailure - data Flags = Flags {- optHelp :: Bool, optVerbosity :: Verbosity.Verbosity, optInfo :: SourcePackage -> String, optParallel :: Bool,@@ -76,56 +49,69 @@ optInstall :: String } -options :: [OptDescr (Flags -> Exc.Exceptional String Flags)]-options =- Option ['h'] ["help"]- (NoArg (\flags -> return $ flags{optHelp = True}))- "show options" :- Option ['v'] ["verbose"]- (ReqArg- (\str flags ->- fmap (\n -> flags{optVerbosity = n}) $- Exc.fromEither $- ReadE.runReadE Verbosity.flagToVerbosity str)- "N")- "verbosity level: 0..3" :- Option [] ["info"]- (ReqArg- (\str flags ->- fmap (\select -> flags{optInfo = select}) $- case str of- "name" -> Exc.Success- (unPackageName . pkgName . package .- packageDescription . description)- "path" -> Exc.Success location- "dir" -> Exc.Success (FilePath.takeDirectory . location)- _ ->- Exc.Exception $- "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" :- []+info :: OP.Parser a -> OP.ParserInfo (a, [String])+info p =+ OP.info+ (OP.helper <*>+ OP.liftA2 (,) p (OP.many (OP.strArgument (OP.metavar "CABAL-FILE"))))+ (OP.fullDesc <>+ OP.progDesc+ "Topological sort of Cabal packages according to dependencies.") +infoMap :: Map String (SourcePackage -> String)+infoMap =+ Map.fromList $+ ("name",+ unPackageName . pkgName . package . packageDescription . description) :+ ("path", location) :+ ("dir", FilePath.takeDirectory . location) :+ [] +options :: OP.Parser Flags+options =+ pure Flags+ <*>+ OP.option+ (OP.eitherReader $ ReadE.runReadE Verbosity.flagToVerbosity)+ (OP.short 'v' <>+ OP.long "verbose" <>+ OP.metavar "N" <>+ OP.value Verbosity.silent <>+ OP.help "verbosity level: 0..3")+ <*>+ OP.option+ (OP.eitherReader $ \str ->+ maybe (Left $ "unknown info type " ++ str) Right $+ Map.lookup str infoMap)+ (OP.long "info" <>+ OP.metavar "KIND" <>+ OP.value location <>+ OP.help ("kind of output: " +++ List.intercalate ", " (Map.keys infoMap)))+ <*>+ OP.switch+ (OP.short 'p' <>+ OP.long "parallel" <>+ OP.help "Display independently buildable groups of packages")+ <*>+ OP.switch+ (OP.short 'm' <>+ OP.long "makefile" <>+ OP.help "Generate a makefile of package dependencies")+ <*>+ OP.strOption+ (OP.long "builddir" <>+ OP.metavar "PATH" <>+ OP.value "." <>+ OP.help "Specify the build dir to use for generated makefile")+ <*>+ OP.strOption+ (OP.long "install-cmd" <>+ OP.metavar "CMD" <>+ OP.value "cabal v1-install" <>+ OP.help "Specify the install command to use in generated makefile") + data SourcePackage = SourcePackage { location :: FilePath,@@ -187,10 +173,12 @@ getDeps :: Gr SourcePackage () -> [(SourcePackage, [SourcePackage])] getDeps gr =- let c2dep :: Graph.Context SourcePackage () -> (SourcePackage, [SourcePackage])+ let c2dep :: Graph.Context SourcePackage () ->+ (SourcePackage, [SourcePackage]) c2dep ctx = (Graph.lab' ctx,- map (Graph.lab' . Graph.context gr) (Graph.pre gr . Graph.node' $ ctx))+ map (Graph.lab' . Graph.context gr)+ (Graph.pre gr . Graph.node' $ ctx)) in Graph.ufold (\ctx ds -> c2dep ctx : ds) [] gr getBuildGraph ::
src/GhcPkgDep.hs view
@@ -3,10 +3,8 @@ import qualified System.Process as Proc import qualified System.IO as IO -import System.Console.GetOpt- (getOpt, ArgOrder(..), OptDescr(..), ArgDescr(..), usageInfo, )-import System.Exit (exitWith, ExitCode(..), )-import qualified System.Environment as Env+import qualified Options.Applicative as OP+import Shell.Utility.Exit (exitFailureMsg) import qualified Distribution.Verbosity as Verbosity import qualified Distribution.ReadE as ReadE@@ -24,28 +22,17 @@ import qualified Data.List.HT as ListHT import qualified Data.List as List import qualified Data.Char as Char-import Control.Monad (when, guard, )-import Data.Maybe (fromMaybe, )+import Data.Monoid ((<>))+import Data.Maybe (fromMaybe) +import Control.Monad (when, guard)+import Control.Applicative (pure, (<*>)) -main :: IO ()-main =- Exc.resolveT (\e -> IO.hPutStr IO.stderr $ "Aborted: " ++ e ++ "\n") $ do- argv <- Trans.lift Env.getArgs- let (opts, pgkNames, errors) =- getOpt RequireOrder options argv- when (not (null errors)) $ Exc.throwT $ concat $ errors- flags <-- Exc.ExceptionalT $ return $- foldr (flip (>>=)) (return defltFlags) opts- when (optHelp flags)- (Trans.lift $- Env.getProgName >>= \programName ->- putStrLn- (usageInfo ("Usage: " ++ programName ++- " [OPTIONS] PKG-NAMES ...") options) >>- exitWith ExitSuccess) +main :: IO ()+main = do+ (flags, pgkNames) <- OP.execParser $ info options+ Exc.resolveT (\e -> exitFailureMsg $ "Aborted: " ++ e) $ mapM_ (Trans.lift . putStrLn) =<< (Exc.mapExceptionalT (flip State.evalStateT Set.empty) $ fmap concat $ mapM (getAllDependencies flags True) pgkNames)@@ -53,53 +40,54 @@ data Flags = Flags {- optHelp :: Bool, optVerbosity :: Verbosity.Verbosity, optUser, optGlobal :: Bool, optShowVersions :: Bool, optPkgCmd :: String } -defltFlags :: Flags-defltFlags =- Flags {- optHelp = False,- optVerbosity = Verbosity.silent,- optUser = False,- optGlobal = False,- optShowVersions = False,- optPkgCmd = "ghc-pkg"- }+info :: OP.Parser a -> OP.ParserInfo (a, [String])+info p =+ OP.info+ (OP.helper <*>+ OP.liftA2 (,) p (OP.many (OP.strArgument (OP.metavar "PKG-NAME"))))+ (OP.fullDesc <>+ OP.progDesc "Find transitive dependences of installed GHC packages.") -options :: [OptDescr (Flags -> Exc.Exceptional String Flags)]+options :: OP.Parser Flags options =- Option ['h'] ["help"]- (NoArg (\flags -> return $ flags{optHelp = True}))- "show options" :- Option ['v'] ["verbose"]- (ReqArg- (\str flags ->- fmap (\n -> flags{optVerbosity = n}) $- Exc.fromEither $- ReadE.runReadE Verbosity.flagToVerbosity str)- "N")- "verbosity level: 0..3" :- Option [] ["user"]- (NoArg (\flags -> return $ flags{optUser = True}))- "query GHC's local user package database" :- Option [] ["global"]- (NoArg (\flags -> return $ flags{optGlobal = True}))- "query GHC's global package database" :- Option [] ["show-versions"]- (NoArg (\flags -> return $ flags{optShowVersions = True}))- "show package version numbers in the output" :- Option [] ["pkg-cmd"]- (ReqArg- (\str flags -> return flags{optPkgCmd = str})- "COMMAND")- ("command for querying the package database (default: " ++- optPkgCmd defltFlags ++ ")") :- []+ pure Flags+ <*>+ OP.option+ (OP.eitherReader $ ReadE.runReadE Verbosity.flagToVerbosity)+ (OP.short 'v' <>+ OP.long "verbose" <>+ OP.metavar "N" <>+ OP.value Verbosity.silent <>+ OP.help "verbosity level: 0..3")+ <*>+ OP.switch+ (OP.long "user" <>+ OP.help "query GHC's local user package database")+ <*>+ OP.switch+ (OP.long "global" <>+ OP.help "query GHC's global package database")+ <*>+ OP.switch+ (OP.long "show-versions" <>+ OP.help "show package version numbers in the output")+ <*>+ OP.strOption+ (OP.long "pkg-cmd" <>+ OP.metavar "COMMAND" <>+ OP.value defaultPkgCmd <>+ OP.help+ ("command for querying the package database (default: " +++ defaultPkgCmd ++ ")"))++defaultPkgCmd :: String+defaultPkgCmd = "ghc-pkg" type PkgName = String