Commit 55d95fa5 authored by Duncan Coutts's avatar Duncan Coutts

Add a verbosity flag to the info list update and fetch commands

parent d757ac76
......@@ -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"
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment