diff options
-rw-r--r-- | CmdLine.hs | 14 | ||||
-rw-r--r-- | CmdLine/GitAnnex/Options.hs | 10 | ||||
-rw-r--r-- | CmdLine/GitAnnexShell.hs | 1 | ||||
-rw-r--r-- | CmdLine/GlobalSetter.hs | 24 | ||||
-rw-r--r-- | CmdLine/Option.hs | 8 | ||||
-rw-r--r-- | Types/DeferredParse.hs | 10 |
6 files changed, 50 insertions, 17 deletions
diff --git a/CmdLine.hs b/CmdLine.hs index e19b54de7..de1b3e7da 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -31,6 +31,7 @@ import Annex.Content import Annex.Environment import Command import Types.Messages +import CmdLine.GlobalSetter {- Runs the passed command line. -} dispatch :: Bool -> CmdParams -> [Command] -> [Parser GlobalSetter] -> [(String, String)] -> IO Git.Repo -> String -> String -> IO () @@ -43,7 +44,7 @@ dispatch fuzzyok allargs allcmds globaloptions fields getgitrepo progname progde Annex.eval state $ do checkEnvironment forM_ fields $ uncurry Annex.setField - ((cmd, seek), globalconfig) <- parsewith cmdparser + (cmd, seek, globalconfig) <- parsewith cmdparser (\a -> inRepo $ a . Just) when (cmdnomessages cmd) $ Annex.setOutput QuietOutput @@ -54,7 +55,7 @@ dispatch fuzzyok allargs allcmds globaloptions fields getgitrepo progname progde performCommandAction cmd seek $ shutdown $ cmdnocommit cmd go (Left norepo) = do - ((_, a), _) <- parsewith + (_, a, _globalconfig) <- parsewith (fromMaybe (throw norepo) . cmdnorepo) (\a -> a =<< Git.Config.global) a @@ -81,20 +82,19 @@ 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 -> [Parser GlobalSetter] -> CmdParams -> [Command] -> (Command -> O.Parser v) -> O.ParserResult ((Command, v), GlobalSetter) +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 <*> combineGlobalSetters globaloptions)) - (O.progDescDoc (Just intro)) + 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 = (,) + mkparser c = (,,) <$> pure c <*> getparser c + <*> combineGlobalSetters globaloptions synopsis n d = n ++ " - " ++ d intro = mconcat $ concatMap (\l -> [H.text l, H.line]) (synopsis progname progdesc : commandList allcmds) diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs index bb002a103..6965e8e51 100644 --- a/CmdLine/GitAnnex/Options.hs +++ b/CmdLine/GitAnnex/Options.hs @@ -26,6 +26,7 @@ import qualified Limit import qualified Limit.Wanted import CmdLine.Option import CmdLine.Usage +import CmdLine.GlobalSetter -- Global options that are accepted by all git-annex sub-commands, -- although not always used. @@ -34,38 +35,47 @@ gitAnnexGlobalOptions = commonGlobalOptions ++ [ globalSetter setnumcopies $ option auto ( long "numcopies" <> short 'N' <> metavar paramNumber <> help "override default number of copies" + <> hidden ) , globalSetter (Remote.forceTrust Trusted) $ strOption ( long "trust" <> metavar paramRemote <> help "override trust setting" + <> hidden ) , globalSetter (Remote.forceTrust SemiTrusted) $ strOption ( long "semitrust" <> metavar paramRemote <> help "override trust setting back to default" + <> hidden ) , globalSetter (Remote.forceTrust UnTrusted) $ strOption ( long "untrust" <> metavar paramRemote <> help "override trust setting to untrusted" + <> hidden ) , globalSetter setgitconfig $ strOption ( long "config" <> short 'c' <> metavar "NAME=VALUE" <> help "override git configuration setting" + <> hidden ) , globalSetter setuseragent $ strOption ( long "user-agent" <> metavar paramName <> help "override default User-Agent" + <> hidden ) , globalFlag (Annex.setFlag "trustglacier") ( long "trust-glacier" <> help "Trust Amazon Glacier inventory" + <> hidden ) , globalFlag (setdesktopnotify mkNotifyFinish) ( long "notify-finish" <> help "show desktop notification after transfer finishes" + <> hidden ) , globalFlag (setdesktopnotify mkNotifyStart) ( long "notify-start" <> help "show desktop notification after transfer completes" + <> hidden ) ] where diff --git a/CmdLine/GitAnnexShell.hs b/CmdLine/GitAnnexShell.hs index c653e8626..c1d02a702 100644 --- a/CmdLine/GitAnnexShell.hs +++ b/CmdLine/GitAnnexShell.hs @@ -13,6 +13,7 @@ import Common.Annex import qualified Git.Construct import qualified Git.Config import CmdLine +import CmdLine.GlobalSetter import Command import Annex.UUID import CmdLine.GitAnnexShell.Fields diff --git a/CmdLine/GlobalSetter.hs b/CmdLine/GlobalSetter.hs new file mode 100644 index 000000000..eb73f3f12 --- /dev/null +++ b/CmdLine/GlobalSetter.hs @@ -0,0 +1,24 @@ +{- git-annex global options + - + - Copyright 2015 Joey Hess <id@joeyh.name> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module CmdLine.GlobalSetter where + +import Types.DeferredParse +import Common +import Annex + +import Options.Applicative + +globalFlag :: Annex () -> Mod FlagFields GlobalSetter -> Parser GlobalSetter +globalFlag setter = flag' (DeferredParse setter) + +globalSetter :: (v -> Annex ()) -> Parser v -> Parser GlobalSetter +globalSetter setter parser = DeferredParse . setter <$> parser + +combineGlobalSetters :: [Parser GlobalSetter] -> Parser GlobalSetter +combineGlobalSetters l = DeferredParse . sequence_ . map getParsed + <$> many (foldl1 (<|>) l) diff --git a/CmdLine/Option.hs b/CmdLine/Option.hs index d28c7a704..9cc7a1f4b 100644 --- a/CmdLine/Option.hs +++ b/CmdLine/Option.hs @@ -20,6 +20,7 @@ import System.Console.GetOpt import Common.Annex import CmdLine.Usage +import CmdLine.GlobalSetter import qualified Annex import Types.Messages import Types.DeferredParse @@ -30,30 +31,37 @@ commonGlobalOptions = [ globalFlag (setforce True) ( long "force" <> help "allow actions that may lose annexed data" + <> hidden ) , globalFlag (setfast True) ( long "fast" <> short 'F' <> help "avoid slow operations" + <> hidden ) , globalFlag (Annex.setOutput QuietOutput) ( long "quiet" <> short 'q' <> help "avoid verbose output" + <> hidden ) , globalFlag (Annex.setOutput NormalOutput) ( long "verbose" <> short 'v' <> help "allow verbose output (default)" + <> hidden ) , globalFlag setdebug ( long "debug" <> short 'd' <> help "show debug messages" + <> hidden ) , globalFlag unsetdebug ( long "no-debug" <> help "don't show debug messages" + <> hidden ) , globalSetter setforcebackend $ strOption ( long "backend" <> short 'b' <> metavar paramName <> help "specify key-value backend to use" + <> hidden ) ] where diff --git a/Types/DeferredParse.hs b/Types/DeferredParse.hs index c11b722bf..619d68e9c 100644 --- a/Types/DeferredParse.hs +++ b/Types/DeferredParse.hs @@ -39,13 +39,3 @@ instance DeferredParseClass [DeferredParse a] where -- Use when the Annex action modifies Annex state. type GlobalSetter = DeferredParse () - -globalFlag :: Annex () -> Mod FlagFields GlobalSetter -> Parser GlobalSetter -globalFlag setter = flag' (DeferredParse setter) - -globalSetter :: (v -> Annex ()) -> Parser v -> Parser GlobalSetter -globalSetter setter parser = DeferredParse . setter <$> parser - -combineGlobalSetters :: [Parser GlobalSetter] -> Parser GlobalSetter -combineGlobalSetters l = DeferredParse . sequence_ . map getParsed - <$> many (foldl1 (<|>) l) |