Merge branch 'optparse-applicative'

Annex.hs

@@ -57,7 +57,6 @@ import Types.UUID
 import Types.FileMatcher
 import Types.NumCopies
 import Types.LockCache
-import Types.MetaData
 import Types.DesktopNotify
 import Types.CleanupActions
 #ifdef WITH_QUVI
@@ -121,7 +120,6 @@ data AnnexState = AnnexState
 	, lockcache :: LockCache
 	, flags :: M.Map String Bool
 	, fields :: M.Map String String
-	, modmeta :: [ModMeta]
 	, cleanup :: M.Map CleanupAction (Annex ())
 	, sentinalstatus :: Maybe SentinalStatus
 	, useragent :: Maybe String
@@ -166,7 +164,6 @@ newState c r = AnnexState
 	, lockcache = M.empty
 	, flags = M.empty
 	, fields = M.empty
-	, modmeta = []
 	, cleanup = M.empty
 	, sentinalstatus = Nothing
 	, useragent = Nothing

Build/mdwn2man

@@ -45,7 +45,7 @@ while (<>) {
 
 	if ($inNAME) {
 		# make lexgrog happy
-		s/^git-annex /git-annex-/;
+		s/^git-annex (\w)/git-annex-$1/;
 	}
 	if ($_ eq ".SH NAME\n") {
 		$inNAME=1;

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 :: Bool -> CmdParams -> [Command] -> [GlobalOption] -> [(String, String)] -> IO Git.Repo -> String -> String -> IO ()
-dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do
+dispatch fuzzyok allargs allcmds globaloptions fields getgitrepo progname progdesc = do
 	setupConsole
-	case getOptCmd args cmd commonoptions of
+	go =<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo))
-		Right (flags, params) -> go flags params
-			=<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo))
-		Left parseerr -> error parseerr
   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
+	go (Left norepo) = do
-		when fuzzy $
+		(_, a, _globalconfig) <- parsewith
-			autocorrect =<< Git.Config.global
+			(fromMaybe (throw norepo) . cmdnorepo)
-		maybe (throw e) (\a -> a params) (cmdnorepo cmd)
+			(\a -> a =<< Git.Config.global)
-	err msg = msg ++ "\n\n" ++ usage header allcmds
+		a
-	cmd = Prelude.head cmds
+
-	(fuzzy, cmds, name, args) = findCmd fuzzyok allargs allcmds err
+	parsewith getparser ingitrepo = 
-	autocorrect = Git.AutoCorrect.prepare name cmdname cmds
+		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 :: Bool -> CmdParams -> [Command] -> (Bool, [Command], Maybe String, CmdParams)
-findCmd fuzzyok argv cmds err
+findCmd fuzzyok argv cmds
-	| isNothing name = error $ err "missing command"
+	| not (null exactcmds) = ret (False, exactcmds)
-	| not (null exactcmds) = (False, exactcmds, fromJust name, args)
+	| fuzzyok && not (null inexactcmds) = ret (True, inexactcmds)
-	| fuzzyok && not (null inexactcmds) = (True, inexactcmds, fromJust name, args)
+	| otherwise = ret (False, [])
-	| otherwise = error $ err $ "unknown command " ++ fromJust name
   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 =

CmdLine/Action.hs

@@ -22,11 +22,11 @@ import Data.Either
 {- Runs a command, starting with the check stage, and then
  - the seek stage. Finishes by running the continutation, and 
  - then showing a count of any failures. -}
-performCommandAction :: Command -> CmdParams -> Annex () -> Annex ()
+performCommandAction :: Command -> CommandSeek -> Annex () -> Annex ()
-performCommandAction Command { cmdseek = seek, cmdcheck = c, cmdname = name } params cont = do
+performCommandAction Command { cmdcheck = c, cmdname = name } seek cont = do
 	mapM_ runCheck c
 	Annex.changeState $ \s -> s { Annex.errcounter = 0 }
-	seek params
+	seek
 	finishCommandActions
 	cont
 	showerrcount =<< Annex.getState Annex.errcounter

CmdLine/Batch.hs

@@ -10,29 +10,42 @@ module CmdLine.Batch where
 import Common.Annex
 import Command
 
-batchOption :: Option
-batchOption = flagOption [] "batch" "enable batch mode"
-
 data BatchMode = Batch | NoBatch
+
+batchOption :: Parser BatchMode
+batchOption = flag NoBatch Batch
+	( long "batch"
+	<> help "enable batch mode"
+	)
+
 type Batchable t = BatchMode -> t -> CommandStart
 
 -- A Batchable command can run in batch mode, or not.
 -- In batch mode, one line at a time is read, parsed, and a reply output to
 -- stdout. In non batch mode, the command's parameters are parsed and
 -- a reply output for each.
-batchable :: ((t -> CommandStart) -> CommandSeek) -> Batchable t -> CommandSeek
+batchable :: (opts -> String -> Annex Bool) -> Parser opts -> CmdParamsDesc -> CommandParser
-batchable seeker starter params = ifM (getOptionFlag batchOption)
+batchable handler parser paramdesc = batchseeker <$> batchparser
-	( batchloop
-	, seeker (starter NoBatch) params
-	)
   where
-	batchloop = do
+	batchparser = (,,)
+		<$> parser
+		<*> batchOption
+		<*> cmdParams paramdesc
+	
+	batchseeker (opts, NoBatch, params) = mapM_ (go NoBatch opts) params
+	batchseeker (opts, Batch, _) = batchloop opts
+
+	batchloop opts = do
 		mp <- liftIO $ catchMaybeIO getLine
 		case mp of
 			Nothing -> return ()
 			Just p -> do
-				seeker (starter Batch) [p]
+				go Batch opts p
-				batchloop
+				batchloop opts
+
+	go batchmode opts p =
+		unlessM (handler opts p) $
+			batchBadInput batchmode
 
 -- bad input is indicated by an empty line in batch mode. In non batch
 -- mode, exit on bad input.

CmdLine/GitAnnex.hs

@@ -1,6 +1,6 @@
 {- git-annex main program
  -
- - Copyright 2010-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2015 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -14,13 +14,16 @@ import CmdLine
 import Command
 import Utility.Env
 import Annex.Ssh
+import Types.Test
 
+import qualified Command.Help
 import qualified Command.Add
 import qualified Command.Unannex
 import qualified Command.Drop
 import qualified Command.Move
 import qualified Command.Copy
 import qualified Command.Get
+import qualified Command.Fsck
 import qualified Command.LookupKey
 import qualified Command.ContentLocation
 import qualified Command.ExamineKey
@@ -46,7 +49,6 @@ import qualified Command.Init
 import qualified Command.Describe
 import qualified Command.InitRemote
 import qualified Command.EnableRemote
-import qualified Command.Fsck
 import qualified Command.Expire
 import qualified Command.Repair
 import qualified Command.Unused
@@ -96,7 +98,6 @@ import qualified Command.Proxy
 import qualified Command.DiffDriver
 import qualified Command.Undo
 import qualified Command.Version
-import qualified Command.Help
 #ifdef WITH_ASSISTANT
 import qualified Command.Watch
 import qualified Command.Assistant
@@ -117,14 +118,17 @@ import qualified Command.TestRemote
 import System.Remote.Monitoring
 #endif
 
-cmds :: [Command]
+cmds :: Parser TestOptions -> Maybe TestRunner -> [Command]
-cmds = concat
+cmds testoptparser testrunner = 
-	[ Command.Add.cmd
+	[ Command.Help.cmd
+	, Command.Add.cmd
 	, Command.Get.cmd
 	, Command.Drop.cmd
 	, Command.Move.cmd
 	, Command.Copy.cmd
+	, Command.Fsck.cmd
 	, Command.Unlock.cmd
+	, Command.Unlock.editcmd
 	, Command.Lock.cmd
 	, Command.Sync.cmd
 	, Command.Mirror.cmd
@@ -175,7 +179,6 @@ cmds = concat
 	, Command.VPop.cmd
 	, Command.VCycle.cmd
 	, Command.Fix.cmd
-	, Command.Fsck.cmd
 	, Command.Expire.cmd
 	, Command.Repair.cmd
 	, Command.Unused.cmd
@@ -200,7 +203,6 @@ cmds = concat
 	, Command.DiffDriver.cmd
 	, Command.Undo.cmd
 	, Command.Version.cmd
-	, Command.Help.cmd
 #ifdef WITH_ASSISTANT
 	, Command.Watch.cmd
 	, Command.Assistant.cmd
@@ -212,24 +214,25 @@ cmds = concat
 #endif
 	, Command.RemoteDaemon.cmd
 #endif
-	, Command.Test.cmd
+	, Command.Test.cmd testoptparser testrunner
 #ifdef WITH_TESTSUITE
 	, Command.FuzzTest.cmd
 	, Command.TestRemote.cmd
 #endif
 	]
 
-header :: String
+run :: Parser TestOptions -> Maybe TestRunner -> [String] -> IO ()
-header = "git-annex command [option ...]"
+run testoptparser testrunner args = do
-
-run :: [String] -> IO ()
-run args = do
 #ifdef WITH_EKG
 	_ <- forkServer "localhost" 4242
 #endif
 	go envmodes
   where
-	go [] = dispatch True args cmds gitAnnexOptions [] header Git.CurrentRepo.get
+	go [] = dispatch True args 
+		(cmds testoptparser testrunner)
+		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
 	envmodes =
 		[ (sshOptionsEnv, runSshOptions args)

CmdLine/GitAnnex/Options.hs

@@ -1,4 +1,4 @@
-{- git-annex options
+{- git-annex command-line option parsing
  -
  - Copyright 2010-2015 Joey Hess <id@joeyh.name>
  -
@@ -7,7 +7,7 @@
 
 module CmdLine.GitAnnex.Options where
 
-import System.Console.GetOpt
+import Options.Applicative
 
 import Common.Annex
 import qualified Git.Config
@@ -15,63 +15,155 @@ import Git.Types
 import Types.TrustLevel
 import Types.NumCopies
 import Types.Messages
+import Types.Key
+import Types.Command
+import Types.DeferredParse
+import Types.DesktopNotify
 import qualified Annex
 import qualified Remote
 import qualified Limit
 import qualified Limit.Wanted
 import CmdLine.Option
 import CmdLine.Usage
+import CmdLine.GlobalSetter
 
--- 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]
+gitAnnexGlobalOptions :: [GlobalOption]
-gitAnnexOptions = commonOptions ++
+gitAnnexGlobalOptions = commonGlobalOptions ++
-	[ Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber)
+	[ globalSetter setnumcopies $ option auto
-		"override default number of copies"
+		( long "numcopies" <> short 'N' <> metavar paramNumber
-	, Option [] ["trust"] (trustArg Trusted)
+		<> help "override default number of copies"
-		"override trust setting"
+		<> hidden
-	, Option [] ["semitrust"] (trustArg SemiTrusted)
+		)
-		"override trust setting back to default"
+	, globalSetter (Remote.forceTrust Trusted) $ strOption
-	, Option [] ["untrust"] (trustArg UnTrusted)
+		( long "trust" <> metavar paramRemote
-		"override trust setting to untrusted"
+		<> help "override trust setting"
-	, Option ['c'] ["config"] (ReqArg setgitconfig "NAME=VALUE")
+		<> hidden
-		"override git configuration setting"
+		)
-	, Option [] ["user-agent"] (ReqArg setuseragent paramName)
+	, globalSetter (Remote.forceTrust SemiTrusted) $ strOption
-		"override default User-Agent"
+		( long "semitrust" <> metavar paramRemote
-	, Option [] ["trust-glacier"] (NoArg (Annex.setFlag "trustglacier"))
+		<> help "override trust setting back to default"
-		"Trust Amazon Glacier inventory"
+		<> 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
-	trustArg t = ReqArg (Remote.forceTrust t) paramRemote
+	setnumcopies n = Annex.changeState $ \s -> s { Annex.forcenumcopies = Just $ NumCopies n }
-	setnumcopies v = maybe noop
-		(\n -> Annex.changeState $ \s -> s { Annex.forcenumcopies = Just $ NumCopies n })
-		(readish v)
 	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 }
 
--- Options for matching on annexed keys, rather than work tree files.
+{- Parser that accepts all non-option params. -}
-keyOptions :: [Option]
+cmdParams :: CmdParamsDesc -> Parser CmdParams
-keyOptions = [ allOption, unusedOption, keyOption]
+cmdParams paramdesc = many $ argument str
+	( metavar paramdesc
+	-- Let bash completion complete files
+	<> action "file"
+	)
 
-allOption :: Option
+parseAutoOption :: Parser Bool
-allOption = Option ['A'] ["all"] (NoArg (Annex.setFlag "all"))
+parseAutoOption = switch
-	"operate on all versions of all files"
+	( long "auto" <> short 'a'
+	<> help "automatic mode"
+	)
 
-unusedOption :: Option
+parseRemoteOption :: Parser RemoteName -> Parser (DeferredParse Remote)
-unusedOption = Option ['U'] ["unused"] (NoArg (Annex.setFlag "unused"))
+parseRemoteOption p = DeferredParse . (fromJust <$$> Remote.byNameWithUUID) . Just <$> p
-	"operate on files found by last run of git-annex unused"
 
-keyOption :: Option
+data FromToOptions
-keyOption = Option [] ["key"] (ReqArg (Annex.setField "key") paramKey)
+	= FromRemote (DeferredParse Remote)
-		"operate on specified key"
+	| ToRemote (DeferredParse Remote)
 
-incompleteOption :: Option
+instance DeferredParseClass FromToOptions where
-incompleteOption = flagOption [] "incomplete" "resume previous downloads"
+	finishParse (FromRemote v) = FromRemote <$> finishParse v
+	finishParse (ToRemote v) = ToRemote <$> finishParse v
+
+parseFromToOptions :: Parser FromToOptions
+parseFromToOptions = 
+	(FromRemote <$> parseFromOption) 
+	<|> (ToRemote <$> parseToOption)
+
+parseFromOption :: Parser (DeferredParse Remote)
+parseFromOption = parseRemoteOption $ strOption
+	( long "from" <> short 'f' <> metavar paramRemote
+	<> help "source remote"
+	)
+
+parseToOption :: Parser (DeferredParse Remote)
+parseToOption = parseRemoteOption $ strOption
+	( long "to" <> short 't' <> metavar paramRemote
+	<> help "destination remote"
+	)
+
+-- Options for acting on keys, rather than work tree files.
+data KeyOptions
+	= WantAllKeys
+	| WantUnusedKeys
+	| WantSpecificKey Key
+	| WantIncompleteKeys
+
+parseKeyOptions :: Bool -> Parser KeyOptions
+parseKeyOptions allowincomplete = if allowincomplete
+	then base
+		<|> flag' WantIncompleteKeys
+			( long "incomplete"
+			<> help "resume previous downloads"
+			)
+	else base
+  where
+	base = parseAllOption
+		<|> flag' WantUnusedKeys
+			( long "unused" <> short 'U'
+			<> help "operate on files found by last run of git-annex unused"
+			)
+		<|> (WantSpecificKey <$> option (str >>= parseKey)
+			( long "key" <> metavar paramKey
+			<> help "operate on specified key"
+			))
+
+parseAllOption :: Parser KeyOptions
+parseAllOption = flag' WantAllKeys
+	( long "all" <> short 'A'
+	<> help "operate on all versions of all files"
+	)
+
+parseKey :: Monad m => String -> m Key
+parseKey = maybe (fail "invalid key") return . file2key
 
 -- Options to match properties of annexed files.
-annexedMatchingOptions :: [Option]
+annexedMatchingOptions :: [GlobalOption]
 annexedMatchingOptions = concat
 	[ nonWorkTreeMatchingOptions'
 	, fileMatchingOptions'
@@ -80,84 +172,132 @@ annexedMatchingOptions = concat
 	]
 
 -- Matching options that don't need to examine work tree files.
-nonWorkTreeMatchingOptions :: [Option]
+nonWorkTreeMatchingOptions :: [GlobalOption]
 nonWorkTreeMatchingOptions = nonWorkTreeMatchingOptions' ++ combiningOptions
 
-nonWorkTreeMatchingOptions' :: [Option]
+nonWorkTreeMatchingOptions' :: [GlobalOption]
 nonWorkTreeMatchingOptions' = 
-	[ Option ['i'] ["in"] (ReqArg Limit.addIn paramRemote)
+	[ globalSetter Limit.addIn $ strOption
-		"match files present in a remote"
+		( long "in" <> short 'i' <> metavar paramRemote
-	, Option ['C'] ["copies"] (ReqArg Limit.addCopies paramNumber)
+		<> help "match files present in a remote"
-		"skip files with fewer copies"
+		<> hidden
-	, Option [] ["lackingcopies"] (ReqArg (Limit.addLackingCopies False) paramNumber)
+		)
-		"match files that need more copies"
+	, globalSetter Limit.addCopies $ strOption
-	, Option [] ["approxlackingcopies"] (ReqArg (Limit.addLackingCopies True) paramNumber)
+		( long "copies" <> short 'C' <> metavar paramRemote
-		"match files that need more copies (faster)"
+		<> help "skip files with fewer copies"
-	, Option ['B'] ["inbackend"] (ReqArg Limit.addInBackend paramName)
+		<> hidden
-		"match files using a key-value backend"
+		)
-	, Option [] ["inallgroup"] (ReqArg Limit.addInAllGroup paramGroup)
+	, globalSetter (Limit.addLackingCopies False) $ strOption
-		"match files present in all remotes in a group"
+		( long "lackingcopies" <> metavar paramNumber
-	, Option [] ["metadata"] (ReqArg Limit.addMetaData "FIELD=VALUE")
+		<> help "match files that need more copies"
-		"match files with attached metadata"
+		<> hidden
-	, Option [] ["want-get"] (NoArg Limit.Wanted.addWantGet)
+		)
-		"match files the repository wants to get"
+	, globalSetter (Limit.addLackingCopies True) $ strOption
-	, Option [] ["want-drop"] (NoArg Limit.Wanted.addWantDrop)
+		( long "approxlackingcopies" <> metavar paramNumber
-		"match files the repository wants to drop"
+		<> help "match files that need more copies (faster)"
+		<> hidden
+		)
+	, globalSetter Limit.addInBackend $ strOption
+		( long "inbackend" <> short 'B' <> metavar paramName
+		<> help "match files using a key-value backend"
+		<> hidden
+		)
+	, globalSetter Limit.addInAllGroup $ strOption
+		( long "inallgroup" <> metavar paramGroup
+		<> help "match files present in all remotes in a group"
+		<> hidden
+		)
+	, globalSetter Limit.addMetaData $ strOption
+		( long "metadata" <> metavar "FIELD=VALUE"
+		<> help "match files with attached metadata"
+		<> hidden
+		)
+	, globalFlag Limit.Wanted.addWantGet
+		( long "want-get"
+		<> help "match files the repository wants to get"
+		<> hidden
+		)
+	, globalFlag Limit.Wanted.addWantDrop
+		( long "want-drop"
+		<> help "match files the repository wants to drop"
+		<> hidden
+		)
 	]
 
 -- Options to match files which may not yet be annexed.
-fileMatchingOptions :: [Option]
+fileMatchingOptions :: [GlobalOption]
 fileMatchingOptions = fileMatchingOptions' ++ combiningOptions
 
-fileMatchingOptions' :: [Option]
+fileMatchingOptions' :: [GlobalOption]
 fileMatchingOptions' =
-	[ Option ['x'] ["exclude"] (ReqArg Limit.addExclude paramGlob)
+	[ globalSetter Limit.addExclude $ strOption
-		"skip files matching the glob pattern"
+		( long "exclude" <> short 'x' <> metavar paramGlob
-	, Option ['I'] ["include"] (ReqArg Limit.addInclude paramGlob)
+		<> help "skip files matching the glob pattern"
-		"limit to files matching the glob pattern"
+		<> hidden
-	, Option [] ["largerthan"] (ReqArg Limit.addLargerThan paramSize)
+		)
-		"match files larger than a size"
+	, globalSetter Limit.addInclude $ strOption
-	, Option [] ["smallerthan"] (ReqArg Limit.addSmallerThan paramSize)
+		( long "include" <> short 'I' <> metavar paramGlob
-		"match files smaller than a size"
+		<> help "limit to files matching the glob pattern"
+		<> hidden
+		)
+	, globalSetter Limit.addLargerThan $ strOption
+		( long "largerthan" <> metavar paramSize
+		<> help "match files larger than a size"
+		<> hidden
+		)
+	, globalSetter Limit.addSmallerThan $ strOption
+		( long "smallerthan" <> metavar paramSize
+		<> help "match files smaller than a size"
+		<> hidden
+		)
 	]
 
-combiningOptions :: [Option]
+combiningOptions :: [GlobalOption]
-combiningOptions =
+combiningOptions = 
 	[ longopt "not" "negate next option"
 	, longopt "and" "both previous and next option must match"
 	, longopt "or" "either previous or next option must match"
-	, shortopt "(" "open group of options"
+	, shortopt '(' "open group of options"
-	, shortopt ")" "close group of options"
+	, shortopt ')' "close group of options"
 	]
   where
-	longopt o = Option [] [o] $ NoArg $ Limit.addToken o
+	longopt o h = globalFlag (Limit.addToken o) ( long o <> help h <> hidden )
-	shortopt o = Option o [] $ NoArg $ Limit.addToken o
+	shortopt o h = globalFlag (Limit.addToken [o]) ( short o <> help h <> hidden )
 
-fromOption :: Option
+jsonOption :: GlobalOption
-fromOption = fieldOption ['f'] "from" paramRemote "source remote"
+jsonOption = globalFlag (Annex.setOutput JSONOutput)
+	( long "json" <> short 'j'
+	<> help "enable JSON output"
+	<> hidden
+	)
 
-toOption :: Option
+jobsOption :: GlobalOption
-toOption = fieldOption ['t'] "to" paramRemote "destination remote"
+jobsOption = globalSetter (Annex.setOutput . ParallelOutput) $ 
+	option auto
+		( long "jobs" <> short 'J' <> metavar paramNumber
+		<> help "enable concurrent jobs"
+		<> hidden
+		)
 
-fromToOptions :: [Option]
+timeLimitOption :: GlobalOption
-fromToOptions = [fromOption, toOption]
+timeLimitOption = globalSetter Limit.addTimeLimit $ strOption
+	( long "time-limit" <> short 'T' <> metavar paramTime
+	<> help "stop after the specified amount of time"
+	<> hidden
+	)
 
-jsonOption :: Option
+data DaemonOptions = DaemonOptions
-jsonOption = Option ['j'] ["json"] (NoArg (Annex.setOutput JSONOutput))
+	{ foregroundDaemonOption :: Bool
-	"enable JSON output"
+	, stopDaemonOption :: Bool
+	}
 
-jobsOption :: Option
+parseDaemonOptions :: Parser DaemonOptions
-jobsOption = Option ['J'] ["jobs"] (ReqArg set paramNumber)
+parseDaemonOptions = DaemonOptions
-	"enable concurrent jobs"
+	<$> switch
-  where
+		( long "foreground"
-	set s = case readish s of
+		<> help "do not daemonize"
-		Nothing -> error "Bad --jobs number"
+		)
-		Just n -> Annex.setOutput (ParallelOutput n)
+	<*> switch
-
+		( long "stop"
-timeLimitOption :: Option
+		<> help "stop daemon"
-timeLimitOption = Option ['T'] ["time-limit"]
+		)
-	(ReqArg Limit.addTimeLimit paramTime)
-	"stop after the specified amount of time"
-
-autoOption :: Option
-autoOption = flagOption ['a'] "auto" "automatic mode"

CmdLine/GitAnnexShell.hs

@@ -8,15 +8,14 @@
 module CmdLine.GitAnnexShell where
 
 import System.Environment
-import System.Console.GetOpt
 
 import Common.Annex
 import qualified Git.Construct
 import qualified Git.Config
 import CmdLine
+import CmdLine.GlobalSetter
 import Command
 import Annex.UUID
-import Annex (setField)
 import CmdLine.GitAnnexShell.Fields
 import Utility.UserInfo
 import Remote.GCrypt (getGCryptUUID)
@@ -34,7 +33,7 @@ import qualified Command.NotifyChanges
 import qualified Command.GCryptSetup
 
 cmds_readonly :: [Command]
-cmds_readonly = concat
+cmds_readonly =
 	[ gitAnnexShellCheck Command.ConfigList.cmd
 	, gitAnnexShellCheck Command.InAnnex.cmd
 	, gitAnnexShellCheck Command.SendKey.cmd
@@ -43,7 +42,7 @@ cmds_readonly = concat
 	]
 
 cmds_notreadonly :: [Command]
-cmds_notreadonly = concat
+cmds_notreadonly =
 	[ gitAnnexShellCheck Command.RecvKey.cmd
 	, gitAnnexShellCheck Command.DropKey.cmd
 	, gitAnnexShellCheck Command.Commit.cmd
@@ -55,10 +54,13 @@ cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly
   where
 	adddirparam c = c { cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c }
 
-options :: [OptDescr (Annex ())]
+globalOptions :: [GlobalOption]
-options = commonOptions ++
+globalOptions = 
-	[ Option [] ["uuid"] (ReqArg checkUUID paramUUID) "local repository uuid"
+	globalSetter checkUUID (strOption
-	]
+		( long "uuid" <> metavar paramUUID
+		<> help "local repository uuid"
+		))
+	: commonGlobalOptions
   where
 	checkUUID expected = getUUID >>= check
 	  where
@@ -74,9 +76,6 @@ options = commonOptions ++
 	unexpected expected s = error $
 		"expected repository UUID " ++ expected ++ " but found " ++ s
 
-header :: String
-header = "git-annex-shell [-c] command [parameters ...] [option ...]"
-
 run :: [String] -> IO ()
 run [] = failure
 -- skip leading -c options, passed by eg, ssh
@@ -100,12 +99,12 @@ builtin cmd dir params = do
 	checkNotReadOnly cmd
 	checkDirectory $ Just dir
 	let (params', fieldparams, opts) = partitionParams params
-	    fields = filter checkField $ parseFields fieldparams
+	    rsyncopts = ("RsyncOptions", unwords opts)
-	    cmds' = map (newcmd $ unwords opts) cmds
+	    fields = rsyncopts : filter checkField (parseFields fieldparams)
-	dispatch False (cmd : params') cmds' options fields header mkrepo
+	dispatch False (cmd : params') cmds globalOptions fields mkrepo
+		"git-annex-shell"
+		"Restricted login shell for git-annex only SSH access"
   where
-	addrsyncopts opts seek k = setField "RsyncOptions" opts >> seek k
-	newcmd opts c = c { cmdseek = addrsyncopts opts (cmdseek c) }
 	mkrepo = do
 		r <- Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath
 		Git.Config.read r
@@ -143,14 +142,16 @@ parseFields = map (separate (== '='))
 {- Only allow known fields to be set, ignore others.
  - Make sure that field values make sense. -}
 checkField :: (String, String) -> Bool
-checkField (field, value)
+checkField (field, val)
-	| field == fieldName remoteUUID = fieldCheck remoteUUID value
+	| field == fieldName remoteUUID = fieldCheck remoteUUID val
-	| field == fieldName associatedFile = fieldCheck associatedFile value
+	| field == fieldName associatedFile = fieldCheck associatedFile val
-	| field == fieldName direct = fieldCheck direct value
+	| field == fieldName direct = fieldCheck direct val
 	| otherwise = False
 
 failure :: IO ()
-failure = error $ "bad parameters\n\n" ++ usage header cmds
+failure = error $ "bad parameters\n\n" ++ usage h cmds
+  where
+	h = "git-annex-shell [-c] command [parameters ...] [option ...]"
 
 checkNotLimited :: IO ()
 checkNotLimited = checkEnv "GIT_ANNEX_SHELL_LIMITED"
@@ -200,8 +201,8 @@ checkEnv var = do
 
 {- Modifies a Command to check that it is run in either a git-annex
  - repository, or a repository with a gcrypt-id set. -}
-gitAnnexShellCheck :: [Command] -> [Command]
+gitAnnexShellCheck :: Command -> Command
-gitAnnexShellCheck = map $ addCheck okforshell . dontCheck repoExists
+gitAnnexShellCheck = addCheck okforshell . dontCheck repoExists
   where
 	okforshell = unlessM (isInitialized <||> isJust . gcryptId <$> Annex.getGitConfig) $
 		error "Not a git-annex or gcrypt repository."

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 -> GlobalOption
+globalFlag setter = flag' (DeferredParse setter) 
+
+globalSetter :: (v -> Annex ()) -> Parser v -> GlobalOption
+globalSetter setter parser = DeferredParse . setter <$> parser
+
+combineGlobalOptions :: [GlobalOption] -> Parser GlobalSetter
+combineGlobalOptions l = DeferredParse . sequence_ . map getParsed
+	<$> many (foldl1 (<|>) l)

CmdLine/Option.hs

@@ -5,45 +5,55 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module CmdLine.Option (
+module CmdLine.Option where
-	commonOptions,
-	flagOption,
-	fieldOption,
-	optionName,
-	optionParam,
-	ArgDescr(..),
-	OptDescr(..),
-) where
 
-import System.Console.GetOpt
+import Options.Applicative
 
 import Common.Annex
+import CmdLine.Usage
+import CmdLine.GlobalSetter
 import qualified Annex
 import Types.Messages
-import Types.DesktopNotify
+import Types.DeferredParse
-import CmdLine.Usage
 
--- Options accepted by both git-annex and git-annex-shell sub-commands.
+-- Global options accepted by both git-annex and git-annex-shell sub-commands.
-commonOptions :: [Option]
+commonGlobalOptions :: [GlobalOption]
-commonOptions =
+commonGlobalOptions =
-	[ Option [] ["force"] (NoArg (setforce True))
+	[ globalFlag (setforce True)
-		"allow actions that may lose annexed data"
+		( long "force" 
-	, Option ['F'] ["fast"] (NoArg (setfast True))
+		<> help "allow actions that may lose annexed data"
-		"avoid slow operations"
+		<> hidden
-	, Option ['q'] ["quiet"] (NoArg (Annex.setOutput QuietOutput))
+		)
-		"avoid verbose output"
+	, globalFlag (setfast True)
-	, Option ['v'] ["verbose"] (NoArg (Annex.setOutput NormalOutput))
+		( long "fast" <> short 'F'
-		"allow verbose output (default)"
+		<> help "avoid slow operations"
-	, Option ['d'] ["debug"] (NoArg setdebug)
+		<> hidden
-		"show debug messages"
+		)
-	, Option [] ["no-debug"] (NoArg unsetdebug)
+	, globalFlag (Annex.setOutput QuietOutput)
-		"don't show debug messages"
+		( long "quiet" <> short 'q'
-	, Option ['b'] ["backend"] (ReqArg setforcebackend paramName)
+		<> help "avoid verbose output"
-		"specify key-value backend to use"
+		<> hidden
-	, Option [] ["notify-finish"] (NoArg (setdesktopnotify mkNotifyFinish))
+		)
-		"show desktop notification after transfer finishes"
+	, globalFlag (Annex.setOutput NormalOutput)
-	, Option [] ["notify-start"] (NoArg (setdesktopnotify mkNotifyStart))
+		( long "verbose" <> short 'v'
-		"show desktop notification after transfer completes"
+		<> 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
 	setforce v = Annex.changeState $ \s -> s { Annex.force = v }
@@ -51,21 +61,3 @@ 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
-
-{- 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
-
-{- The flag or field name used for an option. -}
-optionName :: Option -> String
-optionName (Option _ o _ _) = Prelude.head o
-
-optionParam :: Option -> String
-optionParam o = "--" ++ optionName o

CmdLine/Seek.hs

@@ -22,18 +22,18 @@ import qualified Git.LsFiles as LsFiles
 import qualified Git.LsTree as LsTree
 import Git.FilePath
 import qualified Limit
-import CmdLine.Option
+import CmdLine.GitAnnex.Options
 import CmdLine.Action
 import Logs.Location
 import Logs.Unused
 import Annex.CatFile
 import Annex.Content
 
-withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek
+withFilesInGit :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
 withFilesInGit a params = seekActions $ prepFiltered a $
 	seekHelper LsFiles.inRepo params
 
-withFilesInGitNonRecursive :: (FilePath -> CommandStart) -> CommandSeek
+withFilesInGitNonRecursive :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
 withFilesInGitNonRecursive a params = ifM (Annex.getState Annex.force)
 	( withFilesInGit a params
 	, if null params
@@ -54,7 +54,7 @@ withFilesInGitNonRecursive a params = ifM (Annex.getState Annex.force)
 			_ -> needforce
 	needforce = error "Not recursively setting metadata. Use --force to do that."
 
-withFilesNotInGit :: Bool -> (FilePath -> CommandStart) -> CommandSeek
+withFilesNotInGit :: Bool -> (FilePath -> CommandStart) -> CmdParams -> CommandSeek
 withFilesNotInGit skipdotfiles a params
 	| skipdotfiles = do
 		{- dotfiles are not acted on unless explicitly listed -}
@@ -73,7 +73,7 @@ withFilesNotInGit skipdotfiles a params
 	go l = seekActions $ prepFiltered a $
 		return $ concat $ segmentPaths params l
 
-withFilesInRefs :: (FilePath -> Key -> CommandStart) -> CommandSeek
+withFilesInRefs :: (FilePath -> Key -> CommandStart) -> CmdParams -> CommandSeek
 withFilesInRefs a = mapM_ go
   where
 	go r = do	
@@ -87,7 +87,7 @@ withFilesInRefs a = mapM_ go
 				Just k -> whenM (matcher $ MatchingKey k) $
 					commandAction $ a f k
 
-withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CommandSeek
+withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CmdParams -> CommandSeek
 withPathContents a params = do
 	matcher <- Limit.getMatcher
 	seekActions $ map a <$> (filterM (checkmatch matcher) =<< ps)
@@ -103,27 +103,27 @@ withPathContents a params = do
 		, matchFile = relf
 		}
 
-withWords :: ([String] -> CommandStart) -> CommandSeek
+withWords :: ([String] -> CommandStart) -> CmdParams -> CommandSeek
 withWords a params = seekActions $ return [a params]
 
-withStrings :: (String -> CommandStart) -> CommandSeek
+withStrings :: (String -> CommandStart) -> CmdParams -> CommandSeek
 withStrings a params = seekActions $ return $ map a params
 
-withPairs :: ((String, String) -> CommandStart) -> CommandSeek
+withPairs :: ((String, String) -> CommandStart) -> CmdParams -> CommandSeek
 withPairs a params = seekActions $ return $ map a $ pairs [] params
   where
 	pairs c [] = reverse c
 	pairs c (x:y:xs) = pairs ((x,y):c) xs
 	pairs _ _ = error "expected pairs"
 
-withFilesToBeCommitted :: (String -> CommandStart) -> CommandSeek
+withFilesToBeCommitted :: (String -> CommandStart) -> CmdParams -> CommandSeek
 withFilesToBeCommitted a params = seekActions $ prepFiltered a $
 	seekHelper LsFiles.stagedNotDeleted params
 
-withFilesUnlocked :: (FilePath -> CommandStart) -> CommandSeek
+withFilesUnlocked :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
 withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged
 
-withFilesUnlockedToBeCommitted :: (FilePath -> CommandStart) -> CommandSeek
+withFilesUnlockedToBeCommitted :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
 withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
 
 {- Unlocked files have changed type from a symlink to a regular file.
@@ -131,7 +131,7 @@ withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
  - Furthermore, unlocked files used to be a git-annex symlink,
  - not some other sort of symlink.
  -}
-withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> CommandSeek
+withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> CmdParams -> CommandSeek
 withFilesUnlocked' typechanged a params = seekActions $
 	prepFiltered a unlockedfiles
   where
@@ -142,25 +142,16 @@ isUnlocked f = liftIO (notSymlink f) <&&>
 	(isJust <$> catKeyFile f <||> isJust <$> catKeyFileHEAD f)
 
 {- Finds files that may be modified. -}
-withFilesMaybeModified :: (FilePath -> CommandStart) -> CommandSeek
+withFilesMaybeModified :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
 withFilesMaybeModified a params = seekActions $
 	prepFiltered a $ seekHelper LsFiles.modified params
 
-withKeys :: (Key -> CommandStart) -> CommandSeek
+withKeys :: (Key -> CommandStart) -> CmdParams -> CommandSeek
 withKeys a params = seekActions $ return $ map (a . parse) params
   where
 	parse p = fromMaybe (error "bad key") $ file2key p
 
-{- Gets the value of a field options, which is fed into
+withNothing :: CommandStart -> CmdParams -> CommandSeek
- - a conversion function.
- -}
-getOptionField :: Option -> (Maybe String -> Annex a) -> Annex a
-getOptionField option converter = converter <=< Annex.getField $ optionName option
-
-getOptionFlag :: Option -> Annex Bool
-getOptionFlag option = Annex.getFlag (optionName option)
-
-withNothing :: CommandStart -> CommandSeek
 withNothing a [] = seekActions $ return [a]
 withNothing _ _ = error "This command takes no parameters."
 
@@ -171,40 +162,34 @@ withNothing _ _ = error "This command takes no parameters."
  -
  - Otherwise falls back to a regular CommandSeek action on
  - whatever params were passed. -}
-withKeyOptions :: Bool -> (Key -> CommandStart) -> CommandSeek -> CommandSeek
+withKeyOptions :: Maybe KeyOptions -> Bool -> (Key -> CommandStart) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek
-withKeyOptions auto keyop = withKeyOptions' auto $ \getkeys -> do
+withKeyOptions ko auto keyaction = withKeyOptions' ko auto $ \getkeys -> do
 	matcher <- Limit.getMatcher
 	seekActions $ map (process matcher) <$> getkeys
   where
 	process matcher k = ifM (matcher $ MatchingKey k)
-		( keyop k
+		( keyaction k
 		, return Nothing
 		)
 
-withKeyOptions' :: Bool -> (Annex [Key] -> Annex ()) -> CommandSeek -> CommandSeek
+withKeyOptions' :: Maybe KeyOptions -> Bool -> (Annex [Key] -> Annex ()) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek
-withKeyOptions' auto keyop fallbackop params = do
+withKeyOptions' ko auto keyaction fallbackaction params = do
 	bare <- fromRepo Git.repoIsLocalBare
-	allkeys <- Annex.getFlag "all"
-	unused <- Annex.getFlag "unused"
-	incomplete <- Annex.getFlag "incomplete"
-	specifickey <- Annex.getField "key"
 	when (auto && bare) $
 		error "Cannot use --auto in a bare repository"
-	case	(allkeys, unused, incomplete, null params, specifickey) of
+	case (null params, ko) of
-		(False  , False , False     , True       , Nothing)
+		(True, Nothing)
 			| bare -> go auto loggedKeys
-			| otherwise -> fallbackop params
+			| otherwise -> fallbackaction params
-		(False  , False , False     , _          , Nothing) -> fallbackop params
+		(False, Nothing) -> fallbackaction params
-		(True   , False , False     , True       , Nothing) -> go auto loggedKeys
+		(True, Just WantAllKeys) -> go auto loggedKeys
-		(False  , True  , False     , True       , Nothing) -> go auto unusedKeys'
+		(True, Just WantUnusedKeys) -> go auto unusedKeys'
-		(False  , False , True      , True       , Nothing) -> go auto incompletekeys
+		(True, Just (WantSpecificKey k)) -> go auto $ return [k]
-		(False  , False , False     , True       , Just ks) -> case file2key ks of
+		(True, Just WantIncompleteKeys) -> go auto incompletekeys
-			Nothing -> error "Invalid key"
+		(False, Just _) -> error "Can only specify one of file names, --all, --unused, --key, or --incomplete"
-			Just k -> go auto $ return [k]
-		_ -> error "Can only specify one of file names, --all, --unused, --key, or --incomplete"
   where
 	go True _ = error "Cannot use --auto with --all or --unused or --key or --incomplete"
-	go False getkeys = keyop getkeys
+	go False getkeys = keyaction getkeys
 	incompletekeys = staleKeysPrune gitAnnexTmpObjectDir True
 
 prepFiltered :: (FilePath -> CommandStart) -> Annex [FilePath] -> Annex [CommandStart]

CmdLine/Usage.hs

@@ -1,6 +1,6 @@
 {- git-annex usage messages
  -
- - Copyright 2010-2011 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2015 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -8,17 +8,17 @@
 module CmdLine.Usage where
 
 import Common.Annex
-
 import Types.Command
 
-import System.Console.GetOpt
-
 usageMessage :: String -> String
 usageMessage s = "Usage: " ++ s
 
-{- Usage message with lists of commands by section. -}
 usage :: String -> [Command] -> String
-usage header cmds = unlines $ usageMessage header : concatMap go [minBound..]
+usage header cmds = unlines $ usageMessage header : commandList cmds
+
+{- Commands listed by section, with breif usage and description. -}
+commandList :: [Command] -> [String]
+commandList cmds = concatMap go [minBound..]
   where
 	go section
 		| null cs = []
@@ -42,23 +42,10 @@ usage header cmds = unlines $ usageMessage header : concatMap go [minBound..]
 	longest f = foldl max 0 $ map (length . f) cmds
 	scmds = sort cmds
 
-{- Usage message for a single command. -}
-commandUsage :: Command -> String
-commandUsage cmd = unlines
-	[ usageInfo header (cmdoptions cmd)
-	, "To see additional options common to all commands, run: git annex help options"
-	]
-  where
-	header = usageMessage $ unwords
-		[ "git-annex"
-		, cmdname cmd
-		, cmdparamdesc cmd
-		, "[option ...]"
-		]
 
 {- Descriptions of params used in usage messages. -}
 paramPaths :: String
-paramPaths = paramOptional $ paramRepeating paramPath -- most often used
+paramPaths = paramRepeating paramPath -- most often used
 paramPath :: String
 paramPath = "PATH"
 paramKey :: String
@@ -114,6 +101,6 @@ paramNothing = ""
 paramRepeating :: String -> String
 paramRepeating s = s ++ " ..."
 paramOptional :: String -> String
-paramOptional s = "[" ++ s ++ "]"
+paramOptional s = s
 paramPair :: String -> String -> String
 paramPair a b = a ++ " " ++ b

Command.hs

@@ -1,16 +1,18 @@
 {- git-annex command infrastructure
  -
- - Copyright 2010-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2015 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
 module Command (
 	command,
+	withParams,
+	(<--<),
 	noRepo,
 	noCommit,
 	noMessages,
-	withOptions,
+	withGlobalOptions,
 	next,
 	stop,
 	stopUnless,
@@ -25,16 +27,38 @@ import qualified Backend
 import qualified Git
 import Types.Command as ReExported
 import Types.Option as ReExported
+import Types.DeferredParse as ReExported
 import CmdLine.Seek as ReExported
 import Checks as ReExported
 import CmdLine.Usage as ReExported
 import CmdLine.Action as ReExported
 import CmdLine.Option as ReExported
+import CmdLine.GlobalSetter as ReExported
 import CmdLine.GitAnnex.Options as ReExported
+import Options.Applicative as ReExported hiding (command)
 
-{- Generates a normal command -}
+import qualified Options.Applicative as O
-command :: String -> String -> CommandSeek -> CommandSection -> String -> Command
+
-command = Command [] Nothing commonChecks False False
+{- Generates a normal Command -}
+command :: String -> CommandSection -> String -> CmdParamsDesc -> (CmdParamsDesc -> CommandParser) -> Command
+command name section desc paramdesc mkparser =
+	Command commonChecks False False name paramdesc 
+		section desc (mkparser paramdesc) Nothing
+
+{- Simple option parser that takes all non-option params as-is. -}
+withParams :: (CmdParams -> v) -> CmdParamsDesc -> O.Parser v
+withParams mkseek paramdesc = mkseek <$> cmdParams paramdesc
+
+{- Uses the supplied option parser, which yields a deferred parse,
+ - and calls finishParse on the result before passing it to the
+ - CommandSeek constructor. -}
+(<--<) :: DeferredParseClass a
+	=> (a -> CommandSeek) 
+	-> (CmdParamsDesc -> Parser a)
+	-> CmdParamsDesc
+	-> Parser CommandSeek
+(<--<) mkseek optparser paramsdesc = 
+	(mkseek <=< finishParse) <$> optparser paramsdesc
 
 {- Indicates that a command doesn't need to commit any changes to
  - the git-annex branch. -}
@@ -48,12 +72,21 @@ noMessages c = c { cmdnomessages = True }
 
 {- Adds a fallback action to a command, that will be run if it's used
  - outside a git repository. -}
-noRepo :: (CmdParams -> IO ()) -> Command -> Command
+noRepo :: (String -> O.Parser (IO ())) -> Command -> Command
-noRepo a c = c { cmdnorepo = Just a }
+noRepo a c = c { cmdnorepo = Just (a (cmdparamdesc c)) }
 
-{- Adds options to a command. -}
+{- Adds global options to a command's option parser, and modifies its seek
-withOptions :: [Option] -> Command -> Command
+ - option to first run actions for them.
-withOptions o c = c { cmdoptions = cmdoptions c ++ o }
+ -}
+withGlobalOptions :: [GlobalOption] -> Command -> Command
+withGlobalOptions os c = c { cmdparser = apply <$> mixin (cmdparser c) }
+  where
+	mixin p = (,) 
+		<$> p
+		<*> combineGlobalOptions os
+	apply (seek, globalsetters) = do
+		void $ getParsed globalsetters
+		seek
 
 {- For start and perform stages to indicate what step to run next. -}
 next :: a -> Annex (Maybe a)

Command/Add.hs

@@ -34,28 +34,35 @@ import Utility.Tmp
 
 import Control.Exception (IOException)
 
-cmd :: [Command]
+cmd :: Command
-cmd = [notBareRepo $ withOptions addOptions $
+cmd = notBareRepo $ withGlobalOptions fileMatchingOptions $
-	command "add" paramPaths seek SectionCommon "add files to annex"]
+	command "add" SectionCommon "add files to annex"
+		paramPaths (seek <$$> optParser)
 
-addOptions :: [Option]
+data AddOptions = AddOptions
-addOptions = includeDotFilesOption : fileMatchingOptions
+	{ addThese :: CmdParams
+	, includeDotFiles :: Bool
+	}
 
-includeDotFilesOption :: Option
+optParser :: CmdParamsDesc -> Parser AddOptions
-includeDotFilesOption = flagOption [] "include-dotfiles" "don't skip dotfiles"
+optParser desc = AddOptions
+	<$> cmdParams desc
+	<*> switch
+		( long "include-dotfiles"
+		<> help "don't skip dotfiles"
+		)
 
 {- Add acts on both files not checked into git yet, and unlocked files.
  -
  - In direct mode, it acts on any files that have changed. -}
-seek :: CommandSeek
+seek :: AddOptions -> CommandSeek
-seek ps = do
+seek o = do
 	matcher <- largeFilesMatcher
-	let go a = flip a ps $ \file -> ifM (checkFileMatcher matcher file <||> Annex.getState Annex.force)
+	let go a = flip a (addThese o) $ \file -> ifM (checkFileMatcher matcher file <||> Annex.getState Annex.force)
 		( start file
 		, startSmall file
 		)
-	skipdotfiles <- not <$> Annex.getFlag (optionName includeDotFilesOption)
+	go $ withFilesNotInGit (not $ includeDotFiles o)
-	go $ withFilesNotInGit skipdotfiles
 	ifM isDirect
 		( go withFilesMaybeModified
 		, go withFilesUnlocked
@@ -70,8 +77,8 @@ startSmall file = do
 
 performAdd :: FilePath -> CommandPerform
 performAdd file = do
-	params <- forceParams
+	ps <- forceParams
-	Annex.Queue.addCommand "add" (params++[Param "--"]) [file]
+	Annex.Queue.addCommand "add" (ps++[Param "--"]) [file]
 	next $ return True
 
 {- The add subcommand annexes a file, generating a key for it using a
@@ -278,8 +285,8 @@ addLink :: FilePath -> Key -> Maybe InodeCache -> Annex ()
 addLink file key mcache = ifM (coreSymlinks <$> Annex.getGitConfig)
 	( do
 		_ <- link file key mcache
-		params <- forceParams
+		ps <- forceParams
-		Annex.Queue.addCommand "add" (params++[Param "--"]) [file]
+		Annex.Queue.addCommand "add" (ps++[Param "--"]) [file]
 	, do
 		l <- link file key mcache
 		addAnnexLink l file

Command/AddUnused.hs

@@ -14,11 +14,13 @@ import qualified Command.Add
 import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
 import Types.Key
 
-cmd :: [Command]
+cmd :: Command
-cmd = [notDirect $ command "addunused" (paramRepeating paramNumRange)
+cmd = notDirect $ 
-	seek SectionMaintenance "add back unused files"]
+	command "addunused" SectionMaintenance 
+		"add back unused files"
+		(paramRepeating paramNumRange) (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withUnusedMaps start
 
 start :: UnusedMaps -> Int -> CommandStart

Command/AddUrl.hs

@@ -37,34 +37,51 @@ import Annex.Quvi
 import qualified Utility.Quvi as Quvi
 #endif
 
-cmd :: [Command]
+cmd :: Command
-cmd = [notBareRepo $ withOptions [fileOption, pathdepthOption, relaxedOption, rawOption] $
+cmd = notBareRepo $
-	command "addurl" (paramRepeating paramUrl) seek
+	command "addurl" SectionCommon "add urls to annex"
-		SectionCommon "add urls to annex"]
+		(paramRepeating paramUrl) (seek <$$> optParser)
 
-fileOption :: Option
+data AddUrlOptions = AddUrlOptions
-fileOption = fieldOption [] "file" paramFile "specify what file the url is added to"
+	{ addUrls :: CmdParams
+	, fileOption :: Maybe FilePath
+	, pathdepthOption :: Maybe Int
+	, relaxedOption :: Bool
+	, rawOption :: Bool
+	}
 
-pathdepthOption :: Option
+optParser :: CmdParamsDesc -> Parser AddUrlOptions
-pathdepthOption = fieldOption [] "pathdepth" paramNumber "path components to use in filename"
+optParser desc = AddUrlOptions
+	<$> cmdParams desc
+	<*> optional (strOption
+		( long "file" <> metavar paramFile
+		<> help "specify what file the url is added to"
+		))
+	<*> optional (option auto
+		( long "pathdepth" <> metavar paramNumber
+		<> help "path components to use in filename"
+		))
+	<*> parseRelaxedOption
+	<*> parseRawOption
 
-relaxedOption :: Option
+parseRelaxedOption :: Parser Bool
-relaxedOption = flagOption [] "relaxed" "skip size check"
+parseRelaxedOption = switch
+	( long "relaxed"
+	<> help "skip size check"
+	)
 
-rawOption :: Option
+parseRawOption :: Parser Bool
-rawOption = flagOption [] "raw" "disable special handling for torrents, quvi, etc"
+parseRawOption = switch
+	( long "raw"
+	<> help "disable special handling for torrents, quvi, etc"
+	)
 
-seek :: CommandSeek
+seek :: AddUrlOptions -> CommandSeek
-seek us = do
+seek o = forM_ (addUrls o) $ \u -> do
-	optfile <- getOptionField fileOption return
+	r <- Remote.claimingUrl u
-	relaxed <- getOptionFlag relaxedOption
+	if Remote.uuid r == webUUID || rawOption o
-	raw <- getOptionFlag rawOption
+		then void $ commandAction $ startWeb (relaxedOption o) (fileOption o) (pathdepthOption o) u
-	pathdepth <- getOptionField pathdepthOption (return . maybe Nothing readish)
+		else checkUrl r u (fileOption o) (relaxedOption o) (pathdepthOption o)
-	forM_ us $ \u -> do
-		r <- Remote.claimingUrl u
-		if Remote.uuid r == webUUID || raw
-			then void $ commandAction $ startWeb relaxed optfile pathdepth u
-			else checkUrl r u optfile relaxed pathdepth
 
 checkUrl :: Remote -> URLString -> Maybe FilePath -> Bool -> Maybe Int -> Annex ()
 checkUrl r u optfile relaxed pathdepth = do

Command/Assistant.hs

@@ -1,6 +1,6 @@
 {- git-annex assistant
  -
- - Copyright 2012 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2015 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -17,65 +17,60 @@ import qualified Build.SysConfig
 import Utility.HumanTime
 import Assistant.Install
 
-import System.Environment
+cmd :: Command
+cmd = dontCheck repoExists $ notBareRepo $
+	noRepo (startNoRepo <$$> optParser) $
+		command "assistant" SectionCommon
+			"automatically sync changes"
+			paramNothing (seek <$$> optParser)
 
-cmd :: [Command]
+data AssistantOptions = AssistantOptions
-cmd = [noRepo checkNoRepoOpts $ dontCheck repoExists $ withOptions options $
+	{ daemonOptions :: DaemonOptions
-	notBareRepo $ command "assistant" paramNothing seek SectionCommon
+	, autoStartOption :: Bool
-		"automatically sync changes"]
+	, startDelayOption :: Maybe Duration
+	, autoStopOption :: Bool
+	}
 
-options :: [Option]
+optParser :: CmdParamsDesc -> Parser AssistantOptions
-options =
+optParser _ = AssistantOptions
-	[ Command.Watch.foregroundOption
+	<$> parseDaemonOptions
-	, Command.Watch.stopOption
+	<*> switch
-	, autoStartOption
+		( long "autostart"
-	, startDelayOption
+		<> help "start in known repositories"
-	, autoStopOption
+		)
-	]
+	<*> optional (option (str >>= parseDuration)
+		( long "startdelay" <> metavar paramNumber
+		<> help "delay before running startup scan"
+		))
+	<*> switch
+		( long "autostop"
+		<> help "stop in known repositories"
+		)
 
-autoStartOption :: Option
+seek :: AssistantOptions -> CommandSeek
-autoStartOption = flagOption [] "autostart" "start in known repositories"
+seek = commandAction . start
 
-autoStopOption :: Option
+start :: AssistantOptions -> CommandStart
-autoStopOption = flagOption [] "autostop" "stop in known repositories"
+start o
-
+	| autoStartOption o = do
-startDelayOption :: Option
+		liftIO $ autoStart o
-startDelayOption = fieldOption [] "startdelay" paramNumber "delay before running startup scan"
-
-seek :: CommandSeek
-seek ps = do
-	stopdaemon <- getOptionFlag Command.Watch.stopOption
-	foreground <- getOptionFlag Command.Watch.foregroundOption
-	autostart <- getOptionFlag autoStartOption
-	autostop <- getOptionFlag autoStopOption
-	startdelay <- getOptionField startDelayOption (pure . maybe Nothing parseDuration)
-	withNothing (start foreground stopdaemon autostart autostop startdelay) ps
-
-start :: Bool -> Bool -> Bool -> Bool -> Maybe Duration -> CommandStart
-start foreground stopdaemon autostart autostop startdelay
-	| autostart = do
-		liftIO $ autoStart startdelay
 		stop
-	| autostop = do
+	| autoStopOption o = do
 		liftIO autoStop
 		stop
 	| otherwise = do
 		liftIO ensureInstalled
 		ensureInitialized
-		Command.Watch.start True foreground stopdaemon startdelay
+		Command.Watch.start True (daemonOptions o) (startDelayOption o)
 
-{- Run outside a git repository; support autostart and autostop mode. -}
+startNoRepo :: AssistantOptions -> IO ()
-checkNoRepoOpts :: CmdParams -> IO ()
+startNoRepo o
-checkNoRepoOpts _ = ifM (elem "--autostart" <$> getArgs)
+	| autoStartOption o = autoStart o
-	( autoStart Nothing
+	| autoStopOption o = autoStop
-	, ifM (elem "--autostop" <$> getArgs)
+	| otherwise = error "Not in a git repository."
-		( autoStop
-		, error "Not in a git repository."
-		)
-	) 
 
-autoStart :: Maybe Duration -> IO ()
+autoStart :: AssistantOptions -> IO ()
-autoStart startdelay = do
+autoStart o = do
 	dirs <- liftIO readAutoStartFile
 	when (null dirs) $ do
 		f <- autoStartFile
@@ -103,7 +98,7 @@ autoStart startdelay = do
 	  where
 		baseparams =
 			[ Param "assistant"
-			, Param $ "--startdelay=" ++ fromDuration (fromMaybe (Duration 5) startdelay)
+			, Param $ "--startdelay=" ++ fromDuration (fromMaybe (Duration 5) (startDelayOption o))
 			]
 
 autoStop :: IO ()

Command/CheckPresentKey.hs

@@ -14,11 +14,14 @@ import qualified Remote
 import Annex
 import Types.Messages
 
-cmd :: [Command]
+cmd :: Command
-cmd = [noCommit $ command "checkpresentkey" (paramPair paramKey paramRemote) seek
+cmd = noCommit $ 
-	SectionPlumbing "check if key is present in remote"] 
+	command "checkpresentkey" SectionPlumbing
+		"check if key is present in remote"
+		(paramPair paramKey paramRemote)
+		(withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart

Command/Commit.hs

@@ -12,11 +12,12 @@ import Command
 import qualified Annex.Branch
 import qualified Git
 
-cmd :: [Command]
+cmd :: Command
-cmd = [command "commit" paramNothing seek
+cmd = command "commit" SectionPlumbing 
-	SectionPlumbing "commits any staged changes to the git-annex branch"]
+	"commits any staged changes to the git-annex branch"
+	paramNothing (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withNothing start
 
 start :: CommandStart

Command/ConfigList.hs

@@ -15,11 +15,13 @@ import qualified Annex.Branch
 import qualified Git.Config
 import Remote.GCrypt (coreGCryptId)
 
-cmd :: [Command]
+cmd :: Command
-cmd = [noCommit $ command "configlist" paramNothing seek
+cmd = noCommit $ 
-	SectionPlumbing "outputs relevant git configuration"]
+	command "configlist" SectionPlumbing 
+		"outputs relevant git configuration"
+		paramNothing (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withNothing start
 
 start :: CommandStart

Command/ContentLocation.hs

@@ -11,20 +11,20 @@ import Common.Annex
 import Command
 import CmdLine.Batch
 import Annex.Content
+import Types.Key
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions [batchOption] $ noCommit $ noMessages $
+cmd = noCommit $ noMessages $
-	command "contentlocation" (paramRepeating paramKey) seek
+	command "contentlocation" SectionPlumbing 
-		SectionPlumbing "looks up content for a key"]
+		"looks up content for a key"
+		(paramRepeating paramKey)
+		(batchable run (pure ()))
 
-seek :: CommandSeek
+run :: () -> String -> Annex Bool
-seek = batchable withKeys start
+run _ p = do
-
+	let k = fromMaybe (error "bad key") $ file2key p
-start :: Batchable Key
+	maybe (return False) (\f -> liftIO (putStrLn f) >> return True)
-start batchmode k = do
-	maybe (batchBadInput batchmode) (liftIO . putStrLn)
 		=<< inAnnex' (pure True) Nothing check k
-	stop
   where
 	check f = ifM (liftIO (doesFileExist f))
 		( return (Just f)

Command/Copy.hs

@@ -14,33 +14,44 @@ import qualified Remote
 import Annex.Wanted
 import Annex.NumCopies
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions copyOptions $ command "copy" paramPaths seek
+cmd = command "copy" SectionCommon
-	SectionCommon "copy content of files to/from another repository"]
+	"copy content of files to/from another repository"
+	paramPaths (seek <--< optParser)
 
-copyOptions :: [Option]
+data CopyOptions = CopyOptions
-copyOptions = Command.Move.moveOptions ++ [autoOption]
+	{ moveOptions :: Command.Move.MoveOptions
+	, autoMode :: Bool
+	}
 
-seek :: CommandSeek
+optParser :: CmdParamsDesc -> Parser CopyOptions
-seek ps = do
+optParser desc = CopyOptions
-	to <- getOptionField toOption Remote.byNameWithUUID
+	<$> Command.Move.optParser desc
-	from <- getOptionField fromOption Remote.byNameWithUUID
+	<*> parseAutoOption
-	auto <- getOptionFlag autoOption
+
-	withKeyOptions auto
+instance DeferredParseClass CopyOptions where
-		(Command.Move.startKey to from False)
+	finishParse v = CopyOptions
-		(withFilesInGit $ whenAnnexed $ start auto to from)
+		<$> finishParse (moveOptions v)
-		ps
+		<*> pure (autoMode v)
+
+seek :: CopyOptions -> CommandSeek
+seek o = withKeyOptions (Command.Move.keyOptions $ moveOptions o) (autoMode o)
+	(Command.Move.startKey (moveOptions o) False)
+	(withFilesInGit $ whenAnnexed $ start o)
+	(Command.Move.moveFiles $ moveOptions o)
 
 {- A copy is just a move that does not delete the source file.
  - However, auto mode avoids unnecessary copies, and avoids getting or
  - sending non-preferred content. -}
-start :: Bool -> Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart
+start :: CopyOptions -> FilePath -> Key -> CommandStart
-start auto to from file key = stopUnless shouldCopy $ 
+start o file key = stopUnless shouldCopy $ 
-	Command.Move.start to from False file key
+	Command.Move.start (moveOptions o) False file key
   where
 	shouldCopy
-		| auto = want <||> numCopiesCheck file key (<)
+		| autoMode o = want <||> numCopiesCheck file key (<)
 		| otherwise = return True
-	want = case to of
+	want = case Command.Move.fromToOptions (moveOptions o) of
-		Nothing -> wantGet False (Just key) (Just file)
+		ToRemote _ -> 
-		Just r -> wantSend False (Just key) (Just file) (Remote.uuid r)
+			wantGet False (Just key) (Just file)
+		FromRemote dest -> (Remote.uuid <$> getParsed dest) >>=
+			wantSend False (Just key) (Just file)

Command/Dead.hs

@@ -9,26 +9,29 @@ module Command.Dead where
 
 import Command
 import Common.Annex
-import qualified Annex
 import Types.TrustLevel
 import Types.Key
 import Command.Trust (trustCommand)
 import Logs.Location
 import Remote (keyLocations)
+import Git.Types
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions [keyOption] $ 
+cmd = command "dead" SectionSetup "hide a lost repository or key"
-	command "dead" (paramRepeating paramRemote) seek
+	(paramRepeating paramRemote) (seek <$$> optParser)
-		SectionSetup "hide a lost repository or key"]
 
-seek :: CommandSeek
+data DeadOptions = DeadRemotes [RemoteName] | DeadKeys [Key]
-seek ps = maybe (trustCommand "dead" DeadTrusted ps) (flip seekKey ps)
-	=<< Annex.getField "key"
 
-seekKey :: String -> CommandSeek
+optParser :: CmdParamsDesc -> Parser DeadOptions
-seekKey ks = case file2key ks of
+optParser desc = (DeadRemotes <$> cmdParams desc)
-	Nothing -> error "Invalid key"
+	<|> (DeadKeys <$> many (option (str >>= parseKey)
-	Just key -> withNothing (startKey key)
+		( long "key" <> metavar paramKey
+		<> help "keys whose content has been irretrievably lost"
+		)))
+
+seek :: DeadOptions -> CommandSeek
+seek (DeadRemotes rs) = trustCommand "dead" DeadTrusted rs
+seek (DeadKeys ks) = seekActions $ pure $ map startKey ks
 
 startKey :: Key -> CommandStart
 startKey key = do

Command/Describe.hs

@@ -12,11 +12,13 @@ import Command
 import qualified Remote
 import Logs.UUID
 
-cmd :: [Command]
+cmd :: Command
-cmd = [command "describe" (paramPair paramRemote paramDesc) seek
+cmd = command "describe" SectionSetup
-	SectionSetup "change description of a repository"]
+	"change description of a repository"
+	(paramPair paramRemote paramDesc)
+	(withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart

Command/DiffDriver.hs

@@ -13,12 +13,13 @@ import Annex.Content
 import Annex.Link
 import Git.Types
 
-cmd :: [Command]
+cmd :: Command
-cmd = [dontCheck repoExists $
+cmd = dontCheck repoExists $
-	command "diffdriver" ("[-- cmd --]") seek
+	command "diffdriver" SectionPlumbing 
-		SectionPlumbing "external git diff driver shim"]
+		"external git diff driver shim"
+		("-- cmd --") (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart

Command/Direct.hs

@@ -15,12 +15,12 @@ import qualified Git.Branch
 import Config
 import Annex.Direct
 
-cmd :: [Command]
+cmd :: Command
-cmd = [notBareRepo $ noDaemonRunning $
+cmd = notBareRepo $ noDaemonRunning $
-	command "direct" paramNothing seek
+	command "direct" SectionSetup "switch repository to direct mode"
-		SectionSetup "switch repository to direct mode"]
+		paramNothing (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withNothing start
 
 start :: CommandStart

Command/Drop.hs

@@ -22,45 +22,60 @@ import Annex.Notification
 
 import qualified Data.Set as S
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions (dropOptions) $ command "drop" paramPaths seek
+cmd = withGlobalOptions annexedMatchingOptions $
-	SectionCommon "indicate content of files not currently wanted"]
+	command "drop" SectionCommon
+		"remove content of files from repository"
+		paramPaths (seek <$$> optParser)
 
-dropOptions :: [Option]
+data DropOptions = DropOptions
-dropOptions = dropFromOption : annexedMatchingOptions ++ [autoOption] ++ keyOptions
+	{ dropFiles :: CmdParams
+	, dropFrom :: Maybe (DeferredParse Remote)
+	, autoMode :: Bool
+	, keyOptions :: Maybe KeyOptions
+	}
 
-dropFromOption :: Option
+optParser :: CmdParamsDesc -> Parser DropOptions
-dropFromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote"
+optParser desc = DropOptions
+	<$> cmdParams desc
+	<*> optional parseDropFromOption
+	<*> parseAutoOption
+	<*> optional (parseKeyOptions False)
 
-seek :: CommandSeek
+parseDropFromOption :: Parser (DeferredParse Remote)
-seek ps = do
+parseDropFromOption = parseRemoteOption $ strOption
-	from <- getOptionField dropFromOption Remote.byNameWithUUID
+	( long "from" <> short 'f' <> metavar paramRemote
-	auto <- getOptionFlag autoOption
+	<> help "drop content from a remote"
-	withKeyOptions auto
+	)
-		(startKeys auto from)
-		(withFilesInGit $ whenAnnexed $ start auto from)
-		ps
 
-start :: Bool -> Maybe Remote -> FilePath -> Key -> CommandStart
+seek :: DropOptions -> CommandSeek
-start auto from file key = start' auto from key (Just file)
+seek o = withKeyOptions (keyOptions o) (autoMode o)
+	(startKeys o)
+	(withFilesInGit $ whenAnnexed $ start o)
+	(dropFiles o)
 
-start' :: Bool -> Maybe Remote -> Key -> AssociatedFile -> CommandStart
+start :: DropOptions -> FilePath -> Key -> CommandStart
-start' auto from key afile = checkDropAuto auto from afile key $ \numcopies ->
+start o file key = start' o key (Just file)
-	stopUnless want $
-		case from of
-			Nothing -> startLocal afile numcopies key Nothing
-			Just remote -> do
-				u <- getUUID
-				if Remote.uuid remote == u
-					then startLocal afile numcopies key Nothing
-					else startRemote afile numcopies key remote
-  where
-	want
-		| auto = wantDrop False (Remote.uuid <$> from) (Just key) afile
-		| otherwise = return True
 
-startKeys :: Bool -> Maybe Remote -> Key -> CommandStart
+start' :: DropOptions -> Key -> AssociatedFile -> CommandStart
-startKeys auto from key = start' auto from key Nothing
+start' o key afile = do
+	from <- maybe (pure Nothing) (Just <$$> getParsed) (dropFrom o)
+	checkDropAuto (autoMode o) from afile key $ \numcopies ->
+		stopUnless (want from) $
+			case from of
+				Nothing -> startLocal afile numcopies key Nothing
+				Just remote -> do
+					u <- getUUID
+					if Remote.uuid remote == u
+						then startLocal afile numcopies key Nothing
+						else startRemote afile numcopies key remote
+	  where
+		want from
+			| autoMode o = wantDrop False (Remote.uuid <$> from) (Just key) afile
+			| otherwise = return True
+
+startKeys :: DropOptions -> Key -> CommandStart
+startKeys o key = start' o key Nothing
 
 startLocal :: AssociatedFile -> NumCopies -> Key -> Maybe Remote -> CommandStart
 startLocal afile numcopies key knownpresentremote = stopUnless (inAnnex key) $ do
@@ -164,10 +179,10 @@ requiredContent = do
 {- In auto mode, only runs the action if there are enough
  - copies on other semitrusted repositories. -}
 checkDropAuto :: Bool -> Maybe Remote -> AssociatedFile -> Key -> (NumCopies -> CommandStart) -> CommandStart
-checkDropAuto auto mremote afile key a = go =<< maybe getNumCopies getFileNumCopies afile
+checkDropAuto automode mremote afile key a = go =<< maybe getNumCopies getFileNumCopies afile
   where
 	go numcopies
-		| auto = do
+		| automode = do
 			locs <- Remote.keyLocations key
 			uuid <- getUUID
 			let remoteuuid = fromMaybe uuid $ Remote.uuid <$> mremote

Command/DropKey.hs

@@ -13,11 +13,14 @@ import qualified Annex
 import Logs.Location
 import Annex.Content
 
-cmd :: [Command]
+cmd :: Command
-cmd = [noCommit $ command "dropkey" (paramRepeating paramKey) seek
+cmd = noCommit $ 
-	SectionPlumbing "drops annexed content for specified keys"] 
+	command "dropkey" SectionPlumbing
+		"drops annexed content for specified keys"
+		(paramRepeating paramKey)
+		(withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withKeys start
 
 start :: Key -> CommandStart

Command/DropUnused.hs

@@ -9,34 +9,42 @@ module Command.DropUnused where
 
 import Common.Annex
 import Command
-import qualified Annex
 import qualified Command.Drop
 import qualified Remote
 import qualified Git
 import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
 import Annex.NumCopies
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions [Command.Drop.dropFromOption] $
+cmd = command "dropunused" SectionMaintenance
-	command "dropunused" (paramRepeating paramNumRange)
+	"drop unused file content"
-		seek SectionMaintenance "drop unused file content"]
+	(paramRepeating paramNumRange) (seek <$$> optParser)
 
-seek :: CommandSeek
+data DropUnusedOptions = DropUnusedOptions
-seek ps = do
+	{ rangesToDrop :: CmdParams
+	, dropFrom :: Maybe (DeferredParse Remote)
+	}
+
+optParser :: CmdParamsDesc -> Parser DropUnusedOptions
+optParser desc = DropUnusedOptions
+	<$> cmdParams desc
+	<*> optional (Command.Drop.parseDropFromOption)
+
+seek :: DropUnusedOptions -> CommandSeek
+seek o = do
 	numcopies <- getNumCopies
-	withUnusedMaps (start numcopies) ps
+	from <- maybe (pure Nothing) (Just <$$> getParsed) (dropFrom o)
+	withUnusedMaps (start from numcopies) (rangesToDrop o)
 
-start :: NumCopies -> UnusedMaps -> Int -> CommandStart
+start :: Maybe Remote -> NumCopies -> UnusedMaps -> Int -> CommandStart
-start numcopies = startUnused "dropunused" (perform numcopies) (performOther gitAnnexBadLocation) (performOther gitAnnexTmpObjectLocation)
+start from numcopies = startUnused "dropunused" (perform from numcopies) (performOther gitAnnexBadLocation) (performOther gitAnnexTmpObjectLocation)
 
-perform :: NumCopies -> Key -> CommandPerform
+perform :: Maybe Remote -> NumCopies -> Key -> CommandPerform
-perform numcopies key = maybe droplocal dropremote =<< Remote.byNameWithUUID =<< from
+perform from numcopies key = case from of
-  where
+	Just r -> do
-	dropremote r = do
 		showAction $ "from " ++ Remote.name r
 		Command.Drop.performRemote key Nothing numcopies r
-	droplocal = Command.Drop.performLocal key Nothing numcopies Nothing
+	Nothing -> Command.Drop.performLocal key Nothing numcopies Nothing
-	from = Annex.getField $ optionName Command.Drop.dropFromOption
 
 performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform
 performOther filespec key = do

Command/EnableRemote.hs

@@ -15,12 +15,13 @@ import qualified Command.InitRemote as InitRemote
 
 import qualified Data.Map as M
 
-cmd :: [Command]
+cmd :: Command
-cmd = [command "enableremote"
+cmd = command "enableremote" SectionSetup
+	"enables use of an existing special remote"
 	(paramPair paramName $ paramOptional $ paramRepeating paramKeyValue)
-	seek SectionSetup "enables use of an existing special remote"]
+	(withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart

Command/ExamineKey.hs

@@ -11,20 +11,18 @@ import Common.Annex
 import Command
 import CmdLine.Batch
 import qualified Utility.Format
-import Command.Find (formatOption, getFormat, showFormatted, keyVars)
+import Command.Find (parseFormatOption, showFormatted, keyVars)
 import Types.Key
 
-cmd :: [Command]
+cmd :: Command
-cmd = [noCommit $ noMessages $ withOptions [formatOption, jsonOption, batchOption] $
+cmd = noCommit $ noMessages $ withGlobalOptions [jsonOption] $
-	command "examinekey" (paramRepeating paramKey) seek
+	command "examinekey" SectionPlumbing 
-	SectionPlumbing "prints information from a key"]
+		"prints information from a key"
+		(paramRepeating paramKey)
+		(batchable run (optional parseFormatOption))
 
-seek :: CommandSeek
+run :: Maybe Utility.Format.Format -> String -> Annex Bool
-seek ps = do
+run format p = do
-	format <- getFormat
+	let k = fromMaybe (error "bad key") $ file2key p
-	batchable withKeys (start format) ps
+	showFormatted format (key2file k) (keyVars k)
-
+	return True
-start :: Maybe Utility.Format.Format -> Batchable Key
-start format _ key = do
-	showFormatted format (key2file key) (keyVars key)
-	stop

Command/Expire.hs

@@ -20,29 +20,40 @@ import Utility.HumanTime
 import Data.Time.Clock.POSIX
 import qualified Data.Map as M
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions [activityOption, noActOption] $ command "expire" paramExpire seek
+cmd = command "expire" SectionMaintenance
-	SectionMaintenance "expire inactive repositories"]
+	"expire inactive repositories"
+	paramExpire (seek <$$> optParser)
 
 paramExpire :: String
 paramExpire = (paramRepeating $ paramOptional paramRemote ++ ":" ++ paramTime)
 
-activityOption :: Option
+data ExpireOptions = ExpireOptions
-activityOption = fieldOption [] "activity" "Name" "specify activity"
+	{ expireParams :: CmdParams
+	, activityOption :: Maybe Activity
+	, noActOption :: Bool
+	}
 
-noActOption :: Option
+optParser :: CmdParamsDesc -> Parser ExpireOptions
-noActOption = flagOption [] "no-act" "don't really do anything"
+optParser desc = ExpireOptions
+	<$> cmdParams desc
+	<*> optional (option (str >>= parseActivity)
+		( long "activity" <> metavar paramName
+		<> help "specify activity that prevents expiry"
+		))
+	<*> switch
+		( long "no-act"
+		<> help "don't really do anything"
+		)
 
-seek :: CommandSeek
+seek :: ExpireOptions -> CommandSeek
-seek ps = do
+seek o = do
-	expire <- parseExpire ps
+	expire <- parseExpire (expireParams o)
-	wantact <- getOptionField activityOption (pure . parseActivity)
+	actlog <- lastActivities (activityOption o)
-	noact <- getOptionFlag noActOption
-	actlog <- lastActivities wantact
 	u <- getUUID
 	us <- filter (/= u) . M.keys <$> uuidMap
 	descs <- uuidMap
-	seekActions $ pure $ map (start expire noact actlog descs) us
+	seekActions $ pure $ map (start expire (noActOption o) actlog descs) us
 
 start :: Expire -> Bool -> Log Activity -> M.Map UUID String -> UUID -> CommandStart
 start (Expire expire) noact actlog descs u =
@@ -97,10 +108,9 @@ parseExpire ps = do
 		Nothing -> error $ "bad expire time: " ++ s
 		Just d -> Just (now - durationToPOSIXTime d)
 
-parseActivity :: Maybe String -> Maybe Activity
+parseActivity :: Monad m => String -> m Activity
-parseActivity Nothing = Nothing
+parseActivity s = case readish s of
-parseActivity (Just s) = case readish s of
+	Nothing -> fail $ "Unknown activity. Choose from: " ++ 
-	Nothing -> error $ "Unknown activity. Choose from: " ++ 
 		unwords (map show [minBound..maxBound :: Activity])
-	Just v -> Just v
+	Just v -> return v
 

Command/Find.hs

@@ -14,41 +14,48 @@ import Common.Annex
 import Command
 import Annex.Content
 import Limit
-import qualified Annex
 import qualified Utility.Format
 import Utility.DataUnits
 import Types.Key
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions annexedMatchingOptions $ mkCommand $
+cmd = withGlobalOptions annexedMatchingOptions $ mkCommand $
-	command "find" paramPaths seek SectionQuery "lists available files"]
+	command "find" SectionQuery "lists available files"
+		paramPaths (seek <$$> optParser)
 
 mkCommand :: Command -> Command
-mkCommand = noCommit . noMessages . withOptions [formatOption, print0Option, jsonOption]
+mkCommand = noCommit . noMessages . withGlobalOptions [jsonOption]
 
-formatOption :: Option
+data FindOptions = FindOptions
-formatOption = fieldOption [] "format" paramFormat "control format of output"
+	{ findThese :: CmdParams
+	, formatOption :: Maybe Utility.Format.Format
+	}
 
-getFormat :: Annex (Maybe Utility.Format.Format)
+optParser :: CmdParamsDesc -> Parser FindOptions
-getFormat = getOptionField formatOption $ return . fmap Utility.Format.gen
+optParser desc = FindOptions
+	<$> cmdParams desc
+	<*> optional parseFormatOption
 
-print0Option :: Option
+parseFormatOption :: Parser Utility.Format.Format
-print0Option = Option [] ["print0"] (NoArg set)
+parseFormatOption = 
-	"terminate output with null"
+	option (Utility.Format.gen <$> str)
-  where
+		( long "format" <> metavar paramFormat
-	set = Annex.setField (optionName formatOption) "${file}\0"
+		<> help "control format of output"
+		)
+	<|> flag' (Utility.Format.gen "${file}\0")
+		( long "print0"
+		<> help "output filenames terminated with nulls"
+		)
 
-seek :: CommandSeek
+seek :: FindOptions -> CommandSeek
-seek ps = do
+seek o = withFilesInGit (whenAnnexed $ start o) (findThese o)
-	format <- getFormat
-	withFilesInGit (whenAnnexed $ start format) ps
 
-start :: Maybe Utility.Format.Format -> FilePath -> Key -> CommandStart
+start :: FindOptions -> FilePath -> Key -> CommandStart
-start format file key = do
+start o file key = do
 	-- only files inAnnex are shown, unless the user has requested
 	-- others via a limit
 	whenM (limited <||> inAnnex key) $
-		showFormatted format file $ ("file", file) : keyVars key
+		showFormatted (formatOption o) file $ ("file", file) : keyVars key
 	stop
 
 showFormatted :: Maybe Utility.Format.Format -> String -> [(String, String)] -> Annex ()

Command/FindRef.hs

@@ -7,15 +7,15 @@
 
 module Command.FindRef where
 
+import Common.Annex
 import Command
 import qualified Command.Find as Find
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions nonWorkTreeMatchingOptions $ Find.mkCommand $ 
+cmd = withGlobalOptions nonWorkTreeMatchingOptions $ Find.mkCommand $ 
-	command "findref" paramRef seek SectionPlumbing
+	command "findref" SectionPlumbing
-		"lists files in a git ref"]
+		"lists files in a git ref"
+		paramRef (seek <$$> Find.optParser)
 
-seek :: CommandSeek
+seek :: Find.FindOptions -> CommandSeek
-seek refs = do
+seek o = Find.start o `withFilesInRefs` Find.findThese o
-	format <- Find.getFormat
-	Find.start format `withFilesInRefs` refs

Command/Fix.hs

@@ -18,12 +18,13 @@ import Utility.Touch
 #endif
 #endif
 
-cmd :: [Command]
+cmd :: Command
-cmd = [notDirect $ noCommit $ withOptions annexedMatchingOptions $
+cmd = notDirect $ noCommit $ withGlobalOptions annexedMatchingOptions $
-	command "fix" paramPaths seek
+	command "fix" SectionMaintenance
-		SectionMaintenance "fix up symlinks to point to annexed content"]
+		"fix up symlinks to point to annexed content"
+		paramPaths (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withFilesInGit $ whenAnnexed start
 
 {- Fixes the symlink to an annexed file. -}

Command/Forget.hs

@@ -15,27 +15,31 @@ import qualified Annex
 
 import Data.Time.Clock.POSIX
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions forgetOptions $ command "forget" paramNothing seek
+cmd = command "forget" SectionMaintenance 
-		SectionMaintenance "prune git-annex branch history"]
+	"prune git-annex branch history"
+	paramNothing (seek <$$> optParser)
 
-forgetOptions :: [Option]
+data ForgetOptions = ForgetOptions
-forgetOptions = [dropDeadOption]
+	{ dropDead :: Bool
+	}
 
-dropDeadOption :: Option
+optParser :: CmdParamsDesc -> Parser ForgetOptions
-dropDeadOption = flagOption [] "drop-dead" "drop references to dead repositories"
+optParser _ = ForgetOptions
+	<$> switch
+		( long "drop-dead"
+		<> help "drop references to dead repositories"
+		)
 
-seek :: CommandSeek
+seek :: ForgetOptions -> CommandSeek
-seek ps = do
+seek = commandAction . start
-	dropdead <- getOptionFlag dropDeadOption
-	withNothing (start dropdead) ps
 
-start :: Bool -> CommandStart
+start :: ForgetOptions -> CommandStart
-start dropdead = do
+start o = do
 	showStart "forget" "git-annex"
 	now <- liftIO getPOSIXTime
 	let basets = addTransition now ForgetGitHistory noTransitions
-	let ts = if dropdead
+	let ts = if dropDead o
 		then addTransition now ForgetDeadRemotes basets
 		else basets
 	next $ perform ts =<< Annex.getState Annex.force

Command/FromKey.hs

@@ -19,12 +19,13 @@ import qualified Backend.URL
 
 import Network.URI
 
-cmd :: [Command]
+cmd :: Command
-cmd = [notDirect $ notBareRepo $
+cmd = notDirect $ notBareRepo $
-	command "fromkey" (paramPair paramKey paramPath) seek
+	command "fromkey" SectionPlumbing "adds a file using a specific key"
-		SectionPlumbing "adds a file using a specific key"]
+		(paramPair paramKey paramPath)
+		(withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek ps = do
 	force <- Annex.getState Annex.force
 	withWords (start force) ps

Command/Fsck.hs

@@ -40,40 +40,57 @@ import qualified Database.Fsck as FsckDb
 import Data.Time.Clock.POSIX
 import System.Posix.Types (EpochTime)
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions fsckOptions $ command "fsck" paramPaths seek
+cmd = withGlobalOptions annexedMatchingOptions $
-	SectionMaintenance "check for problems"]
+	command "fsck" SectionMaintenance
+		"find and fix problems"
+		paramPaths (seek <$$> optParser)
 
-fsckFromOption :: Option
+data FsckOptions = FsckOptions
-fsckFromOption = fieldOption ['f'] "from" paramRemote "check remote"
+	{ fsckFiles :: CmdParams
+	, fsckFromOption :: Maybe (DeferredParse Remote)
+	, incrementalOpt :: Maybe IncrementalOpt
+	, keyOptions :: Maybe KeyOptions
+	}
 
-startIncrementalOption :: Option
+data IncrementalOpt
-startIncrementalOption = flagOption ['S'] "incremental" "start an incremental fsck"
+	= StartIncrementalO
+	| MoreIncrementalO
+	| ScheduleIncrementalO Duration
 
-moreIncrementalOption :: Option
+optParser :: CmdParamsDesc -> Parser FsckOptions
-moreIncrementalOption = flagOption ['m'] "more" "continue an incremental fsck"
+optParser desc = FsckOptions
+	<$> cmdParams desc
+	<*> optional (parseRemoteOption $ strOption 
+		( long "from" <> short 'f' <> metavar paramRemote 
+		<> help "check remote"
+		))
+	<*> optional parseincremental
+	<*> optional (parseKeyOptions False)
+  where
+	parseincremental =
+		flag' StartIncrementalO
+			( long "incremental" <> short 'S'
+			<> help "start an incremental fsck"
+			)
+		<|> flag' MoreIncrementalO
+			( long "more" <> short 'm'
+			<> help "continue an incremental fsck"
+			)
+		<|> (ScheduleIncrementalO <$> option (str >>= parseDuration)
+			( long "incremental-schedule" <> metavar paramTime
+			<> help "schedule incremental fscking"
+			))
 
-incrementalScheduleOption :: Option
+seek :: FsckOptions -> CommandSeek
-incrementalScheduleOption = fieldOption [] "incremental-schedule" paramTime
+seek o = do
-	"schedule incremental fscking"
+	from <- maybe (pure Nothing) (Just <$$> getParsed) (fsckFromOption o)
-
-fsckOptions :: [Option]
-fsckOptions = 
-	[ fsckFromOption
-	, startIncrementalOption
-	, moreIncrementalOption
-	, incrementalScheduleOption
-	] ++ keyOptions ++ annexedMatchingOptions
-
-seek :: CommandSeek
-seek ps = do
-	from <- getOptionField fsckFromOption Remote.byNameWithUUID
 	u <- maybe getUUID (pure . Remote.uuid) from
-	i <- getIncremental u
+	i <- prepIncremental u (incrementalOpt o)
-	withKeyOptions False
+	withKeyOptions (keyOptions o) False
 		(\k -> startKey i k =<< getNumCopies)
 		(withFilesInGit $ whenAnnexed $ start from i)
-		ps
+		(fsckFiles o)
 	withFsckDb i FsckDb.closeDb
 	void $ tryIO $ recordActivity Fsck u
 
@@ -497,37 +514,26 @@ getStartTime u = do
 
 data Incremental = StartIncremental FsckDb.FsckHandle | ContIncremental FsckDb.FsckHandle | NonIncremental
 
-getIncremental :: UUID -> Annex Incremental
+prepIncremental :: UUID -> Maybe IncrementalOpt -> Annex Incremental
-getIncremental u = do
+prepIncremental _ Nothing = pure NonIncremental
-	i <- maybe (return False) (checkschedule . parseDuration)
+prepIncremental u (Just StartIncrementalO) = do
-		=<< Annex.getField (optionName incrementalScheduleOption)
+	recordStartTime u
-	starti <- getOptionFlag startIncrementalOption
+	ifM (FsckDb.newPass u)
-	morei <- getOptionFlag moreIncrementalOption
+		( StartIncremental <$> FsckDb.openDb u
-	case (i, starti, morei) of
+		, error "Cannot start a new --incremental fsck pass; another fsck process is already running."
-		(False, False, False) -> return NonIncremental
+		)
-		(False, True, False) -> startIncremental
+prepIncremental u (Just MoreIncrementalO) =
-		(False ,False, True) -> contIncremental
+	ContIncremental <$> FsckDb.openDb u
-		(True, False, False) ->
+prepIncremental u (Just (ScheduleIncrementalO delta)) = do
-			maybe startIncremental (const contIncremental)
+	Annex.addCleanup FsckCleanup $ do
-				=<< getStartTime u
+		v <- getStartTime u
-		_ -> error "Specify only one of --incremental, --more, or --incremental-schedule"
+		case v of
-  where
+			Nothing -> noop
-	startIncremental = do
+			Just started -> do
-		recordStartTime u
+				now <- liftIO getPOSIXTime
-		ifM (FsckDb.newPass u)
+				when (now - realToFrac started >= durationToPOSIXTime delta) $
-			( StartIncremental <$> FsckDb.openDb u
+					resetStartTime u
-			, error "Cannot start a new --incremental fsck pass; another fsck process is already running."
+	started <- getStartTime u
-			)
+	prepIncremental u $ Just $ case started of
-	contIncremental = ContIncremental <$> FsckDb.openDb u
+		Nothing -> StartIncrementalO
-
+		Just _ -> MoreIncrementalO
-	checkschedule Nothing = error "bad --incremental-schedule value"
-	checkschedule (Just delta) = do
-		Annex.addCleanup FsckCleanup $ do
-			v <- getStartTime u
-			case v of
-				Nothing -> noop
-				Just started -> do
-					now <- liftIO getPOSIXTime
-					when (now - realToFrac started >= durationToPOSIXTime delta) $
-						resetStartTime u
-		return True

Command/FuzzTest.hs

@@ -20,11 +20,13 @@ import System.Random (getStdRandom, random, randomR)
 import Test.QuickCheck
 import Control.Concurrent
 
-cmd :: [Command]
+cmd :: Command
-cmd = [ notBareRepo $ command "fuzztest" paramNothing seek SectionTesting
+cmd = notBareRepo $
-	"generates fuzz test files"]
+	command "fuzztest" SectionTesting
+		"generates fuzz test files"
+		paramNothing (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withNothing start
 
 start :: CommandStart
@@ -53,9 +55,9 @@ guardTest = unlessM (fromMaybe False . Git.Config.isTrue <$> getConfig key "") $
 
 fuzz :: Handle -> Annex ()
 fuzz logh = do
-	action <- genFuzzAction
+	fuzzer <- genFuzzAction
-	record logh $ flip Started action
+	record logh $ flip Started fuzzer
-	result <- tryNonAsync $ runFuzzAction action
+	result <- tryNonAsync $ runFuzzAction fuzzer
 	record logh $ flip Finished $
 		either (const False) (const True) result
 

Command/GCryptSetup.hs

@@ -13,12 +13,13 @@ import Annex.UUID
 import qualified Remote.GCrypt
 import qualified Git
 
-cmd :: [Command]
+cmd :: Command
-cmd = [dontCheck repoExists $ noCommit $
+cmd = dontCheck repoExists $ noCommit $
-	command "gcryptsetup" paramValue seek
+	command "gcryptsetup" SectionPlumbing 
-		SectionPlumbing "sets up gcrypt repository"]
+		"sets up gcrypt repository"
+		paramValue (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withStrings start
 
 start :: String -> CommandStart

Command/Get.hs

@@ -16,28 +16,39 @@ import Annex.NumCopies
 import Annex.Wanted
 import qualified Command.Move
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions getOptions $ command "get" paramPaths seek
+cmd = withGlobalOptions (jobsOption : annexedMatchingOptions) $ 
-	SectionCommon "make content of annexed files available"]
+	command "get" SectionCommon 
+		"make content of annexed files available"
+		paramPaths (seek <$$> optParser)
 
-getOptions :: [Option]
+data GetOptions = GetOptions
-getOptions = fromOption : autoOption : jobsOption : annexedMatchingOptions
+	{ getFiles :: CmdParams
-	++ incompleteOption : keyOptions
+	, getFrom :: Maybe (DeferredParse Remote)
+	, autoMode :: Bool
+	, keyOptions :: Maybe KeyOptions
+	}
 
-seek :: CommandSeek
+optParser :: CmdParamsDesc -> Parser GetOptions
-seek ps = do
+optParser desc = GetOptions
-	from <- getOptionField fromOption Remote.byNameWithUUID
+	<$> cmdParams desc
-	auto <- getOptionFlag autoOption
+	<*> optional parseFromOption
-	withKeyOptions auto
+	<*> parseAutoOption
+	<*> optional (parseKeyOptions True)
+
+seek :: GetOptions -> CommandSeek
+seek o = do
+	from <- maybe (pure Nothing) (Just <$$> getParsed) (getFrom o)
+	withKeyOptions (keyOptions o) (autoMode o)
 		(startKeys from)
-		(withFilesInGit $ whenAnnexed $ start auto from)
+		(withFilesInGit $ whenAnnexed $ start o from)
-		ps
+		(getFiles o)
 
-start :: Bool -> Maybe Remote -> FilePath -> Key -> CommandStart
+start :: GetOptions -> Maybe Remote -> FilePath -> Key -> CommandStart
-start auto from file key = start' expensivecheck from key (Just file)
+start o from file key = start' expensivecheck from key (Just file)
   where
 	expensivecheck
-		| auto = numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file)
+		| autoMode o = numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file)
 		| otherwise = return True
 
 startKeys :: Maybe Remote -> Key -> CommandStart

Command/Group.hs

@@ -15,11 +15,11 @@ import Types.Group
 
 import qualified Data.Set as S
 
-cmd :: [Command]
+cmd :: Command
-cmd = [command "group" (paramPair paramRemote paramDesc) seek
+cmd = command "group" SectionSetup "add a repository to a group"
-	SectionSetup "add a repository to a group"]
+	(paramPair paramRemote paramDesc) (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart

Command/GroupWanted.hs

@@ -12,11 +12,13 @@ import Command
 import Logs.PreferredContent
 import Command.Wanted (performGet, performSet)
 
-cmd :: [Command]
+cmd :: Command
-cmd = [command "groupwanted" (paramPair paramGroup (paramOptional paramExpression)) seek
+cmd = command "groupwanted" SectionSetup 
-	SectionSetup "get or set groupwanted expression"]
+	"get or set groupwanted expression"
+	(paramPair paramGroup (paramOptional paramExpression))
+	(withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart

Command/Help.hs

@@ -19,13 +19,15 @@ import qualified Command.Sync
 import qualified Command.Whereis
 import qualified Command.Fsck
 
-import System.Console.GetOpt
+cmd :: Command
+cmd = noCommit $ dontCheck repoExists $
+	noRepo (parseparams startNoRepo) $ 
+		command "help" SectionCommon "display help"
+			"COMMAND" (parseparams seek)
+  where
+	parseparams = withParams
 
-cmd :: [Command]
+seek :: CmdParams -> CommandSeek
-cmd = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $
-	command "help" (paramOptional "COMMAND") seek SectionCommon "display help"]
-
-seek :: CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart
@@ -37,17 +39,13 @@ startNoRepo :: CmdParams -> IO ()
 startNoRepo = start'
 
 start' :: [String] -> IO ()
-start' ["options"] = showCommonOptions
 start' [c] = showGitHelp c
 start' _ = showGeneralHelp
 
-showCommonOptions :: IO ()
-showCommonOptions = putStrLn $ usageInfo "Common options:" gitAnnexOptions
-
 showGeneralHelp :: IO ()
 showGeneralHelp = putStrLn $ unlines
 	[ "The most frequently used git-annex commands are:"
-	, unlines $ map cmdline $ concat
+	, unlines $ map cmdline $
 		[ Command.Init.cmd
 		, Command.Add.cmd
 		, Command.Drop.cmd
@@ -58,9 +56,8 @@ showGeneralHelp = putStrLn $ unlines
 		, Command.Whereis.cmd
 		, Command.Fsck.cmd
 		]
-	, "Run 'git-annex' for a complete command list."
+	, "For a complete command list, run: git-annex"
-	, "Run 'git-annex help command' for help on a specific command."
+	, "For help on a specific command, run: git-annex help COMMAND"
-	, "Run `git annex help options' for a list of common options."
 	]
   where
 	cmdline c = "\t" ++ cmdname c ++ "\t" ++ cmddesc c

Command/Import.hs

@@ -22,52 +22,51 @@ import Annex.NumCopies
 import Types.TrustLevel
 import Logs.Trust
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions opts $ notBareRepo $ command "import" paramPaths seek
+cmd = withGlobalOptions fileMatchingOptions $ notBareRepo $
-	SectionCommon "move and add files from outside git working copy"]
+	command "import" SectionCommon 
-
+		"move and add files from outside git working copy"
-opts :: [Option]
+		paramPaths (seek <$$> optParser)
-opts = duplicateModeOptions ++ fileMatchingOptions
 
 data DuplicateMode = Default | Duplicate | DeDuplicate | CleanDuplicates | SkipDuplicates
-	deriving (Eq, Enum, Bounded)
+	deriving (Eq)
 
-associatedOption :: DuplicateMode -> Maybe Option
+data ImportOptions = ImportOptions
-associatedOption Default = Nothing
+	{ importFiles :: CmdParams
-associatedOption Duplicate = Just $
+	, duplicateMode :: DuplicateMode
-	flagOption [] "duplicate" "do not delete source files"
+	}
-associatedOption DeDuplicate = Just $
-	flagOption [] "deduplicate" "delete source files whose content was imported before"
-associatedOption CleanDuplicates = Just $
-	flagOption [] "clean-duplicates" "delete duplicate source files (import nothing)"
-associatedOption SkipDuplicates = Just $
-	flagOption [] "skip-duplicates" "import only new files"
 
-duplicateModeOptions :: [Option]
+optParser :: CmdParamsDesc -> Parser ImportOptions
-duplicateModeOptions = mapMaybe associatedOption [minBound..maxBound]
+optParser desc = ImportOptions
+	<$> cmdParams desc
+	<*> (fromMaybe Default <$> optional duplicateModeParser)
 
-getDuplicateMode :: Annex DuplicateMode
+duplicateModeParser :: Parser DuplicateMode
-getDuplicateMode = go . catMaybes <$> mapM getflag [minBound..maxBound]
+duplicateModeParser = 
-  where
+	flag' Duplicate
-	getflag m = case associatedOption m of
+		( long "duplicate" 
-		Nothing -> return Nothing
+		<> help "do not delete source files"
-		Just o -> ifM (Annex.getFlag (optionName o))
+		)
-			( return (Just m)
+	<|> flag' DeDuplicate
-			, return Nothing
+		( long "deduplicate"
-			)
+		<> help "delete source files whose content was imported before"
-	go [] = Default
+		)
-	go [m] = m
+	<|> flag' CleanDuplicates
-	go ms = error $ "cannot combine " ++
+		( long "clean-duplicates"
-		unwords (map (optionParam . fromJust . associatedOption) ms)
+		<> help "delete duplicate source files (import nothing)"
+		)
+	<|> flag' SkipDuplicates
+		( long "skip-duplicates"
+		<> help "import only new files"
+		)
 
-seek :: CommandSeek
+seek :: ImportOptions -> CommandSeek
-seek ps = do
+seek o = do
-	mode <- getDuplicateMode
 	repopath <- liftIO . absPath =<< fromRepo Git.repoPath
-	inrepops <- liftIO $ filter (dirContains repopath) <$> mapM absPath ps
+	inrepops <- liftIO $ filter (dirContains repopath) <$> mapM absPath (importFiles o)
 	unless (null inrepops) $ do
 		error $ "cannot import files from inside the working tree (use git annex add instead): " ++ unwords inrepops
-	withPathContents (start mode) ps
+	withPathContents (start (duplicateMode o)) (importFiles o)
 
 start :: DuplicateMode -> (FilePath, FilePath) -> CommandStart
 start mode (srcfile, destfile) =

Command/ImportFeed.hs

@@ -30,7 +30,7 @@ import Types.UrlContents
 import Logs.Web
 import qualified Utility.Format
 import Utility.Tmp
-import Command.AddUrl (addUrlFile, downloadRemoteFile, relaxedOption, rawOption)
+import Command.AddUrl (addUrlFile, downloadRemoteFile, parseRelaxedOption, parseRawOption)
 import Annex.Perms
 import Annex.UUID
 import Backend.URL (fromUrl)
@@ -43,34 +43,39 @@ import Types.MetaData
 import Logs.MetaData
 import Annex.MetaData
 
-cmd :: [Command]
+cmd :: Command
-cmd = [notBareRepo $ withOptions [templateOption, relaxedOption, rawOption] $
+cmd = notBareRepo $
-	command "importfeed" (paramRepeating paramUrl) seek
+	command "importfeed" SectionCommon "import files from podcast feeds"
-		SectionCommon "import files from podcast feeds"]
+		(paramRepeating paramUrl) (seek <$$> optParser)
 
-templateOption :: Option
+data ImportFeedOptions = ImportFeedOptions
-templateOption = fieldOption [] "template" paramFormat "template for filenames"
+	{ feedUrls :: CmdParams
-
+	, templateOption :: Maybe String
-seek :: CommandSeek
+	, relaxedOption :: Bool
-seek ps = do
+	, rawOption :: Bool
-	tmpl <- getOptionField templateOption return
-	relaxed <- getOptionFlag relaxedOption
-	raw <- getOptionFlag rawOption
-	let opts = Opts { relaxedOpt = relaxed, rawOpt = raw }
-	cache <- getCache tmpl
-	withStrings (start opts cache) ps
-
-data Opts = Opts
-	{ relaxedOpt :: Bool
-	, rawOpt :: Bool
 	}
 
-start :: Opts -> Cache -> URLString -> CommandStart
+optParser :: CmdParamsDesc -> Parser ImportFeedOptions
+optParser desc = ImportFeedOptions
+	<$> cmdParams desc
+	<*> optional (strOption
+		( long "template" <> metavar paramFormat
+		<> help "template for filenames"
+		))
+	<*> parseRelaxedOption
+	<*> parseRawOption
+
+seek :: ImportFeedOptions -> CommandSeek
+seek o = do
+	cache <- getCache (templateOption o)
+	withStrings (start o cache) (feedUrls o)
+
+start :: ImportFeedOptions -> Cache -> URLString -> CommandStart
 start opts cache url = do
 	showStart "importfeed" url
 	next $ perform opts cache url
 
-perform :: Opts -> Cache -> URLString -> CommandPerform
+perform :: ImportFeedOptions -> Cache -> URLString -> CommandPerform
 perform opts cache url = do
 	v <- findDownloads url
 	case v of
@@ -160,15 +165,15 @@ downloadFeed url
 				, return Nothing
 				)
 
-performDownload :: Opts -> Cache -> ToDownload -> Annex Bool
+performDownload :: ImportFeedOptions -> Cache -> ToDownload -> Annex Bool
 performDownload opts cache todownload = case location todownload of
 	Enclosure url -> checkknown url $
 		rundownload url (takeExtension url) $ \f -> do
 			r <- Remote.claimingUrl url
-			if Remote.uuid r == webUUID || rawOpt opts
+			if Remote.uuid r == webUUID || rawOption opts
 				then do
 					urlinfo <- Url.withUrlOptions (Url.getUrlInfo url)
-					maybeToList <$> addUrlFile (relaxedOpt opts) url urlinfo f
+					maybeToList <$> addUrlFile (relaxedOption opts) url urlinfo f
 				else do
 					res <- tryNonAsync $ maybe
 						(error $ "unable to checkUrl of " ++ Remote.name r)
@@ -178,10 +183,10 @@ performDownload opts cache todownload = case location todownload of
 						Left _ -> return []
 						Right (UrlContents sz _) ->
 							maybeToList <$>
-								downloadRemoteFile r (relaxedOpt opts) url f sz
+								downloadRemoteFile r (relaxedOption opts) url f sz
 						Right (UrlMulti l) -> do
 							kl <- forM l $ \(url', sz, subf) ->
-								downloadRemoteFile r (relaxedOpt opts) url' (f </> fromSafeFilePath subf) sz
+								downloadRemoteFile r (relaxedOption opts) url' (f </> fromSafeFilePath subf) sz
 							return $ if all isJust kl
 								then catMaybes kl
 								else []
@@ -199,7 +204,7 @@ performDownload opts cache todownload = case location todownload of
 						let videourl = Quvi.linkUrl link
 						checkknown videourl $
 							rundownload videourl ("." ++ fromMaybe "m" (Quvi.linkSuffix link)) $ \f ->
-								maybeToList <$> addUrlFileQuvi (relaxedOpt opts) quviurl videourl f
+								maybeToList <$> addUrlFileQuvi (relaxedOption opts) quviurl videourl f
 #else
 		return False
 #endif

Command/InAnnex.hs

@@ -11,11 +11,14 @@ import Common.Annex
 import Command
 import Annex.Content
 
-cmd :: [Command]
+cmd :: Command
-cmd = [noCommit $ command "inannex" (paramRepeating paramKey) seek
+cmd = noCommit $ 
-	SectionPlumbing "checks if keys are present in the annex"]
+	command "inannex" SectionPlumbing 
+		"checks if keys are present in the annex"
+		(paramRepeating paramKey)
+		(withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withKeys start
 
 start :: Key -> CommandStart

Command/Indirect.hs

@@ -22,12 +22,12 @@ import Annex.CatFile
 import Annex.Init
 import qualified Command.Add
 
-cmd :: [Command]
+cmd :: Command
-cmd = [notBareRepo $ noDaemonRunning $
+cmd = notBareRepo $ noDaemonRunning $
-	command "indirect" paramNothing seek
+	command "indirect" SectionSetup "switch repository to indirect mode"
-		SectionSetup "switch repository to indirect mode"]
+		paramNothing (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withNothing start
 
 start :: CommandStart

Command/Info.hs

@@ -70,79 +70,94 @@ data StatInfo = StatInfo
 	, referencedData :: Maybe KeyData
 	, repoData :: M.Map UUID KeyData
 	, numCopiesStats :: Maybe NumCopiesStats
+	, infoOptions :: InfoOptions
 	}
 
-emptyStatInfo :: StatInfo
+emptyStatInfo :: InfoOptions -> StatInfo
 emptyStatInfo = StatInfo Nothing Nothing M.empty Nothing
 
 -- a state monad for running Stats in
 type StatState = StateT StatInfo Annex
 
-cmd :: [Command]
+cmd :: Command
-cmd = [noCommit $ dontCheck repoExists $ withOptions (jsonOption : bytesOption : annexedMatchingOptions) $
+cmd = noCommit $ dontCheck repoExists $ withGlobalOptions (jsonOption : annexedMatchingOptions) $
-	command "info" (paramOptional $ paramRepeating paramItem) seek SectionQuery
+	command "info" SectionQuery
-	"shows information about the specified item or the repository as a whole"]
+		"shows  information about the specified item or the repository as a whole"
+		(paramRepeating paramItem) (seek <$$> optParser)
 
-seek :: CommandSeek
+data InfoOptions = InfoOptions
-seek = withWords start
+	{ infoFor :: CmdParams
+	, bytesOption :: Bool
+	}
 
-start :: [String] -> CommandStart
+optParser :: CmdParamsDesc -> Parser InfoOptions
-start [] = do
+optParser desc = InfoOptions
-	globalInfo
+	<$> cmdParams desc
+	<*> switch
+		( long "bytes"
+		<> help "display file sizes in bytes"
+		)
+
+seek :: InfoOptions -> CommandSeek
+seek o = withWords (start o) (infoFor o)
+
+start :: InfoOptions -> [String] -> CommandStart
+start o [] = do
+	globalInfo o
 	stop
-start ps = do
+start o ps = do
-	mapM_ itemInfo ps
+	mapM_ (itemInfo o) ps
 	stop
 
-globalInfo :: Annex ()
+globalInfo :: InfoOptions -> Annex ()
-globalInfo = do
+globalInfo o = do
 	stats <- selStats global_fast_stats global_slow_stats
 	showCustom "info" $ do
-		evalStateT (mapM_ showStat stats) emptyStatInfo
+		evalStateT (mapM_ showStat stats) (emptyStatInfo o)
 		return True
 
-itemInfo :: String -> Annex ()
+itemInfo :: InfoOptions -> String -> Annex ()
-itemInfo p = ifM (isdir p)
+itemInfo o p = ifM (isdir p)
-	( dirInfo p
+	( dirInfo o p
 	, do
 		v <- Remote.byName' p
 		case v of
-			Right r -> remoteInfo r
+			Right r -> remoteInfo o r
 			Left _ -> do
 				v' <- Remote.nameToUUID' p
 				case v' of
-					Right u -> uuidInfo u
+					Right u -> uuidInfo o u
-					Left _ -> maybe noinfo (fileInfo p)
+					Left _ -> maybe noinfo (fileInfo o p)
 						=<< isAnnexLink p
 	)
   where
 	isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus)
 	noinfo = error $ p ++ " is not a directory or an annexed file or a remote or a uuid"
 
-dirInfo :: FilePath -> Annex ()
+dirInfo :: InfoOptions -> FilePath -> Annex ()
-dirInfo dir = showCustom (unwords ["info", dir]) $ do
+dirInfo o dir = showCustom (unwords ["info", dir]) $ do
 	stats <- selStats (tostats dir_fast_stats) (tostats dir_slow_stats)
-	evalStateT (mapM_ showStat stats) =<< getDirStatInfo dir
+	evalStateT (mapM_ showStat stats) =<< getDirStatInfo o dir
 	return True
   where
 	tostats = map (\s -> s dir)
 
-fileInfo :: FilePath -> Key -> Annex ()
+fileInfo :: InfoOptions -> FilePath -> Key -> Annex ()
-fileInfo file k = showCustom (unwords ["info", file]) $ do
+fileInfo o file k = showCustom (unwords ["info", file]) $ do
-	evalStateT (mapM_ showStat (file_stats file k)) emptyStatInfo
+	evalStateT (mapM_ showStat (file_stats file k)) (emptyStatInfo o)
 	return True
 
-remoteInfo :: Remote -> Annex ()
+remoteInfo :: InfoOptions -> Remote -> Annex ()
-remoteInfo r = showCustom (unwords ["info", Remote.name r]) $ do
+remoteInfo o r = showCustom (unwords ["info", Remote.name r]) $ do
-	info <- map (\(k, v) -> simpleStat k (pure v)) <$> Remote.getInfo r
+	i <- map (\(k, v) -> simpleStat k (pure v)) <$> Remote.getInfo r
-	l <- selStats (remote_fast_stats r ++ info) (uuid_slow_stats (Remote.uuid r))
+	l <- selStats (remote_fast_stats r ++ i) (uuid_slow_stats (Remote.uuid r))
-	evalStateT (mapM_ showStat l) emptyStatInfo
+	evalStateT (mapM_ showStat l) (emptyStatInfo o)
 	return True
 
-uuidInfo :: UUID -> Annex ()
+uuidInfo :: InfoOptions -> UUID -> Annex ()
-uuidInfo u = showCustom (unwords ["info", fromUUID u]) $ do
+uuidInfo o u = showCustom (unwords ["info", fromUUID u]) $ do
 	l <- selStats [] ((uuid_slow_stats u))
-	evalStateT (mapM_ showStat l) emptyStatInfo
+	evalStateT (mapM_ showStat l) (emptyStatInfo o)
 	return True
 
 selStats :: [Stat] -> [Stat] -> Annex [Stat]
@@ -298,7 +313,7 @@ local_annex_keys = stat "local annex keys" $ json show $
 
 local_annex_size :: Stat
 local_annex_size = simpleStat "local annex size" $
-	lift . showSizeKeys =<< cachedPresentData
+	showSizeKeys =<< cachedPresentData
 
 remote_annex_keys :: UUID -> Stat
 remote_annex_keys u = stat "remote annex keys" $ json show $
@@ -306,7 +321,7 @@ remote_annex_keys u = stat "remote annex keys" $ json show $
 
 remote_annex_size :: UUID -> Stat
 remote_annex_size u = simpleStat "remote annex size" $
-	lift . showSizeKeys =<< cachedRemoteData u
+	showSizeKeys =<< cachedRemoteData u
 
 known_annex_files :: Stat
 known_annex_files = stat "annexed files in working tree" $ json show $
@@ -314,7 +329,7 @@ known_annex_files = stat "annexed files in working tree" $ json show $
 
 known_annex_size :: Stat
 known_annex_size = simpleStat "size of annexed files in working tree" $
-	lift . showSizeKeys =<< cachedReferencedData
+	showSizeKeys =<< cachedReferencedData
 
 tmp_size :: Stat
 tmp_size = staleSize "temporary object directory size" gitAnnexTmpObjectDir
@@ -323,7 +338,7 @@ bad_data_size :: Stat
 bad_data_size = staleSize "bad keys size" gitAnnexBadDir
 
 key_size :: Key -> Stat
-key_size k = simpleStat "size" $ lift $ showSizeKeys $ foldKeys [k]
+key_size k = simpleStat "size" $ showSizeKeys $ foldKeys [k]
 
 key_name :: Key -> Stat
 key_name k = simpleStat "key" $ pure $ key2file k
@@ -339,7 +354,7 @@ bloom_info = simpleStat "bloom filter size" $ do
 
 	-- Two bloom filters are used at the same time when running
 	-- git-annex unused, so double the size of one.
-	sizer <- lift mkSizer
+	sizer <- mkSizer
 	size <- sizer memoryUnits False . (* 2) . fromIntegral . fst <$>
 		lift bloomBitsHashes
 
@@ -371,10 +386,10 @@ transfer_list = stat desc $ nojson $ lift $ do
 		]
 
 disk_size :: Stat
-disk_size = simpleStat "available local disk space" $ lift $
+disk_size = simpleStat "available local disk space" $
 	calcfree
-		<$> (annexDiskReserve <$> Annex.getGitConfig)
+		<$> (lift $ annexDiskReserve <$> Annex.getGitConfig)
-		<*> inRepo (getDiskFree . gitAnnexDir)
+		<*> (lift $ inRepo $ getDiskFree . gitAnnexDir)
 		<*> mkSizer
   where
 	calcfree reserve (Just have) sizer = unwords
@@ -408,7 +423,7 @@ numcopies_stats = stat "numcopies stats" $ json fmt $
 
 reposizes_stats :: Stat
 reposizes_stats = stat desc $ nojson $ do
-	sizer <- lift mkSizer
+	sizer <- mkSizer
 	l <- map (\(u, kd) -> (u, sizer storageUnits True (sizeKeys kd)))
 		. sortBy (flip (comparing (sizeKeys . snd)))
 		. M.toList
@@ -465,14 +480,14 @@ cachedNumCopiesStats = numCopiesStats <$> get
 cachedRepoData :: StatState (M.Map UUID KeyData)
 cachedRepoData = repoData <$> get
 
-getDirStatInfo :: FilePath -> Annex StatInfo
+getDirStatInfo :: InfoOptions -> FilePath -> Annex StatInfo
-getDirStatInfo dir = do
+getDirStatInfo o dir = do
 	fast <- Annex.getState Annex.fast
 	matcher <- Limit.getMatcher
 	(presentdata, referenceddata, numcopiesstats, repodata) <-
 		Command.Unused.withKeysFilesReferencedIn dir initial
 			(update matcher fast)
-	return $ StatInfo (Just presentdata) (Just referenceddata) repodata (Just numcopiesstats)
+	return $ StatInfo (Just presentdata) (Just referenceddata) repodata (Just numcopiesstats) o
   where
 	initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats, M.empty)
 	update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats, repodata) =
@@ -529,7 +544,7 @@ updateNumCopiesStats file (NumCopiesStats m) locs = do
 	let !ret = NumCopiesStats m'
 	return ret
 
-showSizeKeys :: KeyData -> Annex String
+showSizeKeys :: KeyData -> StatState String
 showSizeKeys d = do
 	sizer <- mkSizer
 	return $ total sizer ++ missingnote
@@ -549,7 +564,7 @@ staleSize label dirspec = go =<< lift (dirKeys dirspec)
 	onsize 0 = nostat
 	onsize size = stat label $
 		json (++ aside "clean up with git-annex unused") $ do
-			sizer <- lift mkSizer
+			sizer <- mkSizer
 			return $ sizer storageUnits False size
 	keysizes keys = do
 		dir <- lift $ fromRepo dirspec
@@ -562,11 +577,8 @@ aside s = " (" ++ s ++ ")"
 multiLine :: [String] -> String
 multiLine = concatMap (\l -> "\n\t" ++ l)
 
-mkSizer :: Annex ([Unit] -> Bool -> ByteSize -> String)
+mkSizer :: StatState ([Unit] -> Bool -> ByteSize -> String)
-mkSizer = ifM (getOptionFlag bytesOption)
+mkSizer = ifM (bytesOption . infoOptions <$> get)
 	( return (const $ const show)
 	, return roughSize
 	)
-
-bytesOption :: Option
-bytesOption = flagOption [] "bytes" "display file sizes in bytes"

Command/Init.hs

@@ -11,11 +11,12 @@ import Common.Annex
 import Command
 import Annex.Init
 	
-cmd :: [Command]
+cmd :: Command
-cmd = [dontCheck repoExists $
+cmd = dontCheck repoExists $
-	command "init" paramDesc seek SectionSetup "initialize git-annex"]
+	command "init" SectionSetup "initialize git-annex"
+		paramDesc (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart

Command/InitRemote.hs

@@ -19,12 +19,13 @@ import Logs.Trust
 
 import Data.Ord
 
-cmd :: [Command]
+cmd :: Command
-cmd = [command "initremote"
+cmd = command "initremote" SectionSetup
+	"creates a special (non-git) remote"
 	(paramPair paramName $ paramOptional $ paramRepeating paramKeyValue)
-	seek SectionSetup "creates a special (non-git) remote"]
+	(withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart

Command/List.hs

@@ -20,28 +20,37 @@ import Remote
 import Logs.Trust
 import Logs.UUID
 import Annex.UUID
-import qualified Annex
 import Git.Types (RemoteName)
 
-cmd :: [Command]
+cmd :: Command
-cmd = [noCommit $ withOptions (allrepos : annexedMatchingOptions) $
+cmd = noCommit $ withGlobalOptions annexedMatchingOptions $
-	command "list" paramPaths seek
+	command "list" SectionQuery 
-		SectionQuery "show which remotes contain files"]
+		"show which remotes contain files"
+		paramPaths (seek <$$> optParser)
 
-allrepos :: Option
+data ListOptions = ListOptions
-allrepos = flagOption [] "allrepos" "show all repositories, not only remotes"
+	{ listThese :: CmdParams
+	, allRepos :: Bool
+	}
 
-seek :: CommandSeek
+optParser :: CmdParamsDesc -> Parser ListOptions
-seek ps = do
+optParser desc = ListOptions
-	list <- getList
+	<$> cmdParams desc
+	<*> switch
+		( long "allrepos"
+		<> help "show all repositories, not only remotes"
+		)
+
+seek :: ListOptions -> CommandSeek
+seek o = do
+	list <- getList o
 	printHeader list
-	withFilesInGit (whenAnnexed $ start list) ps
+	withFilesInGit (whenAnnexed $ start list) (listThese o)
 
-getList :: Annex [(UUID, RemoteName, TrustLevel)]
+getList :: ListOptions -> Annex [(UUID, RemoteName, TrustLevel)]
-getList = ifM (Annex.getFlag $ optionName allrepos)
+getList o
-	( nubBy ((==) `on` fst3) <$> ((++) <$> getRemotes <*> getAllUUIDs)
+	| allRepos o = nubBy ((==) `on` fst3) <$> ((++) <$> getRemotes <*> getAllUUIDs)
-	, getRemotes
+	| otherwise = getRemotes
-	)
   where
 	getRemotes = do
 		rs <- remoteList
@@ -59,7 +68,7 @@ getList = ifM (Annex.getFlag $ optionName allrepos)
 			filter (\t -> thd3 t /= DeadTrusted) rs3
 
 printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex ()
-printHeader l = liftIO $ putStrLn $ header $ map (\(_, n, t) -> (n, t)) l
+printHeader l = liftIO $ putStrLn $ lheader $ map (\(_, n, t) -> (n, t)) l
 
 start :: [(UUID, RemoteName, TrustLevel)] -> FilePath -> Key -> CommandStart
 start l file key = do
@@ -69,8 +78,8 @@ start l file key = do
 
 type Present = Bool
 
-header :: [(RemoteName, TrustLevel)] -> String
+lheader :: [(RemoteName, TrustLevel)] -> String
-header remotes = unlines (zipWith formatheader [0..] remotes) ++ pipes (length remotes)
+lheader remotes = unlines (zipWith formatheader [0..] remotes) ++ pipes (length remotes)
   where
 	formatheader n (remotename, trustlevel) = pipes n ++ remotename ++ trust trustlevel
 	pipes = flip replicate '|'

Command/Lock.hs

@@ -12,12 +12,13 @@ import Command
 import qualified Annex.Queue
 import qualified Annex
 	
-cmd :: [Command]
+cmd :: Command
-cmd = [notDirect $ withOptions annexedMatchingOptions $
+cmd = notDirect $ withGlobalOptions annexedMatchingOptions $
-	command "lock" paramPaths seek SectionCommon
+	command "lock" SectionCommon
-	"undo unlock command"]
+		"undo unlock command"
+		paramPaths (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek ps = do
 	withFilesUnlocked start ps
 	withFilesUnlockedToBeCommitted start ps

Command/Log.hs

@@ -38,52 +38,62 @@ data RefChange = RefChange
 
 type Outputter = Bool -> POSIXTime -> [UUID] -> Annex ()
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions options $
+cmd = withGlobalOptions annexedMatchingOptions $
-	command "log" paramPaths seek SectionQuery "shows location log"]
+	command "log" SectionQuery "shows location log"
+		paramPaths (seek <$$> optParser)
 
-options :: [Option]
+data LogOptions = LogOptions
-options = passthruOptions ++ [gourceOption] ++ annexedMatchingOptions
+	{ logFiles :: CmdParams
+	, gourceOption :: Bool
+	, passthruOptions :: [CommandParam]
+	}
 
-passthruOptions :: [Option]
+optParser :: CmdParamsDesc -> Parser LogOptions
-passthruOptions = map odate ["since", "after", "until", "before"] ++
+optParser desc = LogOptions
-	[ fieldOption ['n'] "max-count" paramNumber
+	<$> cmdParams desc
-		"limit number of logs displayed"
+	<*> switch
-	]
+		( long "gource"
+		<> help "format output for gource"
+		)
+	<*> (concat <$> many passthru)
   where
-	odate n = fieldOption [] n paramDate $ "show log " ++ n ++ " date"
+	passthru :: Parser [CommandParam]
+	passthru = datepassthru "since"
+		<|> datepassthru "after"
+		<|> datepassthru "until"
+		<|> datepassthru "before"
+		<|> (mkpassthru "max-count" <$> strOption
+			( long "max-count" <> metavar paramNumber
+			<> help "limit number of logs displayed"
+			))
+	datepassthru n = mkpassthru n <$> strOption
+		( long n <> metavar paramDate
+		<> help ("show log " ++ n ++ " date")
+		)
+	mkpassthru n v = [Param ("--" ++ n), Param v]
 
-gourceOption :: Option
+seek :: LogOptions -> CommandSeek
-gourceOption = flagOption [] "gource" "format output for gource"
+seek o = do
-
-seek :: CommandSeek
-seek ps = do
 	m <- Remote.uuidDescriptions
 	zone <- liftIO getCurrentTimeZone
-	os <- concat <$> mapM getoption passthruOptions
+	withFilesInGit (whenAnnexed $ start m zone o) (logFiles o)
-	gource <- getOptionFlag gourceOption
-	withFilesInGit (whenAnnexed $ start m zone os gource) ps
-  where
-	getoption o = maybe [] (use o) <$>
-		Annex.getField (optionName o)
-	use o v = [Param ("--" ++ optionName o), Param v]
 
 start
 	:: M.Map UUID String
 	-> TimeZone
-	-> [CommandParam]
+	-> LogOptions
-	-> Bool
 	-> FilePath
 	-> Key
 	-> CommandStart
-start m zone os gource file key = do
+start m zone o file key = do
-	showLog output =<< readLog <$> getLog key os
+	showLog output =<< readLog <$> getLog key (passthruOptions o)
 	-- getLog produces a zombie; reap it
 	liftIO reapZombies
 	stop
   where
 	output
-		| gource = gourceOutput lookupdescription file
+		| (gourceOption o) = gourceOutput lookupdescription file
 		| otherwise = normalOutput lookupdescription file zone
 	lookupdescription u = fromMaybe (fromUUID u) $ M.lookup u m
 

Command/LookupKey.hs

@@ -13,16 +13,18 @@ import CmdLine.Batch
 import Annex.CatFile
 import Types.Key
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions [batchOption] $ notBareRepo $ noCommit $ noMessages $
+cmd = notBareRepo $ noCommit $ noMessages $
-	command "lookupkey" (paramRepeating paramFile) seek
+	command "lookupkey" SectionPlumbing 
-		SectionPlumbing "looks up key used for file"]
+		"looks up key used for file"
+		(paramRepeating paramFile)
+		(batchable run (pure ()))
 
-seek :: CommandSeek
+run :: () -> String -> Annex Bool
-seek = batchable withStrings start
+run _ file = do
-
+	mk <- catKeyFile file
-start :: Batchable String
+	case mk of
-start batchmode file = do
+		Just k  -> do
-	maybe (batchBadInput batchmode) (liftIO . putStrLn . key2file)
+			liftIO $ putStrLn $ key2file k
-		=<< catKeyFile file
+			return True
-	stop
+		Nothing -> return False

Command/Map.hs

@@ -25,12 +25,13 @@ import qualified Utility.Dot as Dot
 -- a link from the first repository to the second (its remote)
 data Link = Link Git.Repo Git.Repo
 
-cmd :: [Command]
+cmd :: Command
-cmd = [dontCheck repoExists $
+cmd = dontCheck repoExists $
-	command "map" paramNothing seek SectionQuery
+	command "map" SectionQuery
-		"generate map of repositories"]
+		"generate map of repositories"
+		paramNothing (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withNothing start
 
 start :: CommandStart

Command/Merge.hs

@@ -13,11 +13,12 @@ import qualified Annex.Branch
 import qualified Git.Branch
 import Command.Sync (prepMerge, mergeLocal)
 
-cmd :: [Command]
+cmd :: Command
-cmd = [command "merge" paramNothing seek SectionMaintenance
+cmd = command "merge" SectionMaintenance
-	"automatically merge changes from remotes"]
+	"automatically merge changes from remotes"
+	paramNothing (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek ps = do
 	withNothing mergeBranch ps
 	withNothing mergeSynced ps

Command/MetaData.hs

@@ -8,7 +8,6 @@
 module Command.MetaData where
 
 import Common.Annex
-import qualified Annex
 import Command
 import Annex.MetaData
 import Logs.MetaData
@@ -16,71 +15,70 @@ import Logs.MetaData
 import qualified Data.Set as S
 import Data.Time.Clock.POSIX
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions metaDataOptions $
+cmd = withGlobalOptions ([jsonOption] ++ annexedMatchingOptions) $ 
-	command "metadata" paramPaths seek
+	command "metadata" SectionMetaData
-	SectionMetaData "sets or gets metadata of a file"]
+		"sets or gets metadata of a file"
+		paramPaths (seek <$$> optParser)
 
-metaDataOptions :: [Option]
+data MetaDataOptions = MetaDataOptions
-metaDataOptions =
+	{ forFiles :: CmdParams
-	[ setOption
+	, getSet :: GetSet
-	, tagOption
+	, keyOptions :: Maybe KeyOptions
-	, untagOption
+	}
-	, getOption
-	, jsonOption
-	] ++ keyOptions ++ annexedMatchingOptions
 
-storeModMeta :: ModMeta -> Annex ()
+data GetSet = Get MetaField | Set [ModMeta]
-storeModMeta modmeta = Annex.changeState $
-	\s -> s { Annex.modmeta = modmeta:Annex.modmeta s }
 
-setOption :: Option
+optParser :: CmdParamsDesc -> Parser MetaDataOptions
-setOption = Option ['s'] ["set"] (ReqArg mkmod "FIELD[+-]=VALUE") "set metadata"
+optParser desc = MetaDataOptions
+	<$> cmdParams desc
+	<*> ((Get <$> getopt) <|> (Set <$> many modopts))
+	<*> optional (parseKeyOptions False)
   where
-	mkmod = either error storeModMeta . parseModMeta
+	getopt = option (eitherReader mkMetaField)
+		( long "get" <> short 'g' <> metavar paramField
+		<> help "get single metadata field"
+		)
+	modopts = option (eitherReader parseModMeta)
+		( long "set" <> short 's' <> metavar "FIELD[+-]=VALUE"
+		<> help "set or unset metadata value"
+		)
+		<|> (AddMeta tagMetaField . toMetaValue <$> strOption
+			( long "tag" <> short 't' <> metavar "TAG"
+			<> help "set a tag"
+			))
+		<|> (AddMeta tagMetaField . mkMetaValue (CurrentlySet False) <$> strOption
+			( long "untag" <> short 'u' <> metavar "TAG"
+			<> help "remove a tag"
+			))
 
-getOption :: Option
+seek :: MetaDataOptions -> CommandSeek
-getOption = fieldOption ['g'] "get" paramField "get single metadata field"
+seek o = do
-
-tagOption :: Option
-tagOption = Option ['t'] ["tag"] (ReqArg mkmod "TAG") "set a tag"
-  where
-	mkmod = storeModMeta . AddMeta tagMetaField . toMetaValue
-
-untagOption :: Option
-untagOption = Option ['u'] ["untag"] (ReqArg mkmod "TAG") "remove a tag"
-  where
-	mkmod = storeModMeta . AddMeta tagMetaField . mkMetaValue (CurrentlySet False)
-
-seek :: CommandSeek
-seek ps = do
-	modmeta <- Annex.getState Annex.modmeta
-	getfield <- getOptionField getOption $ \ms ->
-		return $ either error id . mkMetaField <$> ms
 	now <- liftIO getPOSIXTime
-	let seeker = if null modmeta
+	let seeker = case getSet o of
-		then withFilesInGit
+		Get _ -> withFilesInGit
-		else withFilesInGitNonRecursive
+		Set _ -> withFilesInGitNonRecursive
-	withKeyOptions False
+	withKeyOptions (keyOptions o) False
-		(startKeys now getfield modmeta)
+		(startKeys now o)
-		(seeker $ whenAnnexed $ start now getfield modmeta)
+		(seeker $ whenAnnexed $ start now o)
-		ps
+		(forFiles o)
 
-start :: POSIXTime -> Maybe MetaField -> [ModMeta] -> FilePath -> Key -> CommandStart
+start :: POSIXTime -> MetaDataOptions -> FilePath -> Key -> CommandStart
-start now f ms file = start' (Just file) now f ms
+start now o file = start' (Just file) now o
 
-startKeys :: POSIXTime -> Maybe MetaField -> [ModMeta] -> Key -> CommandStart
+startKeys :: POSIXTime -> MetaDataOptions -> Key -> CommandStart
 startKeys = start' Nothing
 
-start' :: AssociatedFile -> POSIXTime -> Maybe MetaField -> [ModMeta] -> Key -> CommandStart
+start' :: AssociatedFile -> POSIXTime -> MetaDataOptions -> Key -> CommandStart
-start' afile now Nothing ms k = do
+start' afile now o k = case getSet o of
-	showStart' "metadata" k afile
+	Set ms -> do
-	next $ perform now ms k
+		showStart' "metadata" k afile
-start' _ _ (Just f) _ k = do
+		next $ perform now ms k
-	l <- S.toList . currentMetaDataValues f <$> getCurrentMetaData k
+	Get f -> do
-	liftIO $ forM_ l $
+		l <- S.toList . currentMetaDataValues f <$> getCurrentMetaData k
-		putStrLn . fromMetaValue
+		liftIO $ forM_ l $
-	stop
+			putStrLn . fromMetaValue
+		stop
 
 perform :: POSIXTime -> [ModMeta] -> Key -> CommandPerform
 perform _ [] k = next $ cleanup k

Command/Migrate.hs

@@ -18,12 +18,13 @@ import qualified Command.ReKey
 import qualified Command.Fsck
 import qualified Annex
 
-cmd :: [Command]
+cmd :: Command
-cmd = [notDirect $ withOptions annexedMatchingOptions $
+cmd = notDirect $ withGlobalOptions annexedMatchingOptions $
-	command "migrate" paramPaths seek
+	command "migrate" SectionUtility 
-		SectionUtility "switch data to different backend"]
+		"switch data to different backend"
+		paramPaths (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withFilesInGit $ whenAnnexed start
 
 start :: FilePath -> Key -> CommandStart

Command/Mirror.hs

@@ -16,41 +16,49 @@ import qualified Remote
 import Annex.Content
 import Annex.NumCopies
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions mirrorOptions $ command "mirror" paramPaths seek
+cmd = withGlobalOptions ([jobsOption] ++ annexedMatchingOptions) $
-	SectionCommon "mirror content of files to/from another repository"]
+	command "mirror" SectionCommon 
+		"mirror content of files to/from another repository"
+		paramPaths (seek <--< optParser)
 
-mirrorOptions :: [Option]
+data MirrorOptions = MirrorOptions
-mirrorOptions = fromToOptions ++ [jobsOption] ++ annexedMatchingOptions ++ keyOptions
+	{ mirrorFiles :: CmdParams
+	, fromToOptions :: FromToOptions
+	, keyOptions :: Maybe KeyOptions
+	}
 
-seek :: CommandSeek
+optParser :: CmdParamsDesc -> Parser MirrorOptions
-seek ps = do
+optParser desc = MirrorOptions
-	to <- getOptionField toOption Remote.byNameWithUUID
+	<$> cmdParams desc
-	from <- getOptionField fromOption Remote.byNameWithUUID
+	<*> parseFromToOptions
-	withKeyOptions False
+	<*> optional (parseKeyOptions False)
-		(startKey to from Nothing)
-		(withFilesInGit $ whenAnnexed $ start to from)
-		ps
 
-start :: Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart
+instance DeferredParseClass MirrorOptions where
-start to from file = startKey to from (Just file)
+	finishParse v = MirrorOptions
+		<$> pure (mirrorFiles v)
+		<*> finishParse (fromToOptions v)
+		<*> pure (keyOptions v)
 
-startKey :: Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart
+seek :: MirrorOptions -> CommandSeek
-startKey to from afile key =
+seek o = withKeyOptions (keyOptions o) False
-	case (from, to) of
+	(startKey o Nothing)
-		(Nothing, Nothing) -> error "specify either --from or --to"
+	(withFilesInGit $ whenAnnexed $ start o)
-		(Nothing, Just r) -> mirrorto r
+	(mirrorFiles o)
-		(Just r, Nothing) -> mirrorfrom r
+
-		_ -> error "only one of --from or --to can be specified"
+start :: MirrorOptions -> FilePath -> Key -> CommandStart
-  where
+start o file = startKey o (Just file)
-	mirrorto r = ifM (inAnnex key)
+
-		( Command.Move.toStart r False afile key
+startKey :: MirrorOptions -> Maybe FilePath -> Key -> CommandStart
+startKey o afile key = case fromToOptions o of
+	ToRemote r -> ifM (inAnnex key)
+		( Command.Move.toStart False afile key =<< getParsed r
 		, do
 			numcopies <- getnumcopies
-			Command.Drop.startRemote afile numcopies key r
+			Command.Drop.startRemote afile numcopies key =<< getParsed r
 		)
-	mirrorfrom r = do
+	FromRemote r -> do
-		haskey <- Remote.hasKey r key
+		haskey <- flip Remote.hasKey key =<< getParsed r
 		case haskey of
 			Left _ -> stop
 			Right True -> Command.Get.start' (return True) Nothing key afile
@@ -60,4 +68,5 @@ startKey to from afile key =
 					Command.Drop.startLocal afile numcopies key Nothing
 				, stop
 				)
+  where
 	getnumcopies = maybe getNumCopies getFileNumCopies afile

Command/Move.hs

@@ -17,35 +17,47 @@ import Annex.UUID
 import Annex.Transfer
 import Logs.Presence
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions moveOptions $ command "move" paramPaths seek
+cmd = withGlobalOptions (jobsOption : annexedMatchingOptions) $
-	SectionCommon "move content of files to/from another repository"]
+	command "move" SectionCommon
+		"move content of files to/from another repository"
+		paramPaths (seek <--< optParser)
 
-moveOptions :: [Option]
+data MoveOptions = MoveOptions
-moveOptions = fromToOptions ++ [jobsOption] ++ keyOptions ++ annexedMatchingOptions
+	{ moveFiles :: CmdParams
+	, fromToOptions :: FromToOptions
+	, keyOptions :: Maybe KeyOptions
+	}
 
-seek :: CommandSeek
+optParser :: CmdParamsDesc -> Parser MoveOptions
-seek ps = do
+optParser desc = MoveOptions
-	to <- getOptionField toOption Remote.byNameWithUUID
+	<$> cmdParams desc
-	from <- getOptionField fromOption Remote.byNameWithUUID
+	<*> parseFromToOptions
-	withKeyOptions False
+	<*> optional (parseKeyOptions False)
-		(startKey to from True)
-		(withFilesInGit $ whenAnnexed $ start to from True)
-		ps
 
-start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> Key -> CommandStart
+instance DeferredParseClass MoveOptions where
-start to from move = start' to from move . Just
+	finishParse v = MoveOptions
+		<$> pure (moveFiles v)
+		<*> finishParse (fromToOptions v)
+		<*> pure (keyOptions v)
 
-startKey :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart
+seek :: MoveOptions -> CommandSeek
-startKey to from move = start' to from move Nothing
+seek o = withKeyOptions (keyOptions o) False
+	(startKey o True)
+	(withFilesInGit $ whenAnnexed $ start o True)
+	(moveFiles o)
 
-start' :: Maybe Remote -> Maybe Remote -> Bool -> AssociatedFile -> Key -> CommandStart
+start :: MoveOptions -> Bool -> FilePath -> Key -> CommandStart
-start' to from move afile key = do
+start o move = start' o move . Just
-	case (from, to) of
+
-		(Nothing, Nothing) -> error "specify either --from or --to"
+startKey :: MoveOptions -> Bool -> Key -> CommandStart
-		(Nothing, Just dest) -> toStart dest move afile key
+startKey o move = start' o move Nothing
-		(Just src, Nothing) -> fromStart src move afile key
+
-		_ -> error "only one of --from or --to can be specified"
+start' :: MoveOptions -> Bool -> AssociatedFile -> Key -> CommandStart
+start' o move afile key = 
+	case fromToOptions o of
+		FromRemote src -> fromStart move afile key =<< getParsed src
+		ToRemote dest -> toStart move afile key =<< getParsed dest
 
 showMoveAction :: Bool -> Key -> AssociatedFile -> Annex ()
 showMoveAction move = showStart' (if move then "move" else "copy")
@@ -59,8 +71,8 @@ showMoveAction move = showStart' (if move then "move" else "copy")
  - A file's content can be moved even if there are insufficient copies to
  - allow it to be dropped.
  -}
-toStart :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart
+toStart :: Bool -> AssociatedFile -> Key -> Remote -> CommandStart
-toStart dest move afile key = do
+toStart move afile key dest = do
 	u <- getUUID
 	ishere <- inAnnex key
 	if not ishere || u == Remote.uuid dest
@@ -122,8 +134,8 @@ toPerform dest move key afile fastcheck isthere =
  - If the current repository already has the content, it is still removed
  - from the remote.
  -}
-fromStart :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart
+fromStart :: Bool -> AssociatedFile -> Key -> Remote -> CommandStart
-fromStart src move afile key
+fromStart move afile key src
 	| move = go
 	| otherwise = stopUnless (not <$> inAnnex key) go
   where

Command/NotifyChanges.hs

@@ -19,11 +19,13 @@ import Control.Concurrent
 import Control.Concurrent.Async
 import Control.Concurrent.STM
 
-cmd :: [Command]
+cmd :: Command
-cmd = [noCommit $ command "notifychanges" paramNothing seek SectionPlumbing
+cmd = noCommit $ 
-	"sends notification when git refs are changed"]
+	command "notifychanges" SectionPlumbing
+		"sends notification when git refs are changed"
+		paramNothing (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withNothing start
 
 start :: CommandStart

Command/NumCopies.hs

@@ -13,11 +13,12 @@ import Command
 import Annex.NumCopies
 import Types.Messages
 
-cmd :: [Command]
+cmd :: Command
-cmd = [command "numcopies" paramNumber seek
+cmd = command "numcopies" SectionSetup 
-	SectionSetup "configure desired number of copies"]
+	"configure desired number of copies"
+	paramNumber (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart

Command/PreCommit.hs

@@ -28,11 +28,13 @@ import qualified Git.LsFiles as Git
 
 import qualified Data.Set as S
 
-cmd :: [Command]
+cmd :: Command
-cmd = [command "pre-commit" paramPaths seek SectionPlumbing
+cmd = command "pre-commit" SectionPlumbing
-	"run by git pre-commit hook"]
+	"run by git pre-commit hook"
+	paramPaths
+	(withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek ps = lockPreCommitHook $ ifM isDirect
 	( do
 		-- update direct mode mappings for committed files

Command/Proxy.hs

@@ -17,12 +17,13 @@ import qualified Git.Sha
 import qualified Git.Ref
 import qualified Git.Branch
 
-cmd :: [Command]
+cmd :: Command
-cmd = [notBareRepo $
+cmd = notBareRepo $
-	command "proxy" ("-- git command") seek
+	command "proxy" SectionPlumbing 
-		SectionPlumbing "safely bypass direct mode guard"]
+		"safely bypass direct mode guard"
+		("-- git command") (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart

Command/ReKey.hs

@@ -18,12 +18,14 @@ import Logs.Location
 import Utility.CopyFile
 import qualified Remote
 
-cmd :: [Command]
+cmd :: Command
-cmd = [notDirect $ command "rekey"
+cmd = notDirect $ 
-	(paramOptional $ paramRepeating $ paramPair paramPath paramKey)
+	command "rekey" SectionPlumbing
-	seek SectionPlumbing "change keys used for files"]
+		"change keys used for files"
+		(paramRepeating $ paramPair paramPath paramKey)
+		(withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withPairs start
 
 start :: (FilePath, String) -> CommandStart

Command/ReadPresentKey.hs

@@ -12,11 +12,14 @@ import Command
 import Logs.Location
 import Types.Key
 
-cmd :: [Command]
+cmd :: Command
-cmd = [noCommit $ command "readpresentkey" (paramPair paramKey paramUUID) seek
+cmd = noCommit $ 
-	SectionPlumbing "read records of where key is present"] 
+	command "readpresentkey" SectionPlumbing
+		"read records of where key is present"
+		(paramPair paramKey paramUUID)
+		(withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart

Command/RecvKey.hs

@@ -20,11 +20,12 @@ import qualified Types.Key
 import qualified Types.Backend
 import qualified Backend
 
-cmd :: [Command]
+cmd :: Command
-cmd = [noCommit $ command "recvkey" paramKey seek
+cmd = noCommit $ command "recvkey" SectionPlumbing 
-	SectionPlumbing "runs rsync in server mode to receive content"]
+	"runs rsync in server mode to receive content"
+	paramKey (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withKeys start
 
 start :: Key -> CommandStart

Command/RegisterUrl.hs

@@ -15,12 +15,14 @@ import Logs.Web
 import Annex.UUID
 import Command.FromKey (mkKey)
 
-cmd :: [Command]
+cmd :: Command
-cmd = [notDirect $ notBareRepo $
+cmd = notDirect $ notBareRepo $
-	command "registerurl" (paramPair paramKey paramUrl) seek
+	command "registerurl"
-		SectionPlumbing "registers an url for a key"]
+		SectionPlumbing "registers an url for a key"
+		(paramPair paramKey paramUrl)
+		(withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart

Command/Reinit.hs

@@ -14,11 +14,14 @@ import Annex.UUID
 import Types.UUID
 import qualified Remote
 	
-cmd :: [Command]
+cmd :: Command
-cmd = [dontCheck repoExists $
+cmd = dontCheck repoExists $
-	command "reinit" (paramUUID ++ "|" ++ paramDesc) seek SectionUtility "initialize repository, reusing old UUID"]
+	command "reinit" SectionUtility 
+		"initialize repository, reusing old UUID"
+		(paramUUID ++ "|" ++ paramDesc)
+		(withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart

Command/Reinject.hs

@@ -14,11 +14,12 @@ import Annex.Content
 import qualified Command.Fsck
 import qualified Backend
 
-cmd :: [Command]
+cmd :: Command
-cmd = [command "reinject" (paramPair "SRC" "DEST") seek
+cmd = command "reinject" SectionUtility 
-	SectionUtility "sets content of annexed file"]
+	"sets content of annexed file"
+	(paramPair "SRC" "DEST") (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [FilePath] -> CommandStart

Command/RemoteDaemon.hs

@@ -11,11 +11,13 @@ import Common.Annex
 import Command
 import RemoteDaemon.Core
 
-cmd :: [Command]
+cmd :: Command
-cmd = [noCommit $ command "remotedaemon" paramNothing seek SectionPlumbing
+cmd = noCommit $ 
-	"detects when remotes have changed, and fetches from them"]
+	command "remotedaemon" SectionPlumbing
+		"detects when remotes have changed, and fetches from them"
+		paramNothing (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withNothing start
 
 start :: CommandStart

Command/Repair.hs

@@ -16,11 +16,13 @@ import qualified Git.Ref
 import Git.Types
 import Annex.Version
 
-cmd :: [Command]
+cmd :: Command
-cmd = [noCommit $ dontCheck repoExists $
+cmd = noCommit $ dontCheck repoExists $
-	command "repair" paramNothing seek SectionMaintenance "recover broken git repository"]
+	command "repair" SectionMaintenance 
+		"recover broken git repository"
+		paramNothing (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withNothing start
 
 start :: CommandStart

Command/Required.hs

@@ -11,7 +11,7 @@ import Command
 import Logs.PreferredContent
 import qualified Command.Wanted
 
-cmd :: [Command]
+cmd :: Command
 cmd = Command.Wanted.cmd' "required" "get or set required content expression"
 	requiredContentMapRaw
 	requiredContentSet

Command/ResolveMerge.hs

@@ -14,11 +14,12 @@ import Git.Sha
 import qualified Git.Branch
 import Annex.AutoMerge
 
-cmd :: [Command]
+cmd :: Command
-cmd = [command "resolvemerge" paramNothing seek SectionPlumbing
+cmd = command "resolvemerge" SectionPlumbing
-	"resolve merge conflicts"]
+	"resolve merge conflicts"
+	paramNothing (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withNothing start
 
 start :: CommandStart

Command/RmUrl.hs

@@ -13,12 +13,14 @@ import Logs.Web
 import Annex.UUID
 import qualified Remote
 
-cmd :: [Command]
+cmd :: Command
-cmd = [notBareRepo $
+cmd = notBareRepo $
-	command "rmurl" (paramPair paramFile paramUrl) seek
+	command "rmurl" SectionCommon 
-		SectionCommon "record file is not available at url"]
+		"record file is not available at url"
+		(paramPair paramFile paramUrl)
+		(withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withPairs start
 
 start :: (FilePath, String) -> CommandStart

Command/Schedule.hs

@@ -17,11 +17,12 @@ import Types.Messages
 
 import qualified Data.Set as S
 
-cmd :: [Command]
+cmd :: Command
-cmd = [command "schedule" (paramPair paramRemote (paramOptional paramExpression)) seek
+cmd = command "schedule" SectionSetup "get or set scheduled jobs"
-	SectionSetup "get or set scheduled jobs"]
+	(paramPair paramRemote (paramOptional paramExpression))
+	(withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart

Command/Semitrust.hs

@@ -11,9 +11,10 @@ import Command
 import Types.TrustLevel
 import Command.Trust (trustCommand)
 
-cmd :: [Command]
+cmd :: Command
-cmd = [command "semitrust" (paramRepeating paramRemote) seek
+cmd = command "semitrust" SectionSetup 
-	SectionSetup "return repository to default trust level"]
+	"return repository to default trust level"
+	(paramRepeating paramRemote) (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = trustCommand "semitrust" SemiTrusted

Command/SendKey.hs

@@ -16,11 +16,13 @@ import Annex.Transfer
 import qualified CmdLine.GitAnnexShell.Fields as Fields
 import Utility.Metered
 
-cmd :: [Command]
+cmd :: Command
-cmd = [noCommit $ command "sendkey" paramKey seek
+cmd = noCommit $ 
-	SectionPlumbing "runs rsync in server mode to send content"]
+	command "sendkey" SectionPlumbing 
+		"runs rsync in server mode to send content"
+		paramKey (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withKeys start
 
 start :: Key -> CommandStart

Command/SetKey.hs

@@ -13,11 +13,12 @@ import Logs.Location
 import Annex.Content
 import Types.Key
 
-cmd :: [Command]
+cmd :: Command
-cmd = [command "setkey" (paramPair paramKey paramPath) seek
+cmd = command "setkey" SectionPlumbing "sets annexed content for a key"
-	SectionPlumbing "sets annexed content for a key"]
+	(paramPair paramKey paramPath)
+	(withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart

Command/SetPresentKey.hs

@@ -13,11 +13,14 @@ import Logs.Location
 import Logs.Presence.Pure
 import Types.Key
 
-cmd :: [Command]
+cmd :: Command
-cmd = [noCommit $ command "setpresentkey" (paramPair paramKey (paramPair paramUUID "[1|0]")) seek
+cmd = noCommit $ 
-	SectionPlumbing "change records of where key is present"] 
+	command "setpresentkey" SectionPlumbing
+		"change records of where key is present"
+		(paramPair paramKey (paramPair paramUUID "[1|0]"))
+		(withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart

Command/Status.hs

@@ -16,12 +16,13 @@ import qualified Git.LsFiles as LsFiles
 import qualified Git.Ref
 import qualified Git
 
-cmd :: [Command]
+cmd :: Command
-cmd = [notBareRepo $ noCommit $ noMessages $ withOptions [jsonOption] $
+cmd = notBareRepo $ noCommit $ noMessages $ withGlobalOptions [jsonOption] $
-	command "status" paramPaths seek SectionCommon
+	command "status" SectionCommon
-		"show the working tree status"]
+		"show the working tree status"
+		paramPaths (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [FilePath] -> CommandStart

Command/Sync.hs

@@ -51,26 +51,33 @@ import Utility.Bloom
 import Control.Concurrent.MVar
 import qualified Data.Map as M
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions syncOptions $
+cmd = command "sync" SectionCommon 
-	command "sync" (paramOptional (paramRepeating paramRemote))
+	"synchronize local repository with remotes"
-	seek SectionCommon "synchronize local repository with remotes"]
+	(paramRepeating paramRemote) (seek <$$> optParser)
 
-syncOptions :: [Option]
+data SyncOptions  = SyncOptions
-syncOptions =
+	{ syncWith :: CmdParams
-	[ contentOption
+	, contentOption :: Bool
-	, messageOption
+	, messageOption :: Maybe String
-	, allOption
+	, keyOptions :: Maybe KeyOptions
-	]
+	}
 
-contentOption :: Option
+optParser :: CmdParamsDesc -> Parser SyncOptions
-contentOption = flagOption [] "content" "also transfer file contents"
+optParser desc = SyncOptions
+	<$> cmdParams desc
+	<*> switch
+		( long "content"
+		<> help "also transfer file contents"
+		)
+	<*> optional (strOption
+		( long "message" <> short 'm' <> metavar "MSG"
+		<> help "commit message"
+		))
+	<*> optional parseAllOption
 
-messageOption :: Option
+seek :: SyncOptions -> CommandSeek
-messageOption = fieldOption ['m'] "message" "MSG" "specify commit message"
+seek o = do
-
-seek :: CommandSeek
-seek rs = do
 	prepMerge
 
 	-- There may not be a branch checked out until after the commit,
@@ -89,20 +96,20 @@ seek rs = do
 		)
 	let withbranch a = a =<< getbranch
 
-	remotes <- syncRemotes rs
+	remotes <- syncRemotes (syncWith o)
 	let gitremotes = filter Remote.gitSyncableRemote remotes
 	let dataremotes = filter (not . remoteAnnexIgnore . Remote.gitconfig) remotes
 
 	-- Syncing involves many actions, any of which can independently
 	-- fail, without preventing the others from running.
 	seekActions $ return $ concat
-		[ [ commit ]
+		[ [ commit o ]
 		, [ withbranch mergeLocal ]
 		, map (withbranch . pullRemote) gitremotes
 		,  [ mergeAnnex ]
 		]
-	whenM (Annex.getFlag $ optionName contentOption) $
+	when (contentOption o) $
-		whenM (seekSyncContent dataremotes) $
+		whenM (seekSyncContent o dataremotes) $
 			-- Transferring content can take a while,
 			-- and other changes can be pushed to the git-annex
 			-- branch on the remotes in the meantime, so pull
@@ -150,15 +157,14 @@ syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted )
 	
 	fastest = fromMaybe [] . headMaybe . Remote.byCost
 
-commit :: CommandStart
+commit :: SyncOptions -> CommandStart
-commit = ifM (annexAutoCommit <$> Annex.getGitConfig)
+commit o = ifM (annexAutoCommit <$> Annex.getGitConfig)
 	( go
 	, stop
 	)
   where
 	go = next $ next $ do
-		commitmessage <- maybe commitMsg return
+		commitmessage <- maybe commitMsg return (messageOption o)
-			=<< Annex.getField (optionName messageOption)
 		showStart "commit" ""
 		Annex.Branch.commit "update"
 		ifM isDirect
@@ -371,14 +377,16 @@ newer remote b = do
  -
  - If any file movements were generated, returns true.
  -}
-seekSyncContent :: [Remote] -> Annex Bool
+seekSyncContent :: SyncOptions -> [Remote] -> Annex Bool
-seekSyncContent rs = do
+seekSyncContent o rs = do
 	mvar <- liftIO newEmptyMVar
-	bloom <- ifM (Annex.getFlag "all")
+	bloom <- case keyOptions o of
-		( Just <$> genBloomFilter (seekworktree mvar [])
+		Just WantAllKeys -> Just <$> genBloomFilter (seekworktree mvar [])
-		, seekworktree mvar [] (const noop) >> pure Nothing
+		_ -> seekworktree mvar [] (const noop) >> pure Nothing
-		)
+	withKeyOptions' (keyOptions o) False
-	withKeyOptions' False (seekkeys mvar bloom) (const noop) []
+		(seekkeys mvar bloom) 
+		(const noop)
+		[]
 	liftIO $ not <$> isEmptyMVar mvar
   where
 	seekworktree mvar l bloomfeeder = seekHelper LsFiles.inRepo l >>=

Command/Test.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2013 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2015 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -10,28 +10,23 @@ module Command.Test where
 import Common
 import Command
 import Messages
+import Types.Test
 
-cmd :: [Command]
+cmd :: Parser TestOptions -> Maybe TestRunner -> Command
-cmd = [ noRepo startIO $ dontCheck repoExists $
+cmd optparser runner = noRepo (startIO runner <$$> const optparser) $
-	command "test" paramNothing seek SectionTesting
+	dontCheck repoExists $
-		"run built-in test suite"]
+		command "test" SectionTesting
+			"run built-in test suite"
+			paramNothing (seek runner <$$> const optparser)
 
-seek :: CommandSeek
+seek :: Maybe TestRunner -> TestOptions -> CommandSeek
-seek = withWords start
+seek runner o = commandAction $ start runner o
 
-{- We don't actually run the test suite here because of a dependency loop.
+start :: Maybe TestRunner -> TestOptions -> CommandStart
- - The main program notices when the command is test and runs it; this
+start runner o = do
- - function is never run if that works.
+	liftIO $ startIO runner o
- -
- - However, if git-annex is built without the test suite, just print a
- - warning, and do not exit nonzero. This is so git-annex test can be run
- - in debian/rules despite some architectures not being able to build the
- - test suite.
- -}
-start :: [String] -> CommandStart
-start ps = do
-	liftIO $ startIO ps
 	stop
 
-startIO :: CmdParams -> IO ()
+startIO :: Maybe TestRunner -> TestOptions -> IO ()
-startIO _ = warningIO "git-annex was built without its test suite; not testing"
+startIO Nothing _ = warningIO "git-annex was built without its test suite; not testing"
+startIO (Just runner) o = runner o

Command/TestRemote.hs

@@ -27,6 +27,7 @@ import Messages
 import Types.Messages
 import Remote.Helper.Chunked
 import Locations
+import Git.Types
 
 import Test.Tasty
 import Test.Tasty.Runners
@@ -36,25 +37,30 @@ import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
 
-cmd :: [Command]
+cmd :: Command
-cmd = [ withOptions [sizeOption] $
+cmd = command "testremote" SectionTesting
-		command "testremote" paramRemote seek SectionTesting
+	"test transfers to/from a remote"
-			"test transfers to/from a remote"]
+	paramRemote (seek <$$> optParser)
 
-sizeOption :: Option
+data TestRemoteOptions = TestRemoteOptions
-sizeOption = fieldOption [] "size" paramSize "base key size (default 1MiB)"
+	{ testRemote :: RemoteName
+	, sizeOption :: ByteSize
+	}
 
-seek :: CommandSeek
+optParser :: CmdParamsDesc -> Parser TestRemoteOptions
-seek ps = do
+optParser desc = TestRemoteOptions
-	basesz <- fromInteger . fromMaybe (1024 * 1024)
+	<$> argument str ( metavar desc )
-		<$> getOptionField sizeOption (pure . getsize)
+	<*> option (str >>= maybe (fail "parse error") return . readSize dataUnits)
-	withWords (start basesz) ps
+		( long "size" <> metavar paramSize
-  where
+		<> value (1024 * 1024)
-	getsize v = v >>= readSize dataUnits
+		<> help "base key size (default 1MiB)"
+		)
 
-start :: Int -> [String] -> CommandStart
+seek :: TestRemoteOptions -> CommandSeek
-start basesz ws = do
+seek o = commandAction $ start (fromInteger $ sizeOption o) (testRemote o) 
-	let name = unwords ws
+
+start :: Int -> RemoteName -> CommandStart
+start basesz name = do
 	showStart "testremote" name
 	r <- either error id <$> Remote.byName' name
 	showSideAction "generating test keys"

Command/TransferInfo.hs

@@ -15,11 +15,13 @@ import Types.Key
 import qualified CmdLine.GitAnnexShell.Fields as Fields
 import Utility.Metered
 
-cmd :: [Command]
+cmd :: Command
-cmd = [noCommit $ command "transferinfo" paramKey seek SectionPlumbing
+cmd = noCommit $ 
-	"updates sender on number of bytes of content received"]
+	command "transferinfo" SectionPlumbing
+		"updates sender on number of bytes of content received"
+		paramKey (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 {- Security:
@@ -47,8 +49,8 @@ start (k:[]) = do
 				, transferUUID = u
 				, transferKey = key
 				}
-			info <- liftIO $ startTransferInfo file
+			tinfo <- liftIO $ startTransferInfo file
-			(update, tfile, _) <- mkProgressUpdater t info
+			(update, tfile, _) <- mkProgressUpdater t tinfo
 			liftIO $ mapM_ void
 				[ tryIO $ forever $ do
 					bytes <- readUpdate

Command/TransferKey.hs

@@ -15,41 +15,51 @@ import Annex.Transfer
 import qualified Remote
 import Types.Remote
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions transferKeyOptions $
+cmd = noCommit $
-	noCommit $ command "transferkey" paramKey seek SectionPlumbing
+	command "transferkey" SectionPlumbing
-		"transfers a key from or to a remote"]
+		"transfers a key from or to a remote"
+		paramKey (seek <--< optParser)
 
-transferKeyOptions :: [Option]
+data TransferKeyOptions = TransferKeyOptions
-transferKeyOptions = fileOption : fromToOptions
+	{ keyOptions :: CmdParams 
+	, fromToOptions :: FromToOptions
+	, fileOption :: AssociatedFile
+	}
 
-fileOption :: Option
+optParser :: CmdParamsDesc -> Parser TransferKeyOptions
-fileOption = fieldOption [] "file" paramFile "the associated file"
+optParser desc  = TransferKeyOptions
+	<$> cmdParams desc
+	<*> parseFromToOptions
+	<*> optional (strOption
+		( long "file" <> metavar paramFile
+		<> help "the associated file"
+		))
 
-seek :: CommandSeek
+instance DeferredParseClass TransferKeyOptions where
-seek ps = do
+	finishParse v = TransferKeyOptions
-	to <- getOptionField toOption Remote.byNameWithUUID
+		<$> pure (keyOptions v)
-	from <- getOptionField fromOption Remote.byNameWithUUID
+		<*> finishParse (fromToOptions v)
-	file <- getOptionField fileOption return
+		<*> pure (fileOption v)
-	withKeys (start to from file) ps
 
-start :: Maybe Remote -> Maybe Remote -> AssociatedFile -> Key -> CommandStart
+seek :: TransferKeyOptions -> CommandSeek
-start to from file key =
+seek o = withKeys (start o) (keyOptions o)
-	case (from, to) of
-		(Nothing, Just dest) -> next $ toPerform dest key file
-		(Just src, Nothing) -> next $ fromPerform src key file
-		_ -> error "specify either --from or --to"
 
-toPerform :: Remote -> Key -> AssociatedFile -> CommandPerform
+start :: TransferKeyOptions -> Key -> CommandStart
-toPerform remote key file = go Upload file $
+start o key = case fromToOptions o of
+	ToRemote dest -> next $ toPerform key (fileOption o) =<< getParsed dest
+	FromRemote src -> next $ fromPerform key (fileOption o) =<< getParsed src
+
+toPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
+toPerform key file remote = go Upload file $
 	upload (uuid remote) key file forwardRetry noObserver $ \p -> do
 		ok <- Remote.storeKey remote key file p
 		when ok $
 			Remote.logStatus remote key InfoPresent
 		return ok
 
-fromPerform :: Remote -> Key -> AssociatedFile -> CommandPerform
+fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
-fromPerform remote key file = go Upload file $
+fromPerform key file remote = go Upload file $
 	download (uuid remote) key file forwardRetry noObserver $ \p ->
 		getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p
 

Command/TransferKeys.hs

@@ -21,11 +21,11 @@ import Git.Types (RemoteName)
 
 data TransferRequest = TransferRequest Direction Remote Key AssociatedFile
 
-cmd :: [Command]
+cmd :: Command
-cmd = [command "transferkeys" paramNothing seek
+cmd = command "transferkeys" SectionPlumbing "transfers keys"
-	SectionPlumbing "transfers keys"]
+	paramNothing (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withNothing start
 
 start :: CommandStart
@@ -45,7 +45,7 @@ start = do
 			download (Remote.uuid remote) key file forwardRetry observer $ \p ->
 				getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p
 	
-	observer False t info = recordFailedTransfer t info
+	observer False t tinfo = recordFailedTransfer t tinfo
 	observer True _ _ = noop
 
 runRequests
@@ -80,14 +80,14 @@ runRequests readh writeh a = do
 		hFlush writeh
 
 sendRequest :: Transfer -> TransferInfo -> Handle -> IO ()
-sendRequest t info h = do
+sendRequest t tinfo h = do
 	hPutStr h $ intercalate fieldSep
 		[ serialize (transferDirection t)
 		, maybe (serialize (fromUUID (transferUUID t)))
 			(serialize . Remote.name)
-			(transferRemote info)
+			(transferRemote tinfo)
 		, serialize (transferKey t)
-		, serialize (associatedFile info)
+		, serialize (associatedFile tinfo)
 		, "" -- adds a trailing null
 		]
 	hFlush h

Command/Trust.hs

@@ -16,14 +16,14 @@ import Logs.Group
 
 import qualified Data.Set as S
 
-cmd :: [Command]
+cmd :: Command
-cmd = [command "trust" (paramRepeating paramRemote) seek
+cmd = command "trust" SectionSetup "trust a repository"
-	SectionSetup "trust a repository"]
+	(paramRepeating paramRemote) (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = trustCommand "trust" Trusted
 
-trustCommand :: String -> TrustLevel -> CommandSeek
+trustCommand :: String -> TrustLevel -> CmdParams -> CommandSeek
 trustCommand c level = withWords start
   where
 	start ws = do

Command/Unannex.hs

@@ -22,12 +22,13 @@ import qualified Git.DiffTree as DiffTree
 import Utility.CopyFile
 import Command.PreCommit (lockPreCommitHook)
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions annexedMatchingOptions $
+cmd = withGlobalOptions annexedMatchingOptions $
-	command "unannex" paramPaths seek SectionUtility
+	command "unannex" SectionUtility
-		"undo accidential add command"]
+		"undo accidential add command"
+		paramPaths (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = wrapUnannex . (withFilesInGit $ whenAnnexed start)
 
 wrapUnannex :: Annex a -> Annex a

Command/Undo.hs

@@ -21,12 +21,13 @@ import qualified Git.Command as Git
 import qualified Git.Branch
 import qualified Command.Sync
 
-cmd :: [Command]
+cmd :: Command
-cmd = [notBareRepo $
+cmd = notBareRepo $
-	command "undo" paramPaths seek
+	command "undo" SectionCommon 
-		SectionCommon "undo last change to a file or directory"]
+		"undo last change to a file or directory"
+		paramPaths (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek ps = do
 	-- Safety first; avoid any undo that would touch files that are not
 	-- in the index.

Command/Ungroup.hs

@@ -15,11 +15,11 @@ import Types.Group
 
 import qualified Data.Set as S
 
-cmd :: [Command]
+cmd :: Command
-cmd = [command "ungroup" (paramPair paramRemote paramDesc) seek
+cmd = command "ungroup" SectionSetup "remove a repository from a group"
-	SectionSetup "remove a repository from a group"]
+	(paramPair paramRemote paramDesc) (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart

Command/Uninit.hs

@@ -21,9 +21,11 @@ import Utility.FileMode
 import System.IO.HVFS
 import System.IO.HVFS.Utils
 
-cmd :: [Command]
+cmd :: Command
-cmd = [addCheck check $ command "uninit" paramPaths seek 
+cmd = addCheck check $ 
-	SectionUtility "de-initialize git-annex and clean out repository"]
+	command "uninit" SectionUtility
+		"de-initialize git-annex and clean out repository"
+		paramPaths (withParams seek)
 
 check :: Annex ()
 check = do
@@ -39,7 +41,7 @@ check = do
 	revhead = inRepo $ Git.Command.pipeReadStrict
 		[Param "rev-parse", Param "--abbrev-ref", Param "HEAD"]
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek ps = do
 	withFilesNotInGit False (whenAnnexed startCheckIncomplete) ps
 	Annex.changeState $ \s -> s { Annex.fast = True }

Command/Unlock.hs

@@ -13,16 +13,17 @@ import Annex.Content
 import Annex.CatFile
 import Utility.CopyFile
 
-cmd :: [Command]
+cmd :: Command
-cmd =
+cmd = mkcmd "unlock" "unlock files for modification"
-	[ c "unlock" "unlock files for modification"
-	, c "edit" "same as unlock"
-	]
-  where
-	c n = notDirect . withOptions annexedMatchingOptions 
-		. command n paramPaths seek SectionCommon
 
-seek :: CommandSeek
+editcmd :: Command
+editcmd = mkcmd "edit" "same as unlock"
+
+mkcmd :: String -> String -> Command
+mkcmd n d = notDirect $ withGlobalOptions annexedMatchingOptions $
+	command n SectionCommon d paramPaths (withParams seek)
+
+seek :: CmdParams -> CommandSeek
 seek = withFilesInGit $ whenAnnexed start
 
 {- The unlock subcommand replaces the symlink with a copy of the file's

Command/Untrust.hs

@@ -11,9 +11,9 @@ import Command
 import Types.TrustLevel
 import Command.Trust (trustCommand)
 
-cmd :: [Command]
+cmd :: Command
-cmd = [command "untrust" (paramRepeating paramRemote) seek
+cmd = command "untrust" SectionSetup "do not trust a repository"
-	SectionSetup "do not trust a repository"]
+	(paramRepeating paramRemote) (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = trustCommand "untrust" UnTrusted

Command/Unused.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - 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.
  -}
@@ -31,38 +31,47 @@ import Annex.CatFile
 import Types.Key
 import Types.RefSpec
 import Git.FilePath
+import Git.Types
 import Logs.View (is_branchView)
 import Annex.BloomFilter
 
-cmd :: [Command]
+cmd :: Command
-cmd = [withOptions [unusedFromOption, refSpecOption] $
+cmd = -- withGlobalOptions [unusedFromOption, refSpecOption] $
-	command "unused" paramNothing seek
+	command "unused" SectionMaintenance 
-		SectionMaintenance "look for unused file content"]
+		"look for unused file content"
+		paramNothing (seek <$$> optParser)
 
-unusedFromOption :: Option
+data UnusedOptions = UnusedOptions
-unusedFromOption = fieldOption ['f'] "from" paramRemote "remote to check for unused content"
+	{ fromRemote :: Maybe RemoteName
+	, refSpecOption :: Maybe RefSpec
+	}
 
-refSpecOption :: Option
+optParser :: CmdParamsDesc -> Parser UnusedOptions
-refSpecOption = fieldOption [] "used-refspec" paramRefSpec "refs to consider used (default: all refs)"
+optParser _ = UnusedOptions
+	<$> optional (strOption
+		( long "from" <> short 'f' <> metavar paramRemote
+		<> help "remote to check for unused content"
+		))
+	<*> optional (option (eitherReader parseRefSpec)
+		( long "unused-refspec" <> metavar paramRefSpec
+		<> help "refs to consider used (default: all branches)"
+		))
 
-seek :: CommandSeek
+seek :: UnusedOptions -> CommandSeek
-seek = withNothing start
+seek = commandAction . start
 
-{- Finds unused content in the annex. -} 
+start :: UnusedOptions -> CommandStart
-start :: CommandStart
+start o = do
-start = do
 	cfgrefspec <- fromMaybe allRefSpec . annexUsedRefSpec
 		<$> Annex.getGitConfig
-	!refspec <- maybe cfgrefspec (either error id . parseRefSpec)
+	let refspec = fromMaybe cfgrefspec (refSpecOption o)
-		<$> Annex.getField (optionName refSpecOption)
+	let (name, perform) = case fromRemote o of
-	from <- Annex.getField (optionName unusedFromOption)
-	let (name, action) = case from of
 		Nothing -> (".", checkUnused refspec)
 		Just "." -> (".", checkUnused refspec)
 		Just "here" -> (".", checkUnused refspec)
 		Just n -> (n, checkRemoteUnused n refspec)
 	showStart "unused" name
-	next action
+	next perform
 
 checkUnused :: RefSpec -> CommandPerform
 checkUnused refspec = chain 0
@@ -126,11 +135,11 @@ unusedMsg u = unusedMsg' u
 	["Some annexed data is no longer used by any files:"]
 	[dropMsg Nothing]
 unusedMsg' :: [(Int, Key)] -> [String] -> [String] -> String
-unusedMsg' u header trailer = unlines $
+unusedMsg' u mheader mtrailer = unlines $
-	header ++
+	mheader ++
 	table u ++
 	["(To see where data was previously used, try: git log --stat -S'KEY')"] ++
-	trailer
+	mtrailer
 
 remoteUnusedMsg :: Remote -> [(Int, Key)] -> String
 remoteUnusedMsg r u = unusedMsg' u
@@ -267,7 +276,7 @@ data UnusedMaps = UnusedMaps
 	, unusedTmpMap :: UnusedMap
 	}
 
-withUnusedMaps :: (UnusedMaps -> Int -> CommandStart) -> CommandSeek
+withUnusedMaps :: (UnusedMaps -> Int -> CommandStart) -> CmdParams -> CommandSeek
 withUnusedMaps a params = do
 	unused <- readUnusedMap ""
 	unusedbad <- readUnusedMap "bad"

Command/Upgrade.hs

@@ -11,12 +11,12 @@ import Common.Annex
 import Command
 import Upgrade
 
-cmd :: [Command]
+cmd :: Command
-cmd = [dontCheck repoExists $ -- because an old version may not seem to exist
+cmd = dontCheck repoExists $ -- because an old version may not seem to exist
-	command "upgrade" paramNothing seek
+	command "upgrade" SectionMaintenance "upgrade repository layout"
-		SectionMaintenance "upgrade repository layout"]
+		paramNothing (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withNothing start
 
 start :: CommandStart

Command/VAdd.hs

@@ -12,11 +12,14 @@ import Command
 import Annex.View
 import Command.View (checkoutViewBranch)
 
-cmd :: [Command]
+cmd :: Command
-cmd = [notBareRepo $ notDirect $ command "vadd" (paramRepeating "FIELD=GLOB")
+cmd = notBareRepo $ notDirect $
-	seek SectionMetaData "add subdirs to current view"]
+	command "vadd" SectionMetaData 
+		"add subdirs to current view"
+		(paramRepeating "FIELD=GLOB")
+		(withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart

Command/VCycle.hs

@@ -14,12 +14,13 @@ import Types.View
 import Logs.View
 import Command.View (checkoutViewBranch)
 
-cmd :: [Command]
+cmd :: Command
-cmd = [notBareRepo $ notDirect $
+cmd = notBareRepo $ notDirect $
-	command "vcycle" paramNothing seek SectionMetaData
+	command "vcycle" SectionMetaData
-	"switch view to next layout"]
+		"switch view to next layout"
+		paramNothing (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withNothing start
 
 start ::CommandStart

Command/VFilter.hs

@@ -12,11 +12,12 @@ import Command
 import Annex.View
 import Command.View (paramView, checkoutViewBranch)
 
-cmd :: [Command]
+cmd :: Command
-cmd = [notBareRepo $ notDirect $
+cmd = notBareRepo $ notDirect $
-	command "vfilter" paramView seek SectionMetaData "filter current view"]
+	command "vfilter" SectionMetaData "filter current view"
+		paramView (withParams seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart