Commit d54a98b1 authored by Lennart Spitzner's avatar Lennart Spitzner

Change globalCommands description generation

- previously, runCommands internally modified the description
  by adding the list of commands.
- now, globalCommands is a function that builds the complete
  description without need for changes during runCommands invocation.
- slightly more code duplication, but better separation of concerns
parent b24f433b
......@@ -92,7 +92,7 @@ defaultMainNoRead = const defaultMain
defaultMainHelper :: [String] -> IO ()
defaultMainHelper args =
case commandsRun globalCommand commands args of
case commandsRun (globalCommand commands) commands args of
CommandHelp help -> printHelp help
CommandList opts -> printOptionsList opts
CommandErrors errs -> printErrors errs
......
......@@ -143,7 +143,7 @@ defaultMainNoRead pkg_descr =
defaultMainHelper :: UserHooks -> Args -> IO ()
defaultMainHelper hooks args = topHandler $
case commandsRun globalCommand commands args of
case commandsRun (globalCommand commands) commands args of
CommandHelp help -> printHelp help
CommandList opts -> printOptionsList opts
CommandErrors errs -> printErrors errs
......
......@@ -22,6 +22,8 @@ module Distribution.Simple.Command (
commandShowOptions,
CommandParse(..),
commandParseArgs,
getNormalCommandDescriptions,
helpCommandUI,
-- ** Constructing commands
ShowOrParseArgs(..),
......@@ -529,7 +531,7 @@ commandsRun :: CommandUI a
-> [String]
-> CommandParse (a, CommandParse action)
commandsRun globalCommand commands args =
case commandParseArgs globalCommand' True args of
case commandParseArgs globalCommand True args of
CommandHelp help -> CommandHelp help
CommandList opts -> CommandList (opts ++ commandNames)
CommandErrors errs -> CommandErrors errs
......@@ -550,23 +552,6 @@ commandsRun globalCommand commands args =
++ " (try --help)\n"]
commands' = commands ++ [commandAddAction helpCommandUI undefined]
commandNames = [ name | (Command name _ _ NormalCommand) <- commands' ]
globalCommand' = globalCommand {
commandUsage = \pname ->
(case commandUsage globalCommand pname of
"" -> ""
original -> original ++ "\n")
++ "Usage: " ++ pname ++ " [GLOBAL FLAGS] [COMMAND [FLAGS]]\n",
commandDescription = Just $ \pname ->
"Commands:\n"
++ unlines [ " " ++ align name ++ " " ++ description
| Command name description _ NormalCommand <- commands' ]
++ case commandDescription globalCommand of
Nothing -> ""
Just desc -> '\n': desc pname
}
where maxlen = maximum
[ length name | Command name _ _ NormalCommand <- commands' ]
align str = str ++ replicate (maxlen - length str) ' '
-- A bit of a hack: support "prog help" as a synonym of "prog --help"
-- furthermore, support "prog help command" as "prog command --help"
......@@ -585,13 +570,7 @@ commandsRun globalCommand commands args =
_ -> CommandHelp globalHelp
_ -> badCommand name
where globalHelp = commandHelp globalCommand'
helpCommandUI = mkCommandUI
"help"
"Help about commands."
["[FLAGS]", "COMMAND [FLAGS]"]
()
(const [])
where globalHelp = commandHelp globalCommand
-- | Utility function, many commands do not accept additional flags. This
-- action fails with a helpful error message if the user supplies any extra.
......@@ -602,3 +581,17 @@ noExtraFlags extraFlags =
die $ "Unrecognised flags: " ++ intercalate ", " extraFlags
--TODO: eliminate this function and turn it into a variant on commandAddAction
-- instead like commandAddActionNoArgs that doesn't supply the [String]
-- | Helper function for creating globalCommand description
getNormalCommandDescriptions :: [Command action] -> [(String, String)]
getNormalCommandDescriptions cmds =
[ (name, description)
| Command name description _ NormalCommand <- cmds ]
helpCommandUI :: CommandUI ()
helpCommandUI = mkCommandUI
"help"
"Help about commands."
["[FLAGS]", "COMMAND [FLAGS]"]
()
(const [])
......@@ -205,15 +205,27 @@ defaultGlobalFlags = GlobalFlags {
globalNumericVersion = Flag False
}
globalCommand :: CommandUI GlobalFlags
globalCommand = CommandUI
globalCommand :: [Command action] -> CommandUI GlobalFlags
globalCommand commands = CommandUI
{ commandName = ""
, commandSynopsis = ""
, commandUsage = \_ ->
, commandUsage = \pname ->
"This Setup program uses the Haskell Cabal Infrastructure.\n"
++ "See http://www.haskell.org/cabal/ for more information.\n"
, commandDescription = Just $ \pname ->
"For more information about a command use\n"
++ "\n"
++ "Usage: " ++ pname ++ " [GLOBAL FLAGS] [COMMAND [FLAGS]]\n"
, commandDescription = Just $ \pname ->
let
commands' = commands ++ [commandAddAction helpCommandUI undefined]
cmdDescs = getNormalCommandDescriptions commands'
maxlen = maximum $ [length name | (name, _) <- cmdDescs]
align str = str ++ replicate (maxlen - length str) ' '
in
"Commands:\n"
++ unlines [ " " ++ align name ++ " " ++ description
| (name, description) <- cmdDescs ]
++ "\n"
++ "For more information about a command use\n"
++ " " ++ pname ++ " COMMAND --help\n\n"
++ "Typical steps for installing Cabal packages:\n"
++ concat [ " " ++ pname ++ " " ++ x ++ "\n"
......
......@@ -586,7 +586,7 @@ configFieldDescriptions :: [FieldDescr SavedConfig]
configFieldDescriptions =
toSavedConfig liftGlobalFlag
(commandOptions globalCommand ParseArgs)
(commandOptions (globalCommand []) ParseArgs)
["version", "numeric-version", "config-file", "sandbox-config-file"] []
++ toSavedConfig liftConfigFlag
......
......@@ -138,15 +138,27 @@ defaultGlobalFlags = GlobalFlags {
globalIgnoreSandbox = Flag False
}
globalCommand :: CommandUI GlobalFlags
globalCommand = CommandUI {
globalCommand :: [Command action] -> CommandUI GlobalFlags
globalCommand commands = CommandUI {
commandName = "",
commandSynopsis =
"Command line interface to the Haskell Cabal infrastructure.",
commandUsage = \_ ->
"See http://www.haskell.org/cabal/ for more information.\n",
commandUsage = \pname ->
"See http://www.haskell.org/cabal/ for more information.\n"
++ "\n"
++ "Usage: " ++ pname ++ " [GLOBAL FLAGS] [COMMAND [FLAGS]]\n",
commandDescription = Just $ \pname ->
"For more information about a command use:\n"
let
commands' = commands ++ [commandAddAction helpCommandUI undefined]
cmdDescs = getNormalCommandDescriptions commands'
maxlen = maximum $ [length name | (name, _) <- cmdDescs]
align str = str ++ replicate (maxlen - length str) ' '
in
"Commands:\n"
++ unlines [ " " ++ align name ++ " " ++ description
| (name, description) <- cmdDescs ]
++ "\n"
++ "For more information about a command use:\n"
++ " " ++ pname ++ " COMMAND --help\n"
++ "or\n"
++ " " ++ pname ++ " help COMMAND\n"
......
......@@ -173,7 +173,7 @@ main = do
mainWorker :: [String] -> IO ()
mainWorker args = topHandler $
case commandsRun globalCommand commands args of
case commandsRun (globalCommand commands) commands args of
CommandHelp help -> printGlobalHelp help
CommandList opts -> printOptionsList opts
CommandErrors errs -> printErrors errs
......
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