Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/55d95fa57a9139684ad58f8f037734377273cdd4 >--------------------------------------------------------------- commit 55d95fa57a9139684ad58f8f037734377273cdd4 Author: Duncan Coutts <[email protected]> Date: Mon Dec 17 19:00:35 2007 +0000 Add a verbosity flag to the info list update and fetch commands >--------------------------------------------------------------- cabal-install/Hackage/Setup.hs | 39 +++++++++++++++++++++++++-------------- cabal-install/Main.hs | 31 +++++++++++++++++++------------ 2 files changed, 44 insertions(+), 26 deletions(-) diff --git a/cabal-install/Hackage/Setup.hs b/cabal-install/Hackage/Setup.hs index 0ffcb27..6fc41d6 100644 --- a/cabal-install/Hackage/Setup.hs +++ b/cabal-install/Hackage/Setup.hs @@ -40,8 +40,9 @@ import qualified Distribution.Simple.Setup as Cabal RegisterFlags(..), emptyRegisterFlags, registerCommand, unregisterCommand, SDistFlags(..), emptySDistFlags, sdistCommand, testCommand-}) -import Distribution.Simple.Setup (fromFlagOrDefault, flagToMaybe) ---import System.Console.GetOpt (ArgDescr (..), OptDescr (..)) +import Distribution.Simple.Setup (Flag, toFlag, fromFlagOrDefault, + flagToMaybe, flagToList) +import Distribution.Verbosity (Verbosity, normal, flagToVerbosity, showForCabal) import Hackage.Types (ConfigFlags(..), UnresolvedDependency(..)) import Hackage.Utils (readPToMaybe, parseDependencyOrPackageId) @@ -94,34 +95,34 @@ installCommand = (Cabal.configureCommand defaultProgramConfiguration) { commandUsage = usagePackages "install" } -fetchCommand :: CommandUI () +fetchCommand :: CommandUI (Flag Verbosity) fetchCommand = CommandUI { commandName = "fetch", commandSynopsis = "Downloads packages for later installation or study.", commandDescription = Nothing, commandUsage = usagePackages "fetch", - commandDefaultFlags = (), - commandOptions = \_ -> [] + commandDefaultFlags = toFlag normal, + commandOptions = \_ -> [optionVerbose id const] } -listCommand :: CommandUI () +listCommand :: CommandUI (Flag Verbosity) listCommand = CommandUI { commandName = "list", commandSynopsis = "List available packages on the server (cached).", commandDescription = Nothing, commandUsage = usagePackages "list", - commandDefaultFlags = (), - commandOptions = \_ -> [] + commandDefaultFlags = toFlag normal, + commandOptions = \_ -> [optionVerbose id const] } -updateCommand :: CommandUI () +updateCommand :: CommandUI (Flag Verbosity) updateCommand = CommandUI { commandName = "update", commandSynopsis = "Updates list of known packages", commandDescription = Nothing, commandUsage = usagePackages "update", - commandDefaultFlags = (), - commandOptions = \_ -> [] + commandDefaultFlags = toFlag normal, + commandOptions = \_ -> [optionVerbose id const] } {- @@ -135,16 +136,26 @@ cleanCommand = makeCommand name shortDesc longDesc emptyFlags options options _ = [] -} -infoCommand :: CommandUI () +infoCommand :: CommandUI (Flag Verbosity) infoCommand = CommandUI { commandName = "info", commandSynopsis = "Emit some info about dependency resolution", commandDescription = Nothing, commandUsage = usagePackages "info", - commandDefaultFlags = (), - commandOptions = \_ -> [] + commandDefaultFlags = toFlag normal, + commandOptions = \_ -> [optionVerbose id const] } +optionVerbose :: (flags -> Flag Verbosity) + -> (Flag Verbosity -> flags -> flags) + -> Option flags +optionVerbose get set = + option "v" ["verbose"] + "Control verbosity (n is 0--3, default verbosity level is 1)" + get set + (optArg "n" (toFlag . flagToVerbosity) + (fmap (Just . showForCabal) . flagToList)) + usagePackages :: String -> String -> String usagePackages pname name = "Usage: " ++ pname ++ " " ++ name ++ " [FLAGS]\n" diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs index 57b6ba0..2a25302 100644 --- a/cabal-install/Main.hs +++ b/cabal-install/Main.hs @@ -14,7 +14,9 @@ module Main where import Hackage.Setup +import Hackage.Types (ConfigFlags(..)) import Distribution.PackageDescription (cabalVersion) +import Distribution.Simple.Setup (Flag, fromFlagOrDefault) import qualified Distribution.Simple.Setup as Cabal import Distribution.Simple.Setup (fromFlag) import Distribution.Simple.Command @@ -27,6 +29,7 @@ import Hackage.Update (update) import Hackage.Fetch (fetch) --import Hackage.Clean (clean) +import Distribution.Verbosity (Verbosity, normal) import Distribution.Version (showVersion) import qualified Paths_cabal_install (version) @@ -126,31 +129,35 @@ installAction flags extraArgs = (comp, conf) <- findCompiler config install config comp conf flags pkgs -infoAction :: () -> Args -> IO () -infoAction _flags extraArgs = do +infoAction :: Cabal.Flag Verbosity -> Args -> IO () +infoAction flags extraArgs = do configFile <- defaultConfigFile --FIXME - config <- loadConfig configFile + config0 <- loadConfig configFile + let config = config0 { configVerbose = fromFlagOrDefault normal flags } (comp, conf) <- findCompiler config case parsePackageArgs extraArgs of Left err -> putStrLn err >> exitWith (ExitFailure 1) Right pkgs -> info config comp conf [] pkgs -listAction :: () -> Args -> IO () -listAction _flags extraArgs = do +listAction :: Cabal.Flag Verbosity -> Args -> IO () +listAction flags extraArgs = do configFile <- defaultConfigFile --FIXME - config <- loadConfig configFile + config0 <- loadConfig configFile + let config = config0 { configVerbose = fromFlagOrDefault normal flags } list config extraArgs -updateAction :: () -> Args -> IO () -updateAction _flags _extraArgs = do +updateAction :: Flag Verbosity -> Args -> IO () +updateAction flags _extraArgs = do configFile <- defaultConfigFile --FIXME - config <- loadConfig configFile + config0 <- loadConfig configFile + let config = config0 { configVerbose = fromFlagOrDefault normal flags } update config -fetchAction :: () -> Args -> IO () -fetchAction _flags extraArgs = do +fetchAction :: Flag Verbosity -> Args -> IO () +fetchAction flags extraArgs = do configFile <- defaultConfigFile --FIXME - config <- loadConfig configFile + config0 <- loadConfig configFile + let config = config0 { configVerbose = fromFlagOrDefault normal flags } (comp, conf) <- findCompiler config case parsePackageArgs extraArgs of Left err -> putStrLn err >> exitWith (ExitFailure 1) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
