diff options
| -rw-r--r-- | CmdLine.hs | 21 | ||||
| -rw-r--r-- | CmdLine/GitAnnex/Options.hs | 7 | ||||
| -rw-r--r-- | CmdLine/GitAnnexShell.hs | 13 | ||||
| -rw-r--r-- | CmdLine/Option.hs | 4 | ||||
| -rw-r--r-- | Types/DeferredParse.hs | 4 |
5 files changed, 25 insertions, 24 deletions
diff --git a/CmdLine.hs b/CmdLine.hs index 7d90a25ce..e19b54de7 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -33,7 +33,7 @@ import Command import Types.Messages {- Runs the passed command line. -} -dispatch :: Bool -> CmdParams -> [Command] -> Parser GlobalSetter -> [(String, String)] -> IO Git.Repo -> String -> String -> IO () +dispatch :: Bool -> CmdParams -> [Command] -> [Parser GlobalSetter] -> [(String, String)] -> IO Git.Repo -> String -> String -> IO () dispatch fuzzyok allargs allcmds globaloptions fields getgitrepo progname progdesc = do setupConsole go =<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo)) @@ -43,30 +43,30 @@ dispatch fuzzyok allargs allcmds globaloptions fields getgitrepo progname progde Annex.eval state $ do checkEnvironment forM_ fields $ uncurry Annex.setField - (cmd, seek) <- parsewith cmdparser + ((cmd, seek), globalconfig) <- parsewith cmdparser (\a -> inRepo $ a . Just) when (cmdnomessages cmd) $ Annex.setOutput QuietOutput - -- TODO: propigate global options to annex state (how?) + getParsed globalconfig whenM (annexDebug <$> Annex.getGitConfig) $ liftIO enableDebugOutput startup performCommandAction cmd seek $ shutdown $ cmdnocommit cmd go (Left norepo) = do - (_, a) <- parsewith + ((_, a), _) <- parsewith (fromMaybe (throw norepo) . cmdnorepo) (\a -> a =<< Git.Config.global) a parsewith getparser ingitrepo = - case parseCmd progname progdesc allargs allcmds getparser of + 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 correctedargs allcmds getparser)) + liftIO (O.handleParseResult (parseCmd progname progdesc globaloptions correctedargs allcmds getparser)) res -> liftIO (O.handleParseResult res) where autocorrect = Git.AutoCorrect.prepare (fromJust inputcmdname) cmdname cmds @@ -81,10 +81,13 @@ dispatch fuzzyok allargs allcmds globaloptions fields getgitrepo progname progde Just n -> n:args {- Parses command line, selecting one of the commands from the list. -} -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 +parseCmd :: String -> String -> [Parser GlobalSetter] -> 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)) + pinfo = O.info + (O.helper <*> ((,) <$> subcmds <*> combineGlobalSetters globaloptions)) + (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)) diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs index 8bc96a14d..bb002a103 100644 --- a/CmdLine/GitAnnex/Options.hs +++ b/CmdLine/GitAnnex/Options.hs @@ -29,10 +29,9 @@ import CmdLine.Usage -- Global options that are accepted by all git-annex sub-commands, -- although not always used. -gitAnnexGlobalOptions :: Parser GlobalSetter -gitAnnexGlobalOptions = globalSetters - [ commonGlobalOptions - , globalSetter setnumcopies $ option auto +gitAnnexGlobalOptions :: [Parser GlobalSetter] +gitAnnexGlobalOptions = commonGlobalOptions ++ + [ globalSetter setnumcopies $ option auto ( long "numcopies" <> short 'N' <> metavar paramNumber <> help "override default number of copies" ) diff --git a/CmdLine/GitAnnexShell.hs b/CmdLine/GitAnnexShell.hs index 5bc297a71..c653e8626 100644 --- a/CmdLine/GitAnnexShell.hs +++ b/CmdLine/GitAnnexShell.hs @@ -53,14 +53,13 @@ cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly where adddirparam c = c { cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c } -options :: Parser GlobalSetter -options = globalSetters - [ commonGlobalOptions - , globalSetter checkUUID $ strOption +globalOptions :: [Parser GlobalSetter] +globalOptions = + globalSetter checkUUID (strOption ( long "uuid" <> metavar paramUUID <> help "local repository uuid" - ) - ] + )) + : commonGlobalOptions where checkUUID expected = getUUID >>= check where @@ -101,7 +100,7 @@ builtin cmd dir params = do let (params', fieldparams, opts) = partitionParams params rsyncopts = ("RsyncOptions", unwords opts) fields = rsyncopts : filter checkField (parseFields fieldparams) - dispatch False (cmd : params') cmds options fields mkrepo + dispatch False (cmd : params') cmds globalOptions fields mkrepo "git-annex-shell" "Restricted login shell for git-annex only SSH access" where diff --git a/CmdLine/Option.hs b/CmdLine/Option.hs index 9cb1d41d4..d28c7a704 100644 --- a/CmdLine/Option.hs +++ b/CmdLine/Option.hs @@ -25,8 +25,8 @@ import Types.Messages import Types.DeferredParse -- Global options accepted by both git-annex and git-annex-shell sub-commands. -commonGlobalOptions :: Parser GlobalSetter -commonGlobalOptions = globalSetters +commonGlobalOptions :: [Parser GlobalSetter] +commonGlobalOptions = [ globalFlag (setforce True) ( long "force" <> help "allow actions that may lose annexed data" diff --git a/Types/DeferredParse.hs b/Types/DeferredParse.hs index 4c6e90175..c11b722bf 100644 --- a/Types/DeferredParse.hs +++ b/Types/DeferredParse.hs @@ -46,6 +46,6 @@ globalFlag setter = flag' (DeferredParse setter) globalSetter :: (v -> Annex ()) -> Parser v -> Parser GlobalSetter globalSetter setter parser = DeferredParse . setter <$> parser -globalSetters :: [Parser GlobalSetter] -> Parser GlobalSetter -globalSetters l = DeferredParse . sequence_ . map getParsed +combineGlobalSetters :: [Parser GlobalSetter] -> Parser GlobalSetter +combineGlobalSetters l = DeferredParse . sequence_ . map getParsed <$> many (foldl1 (<|>) l) |