diff options
Diffstat (limited to 'CmdLine.hs')
| -rw-r--r-- | CmdLine.hs | 100 |
1 files changed, 61 insertions, 39 deletions
diff --git a/CmdLine.hs b/CmdLine.hs index cd7a1a986..492a3b75f 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -1,6 +1,6 @@ {- git-annex command line parsing and dispatch - - - Copyright 2010-2012 Joey Hess <id@joeyh.name> + - Copyright 2010-2015 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -13,10 +13,11 @@ module CmdLine ( shutdown ) 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) -import System.Console.GetOpt #ifndef mingw32_HOST_OS import System.Posix.Signals #endif @@ -32,48 +33,81 @@ 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] -> [GlobalOption] -> [(String, String)] -> IO Git.Repo -> String -> String -> IO () +dispatch fuzzyok allargs allcmds globaloptions fields getgitrepo progname progdesc = do setupConsole - case getOptCmd args cmd commonoptions of - Right (flags, params) -> go flags params - =<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo)) - Left parseerr -> error parseerr + go =<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo)) where - go flags params (Right g) = do + go (Right g) = do state <- Annex.new g Annex.eval state $ do checkEnvironment - when fuzzy $ - inRepo $ autocorrect . Just forM_ fields $ uncurry Annex.setField + (cmd, seek, globalconfig) <- parsewith cmdparser + (\a -> inRepo $ a . Just) when (cmdnomessages cmd) $ Annex.setOutput QuietOutput - sequence_ flags + getParsed globalconfig whenM (annexDebug <$> Annex.getGitConfig) $ liftIO enableDebugOutput startup - performCommandAction cmd params $ + performCommandAction cmd seek $ shutdown $ cmdnocommit cmd - go _flags params (Left e) = do - when fuzzy $ - autocorrect =<< Git.Config.global - maybe (throw e) (\a -> a params) (cmdnorepo cmd) - err msg = msg ++ "\n\n" ++ usage header allcmds - cmd = Prelude.head cmds - (fuzzy, cmds, name, args) = findCmd fuzzyok allargs allcmds err - autocorrect = Git.AutoCorrect.prepare name cmdname cmds + go (Left norepo) = do + (_, a, _globalconfig) <- parsewith + (fromMaybe (throw norepo) . cmdnorepo) + (\a -> a =<< Git.Config.global) + a + + parsewith getparser ingitrepo = + case parseCmd progname progdesc globaloptions 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 progname progdesc globaloptions correctedargs allcmds getparser)) + res -> liftIO (O.handleParseResult res) + where + autocorrect = Git.AutoCorrect.prepare (fromJust inputcmdname) cmdname cmds + (fuzzy, cmds, inputcmdname, args) = findCmd fuzzyok allargs allcmds + name + | fuzzy = case cmds of + (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 :: String -> String -> [GlobalOption] -> CmdParams -> [Command] -> (Command -> O.Parser v) -> O.ParserResult (Command, v, GlobalSetter) +parseCmd progname progdesc globaloptions allargs allcmds getparser = + O.execParserPure (O.prefs O.idm) pinfo allargs + where + 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 (synopsis (progname ++ " " ++ cmdname c) (cmddesc c)) + <> O.footer ("For details, run: " ++ progname ++ " help " ++ cmdname c) + mkparser c = (,,) + <$> pure c + <*> getparser c + <*> combineGlobalOptions globaloptions + 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 @@ -84,18 +118,6 @@ findCmd fuzzyok argv cmds err Nothing -> [] Just n -> Git.AutoCorrect.fuzzymatches n cmdname cmds -{- Parses command line options, and returns actions to run to configure flags - - and the remaining parameters for the command. -} -getOptCmd :: CmdParams -> Command -> [Option] -> Either String ([Annex ()], CmdParams) -getOptCmd argv cmd commonoptions = check $ - getOpt Permute (commonoptions ++ cmdoptions cmd) argv - where - check (flags, rest, []) = Right (flags, rest) - check (_, _, errs) = Left $ unlines - [ concat errs - , commandUsage cmd - ] - {- Actions to perform each time ran. -} startup :: Annex () startup = |