diff --git a/cabal-sort.cabal b/cabal-sort.cabal --- a/cabal-sort.cabal +++ b/cabal-sort.cabal @@ -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 @@ -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, diff --git a/src/CabalSort.hs b/src/CabalSort.hs --- a/src/CabalSort.hs +++ b/src/CabalSort.hs @@ -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 :: diff --git a/src/GhcPkgDep.hs b/src/GhcPkgDep.hs --- a/src/GhcPkgDep.hs +++ b/src/GhcPkgDep.hs @@ -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