wired up global options

Note that I ran into a problem where parsing the global options looped
forever, eating memory. It was somehow caused by stacking
combineGlobalSetters inside a combineGlobalSetters. Maybe due to both
using "many"? Anyway, changed things to avoid that.

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))

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"
 		)

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

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"

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)