convert global options (still not used)

6 files changed, 102 insertions, 68 deletions

diff --git a/CmdLine.hs b/CmdLine.hs
index 5114bc984..7d90a25ce 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -33,8 +33,8 @@ import Command
 import Types.Messages
 
 {- Runs the passed command line. -}
-dispatch :: Bool -> CmdParams -> [Command] -> [Option] -> [(String, String)] -> IO Git.Repo -> String -> String -> IO ()
-dispatch fuzzyok allargs allcmds commonoptions fields getgitrepo progname progdesc = do
+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))
   where
diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs
index 2e9bc537f..32a4b8b10 100644
--- a/CmdLine/GitAnnex.hs
+++ b/CmdLine/GitAnnex.hs
@@ -227,7 +227,7 @@ run args = do
 #endif
 	go envmodes
   where
-	go [] = dispatch True args cmds gitAnnexOptions [] Git.CurrentRepo.get
+	go [] = dispatch True args cmds gitAnnexGlobalOptions [] Git.CurrentRepo.get
 		"git-annex"
 		"manage files with git, without checking their contents in"
 	go ((v, a):rest) = maybe (go rest) a =<< getEnv v
diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs
index 4ec7bc875..8bc96a14d 100644
--- a/CmdLine/GitAnnex/Options.hs
+++ b/CmdLine/GitAnnex/Options.hs
@@ -19,6 +19,7 @@ import Types.Messages
 import Types.Key
 import Types.Command
 import Types.DeferredParse
+import Types.DesktopNotify
 import qualified Annex
 import qualified Remote
 import qualified Limit
@@ -26,34 +27,55 @@ import qualified Limit.Wanted
 import CmdLine.Option
 import CmdLine.Usage
 
--- Options that are accepted by all git-annex sub-commands,
+-- Global options that are accepted by all git-annex sub-commands,
 -- although not always used.
-gitAnnexOptions :: [Option]
-gitAnnexOptions = commonOptions ++
-	[ Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber)
-		"override default number of copies"
-	, Option [] ["trust"] (trustArg Trusted)
-		"override trust setting"
-	, Option [] ["semitrust"] (trustArg SemiTrusted)
-		"override trust setting back to default"
-	, Option [] ["untrust"] (trustArg UnTrusted)
-		"override trust setting to untrusted"
-	, Option ['c'] ["config"] (ReqArg setgitconfig "NAME=VALUE")
-		"override git configuration setting"
-	, Option [] ["user-agent"] (ReqArg setuseragent paramName)
-		"override default User-Agent"
-	, Option [] ["trust-glacier"] (NoArg (Annex.setFlag "trustglacier"))
-		"Trust Amazon Glacier inventory"
+gitAnnexGlobalOptions :: Parser GlobalSetter
+gitAnnexGlobalOptions = globalSetters
+	[ commonGlobalOptions
+	, globalSetter setnumcopies $ option auto
+		( long "numcopies" <> short 'N' <> metavar paramNumber
+		<> help "override default number of copies"
+		)
+	, globalSetter (Remote.forceTrust Trusted) $ strOption
+		( long "trust" <> metavar paramRemote
+		<> help "override trust setting"
+		)
+	, globalSetter (Remote.forceTrust SemiTrusted) $ strOption
+		( long "semitrust" <> metavar paramRemote
+		<> help "override trust setting back to default"
+		)
+	, globalSetter (Remote.forceTrust UnTrusted) $ strOption
+		( long "untrust" <> metavar paramRemote
+		<> help "override trust setting to untrusted"
+		)
+	, globalSetter setgitconfig $ strOption
+		( long "config" <> short 'c' <> metavar "NAME=VALUE"
+		<> help "override git configuration setting"
+		)
+	, globalSetter setuseragent $ strOption
+		( long "user-agent" <> metavar paramName
+		<> help "override default User-Agent"
+		)
+	, globalFlag (Annex.setFlag "trustglacier")
+		( long "trust-glacier"
+		<> help "Trust Amazon Glacier inventory"
+		)
+	, globalFlag (setdesktopnotify mkNotifyFinish)
+		( long "notify-finish"
+		<> help "show desktop notification after transfer finishes"
+		)
+	, globalFlag (setdesktopnotify mkNotifyStart)
+		( long "notify-start"
+		<> help "show desktop notification after transfer completes"
+		)
 	]
   where
-	trustArg t = ReqArg (Remote.forceTrust t) paramRemote
-	setnumcopies v = maybe noop
-		(\n -> Annex.changeState $ \s -> s { Annex.forcenumcopies = Just $ NumCopies n })
-		(readish v)
+	setnumcopies n = Annex.changeState $ \s -> s { Annex.forcenumcopies = Just $ NumCopies n }
 	setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v }
 	setgitconfig v = inRepo (Git.Config.store v)
 		>>= pure . (\r -> r { gitGlobalOpts = gitGlobalOpts r ++ [Param "-c", Param v] })
 		>>= Annex.changeGitRepo
+	setdesktopnotify v = Annex.changeState $ \s -> s { Annex.desktopnotify = Annex.desktopnotify s <> v }
 
 parseRemoteOption :: Parser RemoteName -> Parser (DeferredParse Remote)
 parseRemoteOption p = DeferredParse . (fromJust <$$> Remote.byNameWithUUID) . Just <$> p
@@ -177,13 +199,11 @@ parseCombiningOptions =
 		<|> shortopt '(' "open group of options"
 		<|> shortopt ')' "close group of options"
   where
-	longopt o h = globalOpt (Limit.addToken o) $ switch
-		( long o <> help h )
-	shortopt o h = globalOpt (Limit.addToken [o]) $ switch
-		( short o <> help h)
+	longopt o h = globalFlag (Limit.addToken o) ( long o <> help h )
+	shortopt o h = globalFlag (Limit.addToken [o]) ( short o <> help h)
 
 parseJsonOption :: Parser GlobalSetter
-parseJsonOption = globalOpt (Annex.setOutput JSONOutput) $ switch
+parseJsonOption = globalFlag (Annex.setOutput JSONOutput)
 	( long "json" <> short 'j'
 	<> help "enable JSON output"
 	)
diff --git a/CmdLine/GitAnnexShell.hs b/CmdLine/GitAnnexShell.hs
index 386780add..5bc297a71 100644
--- a/CmdLine/GitAnnexShell.hs
+++ b/CmdLine/GitAnnexShell.hs
@@ -8,7 +8,6 @@
 module CmdLine.GitAnnexShell where
 
 import System.Environment
-import System.Console.GetOpt
 
 import Common.Annex
 import qualified Git.Construct
@@ -54,9 +53,13 @@ cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly
   where
 	adddirparam c = c { cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c }
 
-options :: [OptDescr (Annex ())]
-options = commonOptions ++
-	[ Option [] ["uuid"] (ReqArg checkUUID paramUUID) "local repository uuid"
+options :: Parser GlobalSetter
+options = globalSetters
+	[ commonGlobalOptions
+	, globalSetter checkUUID $ strOption
+		( long "uuid" <> metavar paramUUID
+		<> help "local repository uuid"
+		)
 	]
   where
 	checkUUID expected = getUUID >>= check
diff --git a/CmdLine/Option.hs b/CmdLine/Option.hs
index 0cda34ba1..9cb1d41d4 100644
--- a/CmdLine/Option.hs
+++ b/CmdLine/Option.hs
@@ -6,7 +6,7 @@
  -}
 
 module CmdLine.Option (
-	commonOptions,
+	commonGlobalOptions,
 	flagOption,
 	fieldOption,
 	optionName,
@@ -15,35 +15,46 @@ module CmdLine.Option (
 	OptDescr(..),
 ) where
 
+import Options.Applicative
 import System.Console.GetOpt
 
 import Common.Annex
+import CmdLine.Usage
 import qualified Annex
 import Types.Messages
-import Types.DesktopNotify
-import CmdLine.Usage
+import Types.DeferredParse
 
--- Options accepted by both git-annex and git-annex-shell sub-commands.
-commonOptions :: [Option]
-commonOptions =
-	[ Option [] ["force"] (NoArg (setforce True))
-		"allow actions that may lose annexed data"
-	, Option ['F'] ["fast"] (NoArg (setfast True))
-		"avoid slow operations"
-	, Option ['q'] ["quiet"] (NoArg (Annex.setOutput QuietOutput))
-		"avoid verbose output"
-	, Option ['v'] ["verbose"] (NoArg (Annex.setOutput NormalOutput))
-		"allow verbose output (default)"
-	, Option ['d'] ["debug"] (NoArg setdebug)
-		"show debug messages"
-	, Option [] ["no-debug"] (NoArg unsetdebug)
-		"don't show debug messages"
-	, Option ['b'] ["backend"] (ReqArg setforcebackend paramName)
-		"specify key-value backend to use"
-	, Option [] ["notify-finish"] (NoArg (setdesktopnotify mkNotifyFinish))
-		"show desktop notification after transfer finishes"
-	, Option [] ["notify-start"] (NoArg (setdesktopnotify mkNotifyStart))
-		"show desktop notification after transfer completes"
+-- Global options accepted by both git-annex and git-annex-shell sub-commands.
+commonGlobalOptions :: Parser GlobalSetter
+commonGlobalOptions = globalSetters
+	[ globalFlag (setforce True)
+		( long "force" 
+		<> help "allow actions that may lose annexed data"
+		)
+	, globalFlag (setfast True)
+		( long "fast" <> short 'F'
+		<> help "avoid slow operations"
+		)
+	, globalFlag (Annex.setOutput QuietOutput)
+		( long "quiet" <> short 'q'
+		<> help "avoid verbose output"
+		)
+	, globalFlag (Annex.setOutput NormalOutput)
+		( long "verbose" <> short 'v'
+		<> help "allow verbose output (default)"
+		)
+	, globalFlag setdebug
+		( long "debug" <> short 'd'
+		<> help "show debug messages"
+		)
+	, globalFlag unsetdebug
+		( long "no-debug"
+		<> help "don't show debug messages"
+		)
+	, globalSetter setforcebackend $ strOption
+		( long "backend" <> short 'b' <> metavar paramName
+		<> help "specify key-value backend to use"
+		)
 	]
   where
 	setforce v = Annex.changeState $ \s -> s { Annex.force = v }
@@ -51,17 +62,16 @@ commonOptions =
 	setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }
 	setdebug = Annex.changeGitConfig $ \c -> c { annexDebug = True }
 	unsetdebug = Annex.changeGitConfig $ \c -> c { annexDebug = False }
-	setdesktopnotify v = Annex.changeState $ \s -> s { Annex.desktopnotify = Annex.desktopnotify s <> v }
 
 {- An option that sets a flag. -}
 flagOption :: String -> String -> String -> Option
-flagOption short opt description = 
-	Option short [opt] (NoArg (Annex.setFlag opt)) description
+flagOption shortv opt description = 
+	Option shortv [opt] (NoArg (Annex.setFlag opt)) description
 
 {- An option that sets a field. -}
 fieldOption :: String -> String -> String -> String -> Option
-fieldOption short opt paramdesc description = 
-	Option short [opt] (ReqArg (Annex.setField opt) paramdesc) description
+fieldOption shortv opt paramdesc description = 
+	Option shortv [opt] (ReqArg (Annex.setField opt) paramdesc) description
 
 {- The flag or field name used for an option. -}
 optionName :: Option -> String
diff --git a/Types/DeferredParse.hs b/Types/DeferredParse.hs
index 4b5ee6d59..4c6e90175 100644
--- a/Types/DeferredParse.hs
+++ b/Types/DeferredParse.hs
@@ -12,7 +12,7 @@ module Types.DeferredParse where
 import Annex
 import Common
 
-import Options.Applicative.Types
+import Options.Applicative
 
 -- Some values cannot be fully parsed without performing an action.
 -- The action may be expensive, so it's best to call finishParse on such a
@@ -40,11 +40,12 @@ instance DeferredParseClass [DeferredParse a] where
 -- Use when the Annex action modifies Annex state.
 type GlobalSetter = DeferredParse ()
 
-globalOpt :: Annex () -> Parser Bool -> Parser GlobalSetter
-globalOpt setter parser = go <$> parser
-  where
-	go False = ReadyParse ()
-	go True = DeferredParse setter
+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
+
+globalSetters :: [Parser GlobalSetter] -> Parser GlobalSetter
+globalSetters l = DeferredParse . sequence_ . map getParsed
+	<$> many (foldl1 (<|>) l)