diff options
author | Joey Hess <joeyh@joeyh.name> | 2015-07-09 11:49:52 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2015-07-09 11:52:47 -0400 |
commit | 6ddffe0f0e64a87fd924f736941fa242e0d740a6 (patch) | |
tree | 94bc5fed6512ea3cfab47b274cf5534edf889b77 /CmdLine.hs | |
parent | 1e4c1adeae64baa4eb30fd7e1171620c27e0e17f (diff) |
let optparse-applicative handle the usage display when run w/o command or bad command
Still generating the list of commands myself, to get it sorted into
sections and with short synopses.
Diffstat (limited to 'CmdLine.hs')
-rw-r--r-- | CmdLine.hs | 45 |
1 files changed, 26 insertions, 19 deletions
diff --git a/CmdLine.hs b/CmdLine.hs index b4e0ea044..5114bc984 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -14,6 +14,7 @@ module CmdLine ( ) where import qualified Options.Applicative as O +import qualified Options.Applicative.Help as H import qualified Control.Exception as E import qualified Data.Map as M import Control.Exception (throw) @@ -32,8 +33,8 @@ import Command import Types.Messages {- Runs the passed command line. -} -dispatch :: Bool -> CmdParams -> [Command] -> [Option] -> [(String, String)] -> String -> IO Git.Repo -> IO () -dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do +dispatch :: Bool -> CmdParams -> [Command] -> [Option] -> [(String, String)] -> IO Git.Repo -> String -> String -> IO () +dispatch fuzzyok allargs allcmds commonoptions fields getgitrepo progname progdesc = do setupConsole go =<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo)) where @@ -59,46 +60,52 @@ dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do a parsewith getparser ingitrepo = - case parseCmd allargs allcmds getparser of + case parseCmd progname progdesc allargs allcmds getparser of O.Failure _ -> do -- parse failed, so fall back to -- fuzzy matching, or to showing usage when fuzzy $ ingitrepo autocorrect - liftIO (O.handleParseResult (parseCmd (name:args) allcmds getparser)) + liftIO (O.handleParseResult (parseCmd progname progdesc correctedargs allcmds getparser)) res -> liftIO (O.handleParseResult res) where - autocorrect = Git.AutoCorrect.prepare inputcmdname cmdname cmds - err msg = msg ++ "\n\n" ++ usage header allcmds - (fuzzy, cmds, inputcmdname, args) = findCmd fuzzyok allargs allcmds err + autocorrect = Git.AutoCorrect.prepare (fromJust inputcmdname) cmdname cmds + (fuzzy, cmds, inputcmdname, args) = findCmd fuzzyok allargs allcmds name | fuzzy = case cmds of - (c:_) -> cmdname c + (c:_) -> Just (cmdname c) _ -> inputcmdname | otherwise = inputcmdname + correctedargs = case name of + Nothing -> allargs + Just n -> n:args {- Parses command line, selecting one of the commands from the list. -} -parseCmd :: CmdParams -> [Command] -> (Command -> O.Parser v) -> O.ParserResult (Command, v) -parseCmd allargs allcmds getparser = O.execParserPure (O.prefs O.idm) pinfo allargs +parseCmd :: String -> String -> CmdParams -> [Command] -> (Command -> O.Parser v) -> O.ParserResult (Command, v) +parseCmd progname progdesc allargs allcmds getparser = O.execParserPure (O.prefs O.idm) pinfo allargs where - pinfo = O.info (O.helper <*> subcmds) O.fullDesc + pinfo = O.info (O.helper <*> subcmds) (O.progDescDoc (Just intro)) subcmds = O.hsubparser $ mconcat $ map mkcommand allcmds - mkcommand c = O.command (cmdname c) $ O.info (mkparser c) - (O.fullDesc <> O.header (cmddesc c) <> O.progDesc (cmddesc c)) + mkcommand c = O.command (cmdname c) $ O.info (mkparser c) $ O.fullDesc + <> O.header (synopsis (progname ++ " " ++ cmdname c) (cmddesc c)) + <> O.footer ("For details, run: " ++ progname ++ " help " ++ cmdname c) mkparser c = (,) <$> pure c <*> getparser c + synopsis n d = n ++ " - " ++ d + intro = mconcat $ concatMap (\l -> [H.text l, H.line]) + (synopsis progname progdesc : commandList allcmds) {- Parses command line params far enough to find the Command to run, and - returns the remaining params. - Does fuzzy matching if necessary, which may result in multiple Commands. -} -findCmd :: Bool -> CmdParams -> [Command] -> (String -> String) -> (Bool, [Command], String, CmdParams) -findCmd fuzzyok argv cmds err - | isNothing name = error $ err "missing command" - | not (null exactcmds) = (False, exactcmds, fromJust name, args) - | fuzzyok && not (null inexactcmds) = (True, inexactcmds, fromJust name, args) - | otherwise = error $ err $ "unknown command " ++ fromJust name +findCmd :: Bool -> CmdParams -> [Command] -> (Bool, [Command], Maybe String, CmdParams) +findCmd fuzzyok argv cmds + | not (null exactcmds) = ret (False, exactcmds) + | fuzzyok && not (null inexactcmds) = ret (True, inexactcmds) + | otherwise = ret (False, []) where + ret (fuzzy, matches) = (fuzzy, matches, name, args) (name, args) = findname argv [] findname [] c = (Nothing, reverse c) findname (a:as) c |