started converting to use optparse-applicative

This is a work in progress. It compiles and is able to do basic command
dispatch, including git autocorrection, while using optparse-applicative
for the core commandline parsing.

* Many commands are temporarily disabled before conversion.
* Options are not wired in yet.
* cmdnorepo actions don't work yet.

Also, removed the [Command] list, which was only used in one place.

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.
  -}
@@ -16,7 +16,7 @@ module CmdLine (
 import qualified Control.Exception as E
 import qualified Data.Map as M
 import Control.Exception (throw)
-import System.Console.GetOpt
+import qualified Options.Applicative as O
 #ifndef mingw32_HOST_OS
 import System.Posix.Signals
 #endif
@@ -35,6 +35,41 @@ import Types.Messages
 dispatch :: Bool -> CmdParams -> [Command] -> [Option] -> [(String, String)] -> String -> IO Git.Repo -> IO ()
 dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do
 	setupConsole
+	go =<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo))
+  where
+	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) <- liftIO $
+				O.handleParseResult (parseCmd (name:args) allcmds)
+			when (cmdnomessages cmd) $ 
+				Annex.setOutput QuietOutput
+			-- TODO: propigate global options to annex state (how?)
+			whenM (annexDebug <$> Annex.getGitConfig) $
+				liftIO enableDebugOutput
+			startup
+			performCommandAction cmd seek $
+				shutdown $ cmdnocommit cmd
+	go (Left e) = do
+		when fuzzy $
+			autocorrect =<< Git.Config.global
+		-- a <- O.handleParseResult (parseCmd (name:args) allcmds)
+		error "TODO"
+
+	autocorrect = Git.AutoCorrect.prepare inputcmdname cmdname cmds
+	err msg = msg ++ "\n\n" ++ usage header allcmds
+	(fuzzy, cmds, inputcmdname, args) = findCmd fuzzyok allargs allcmds err
+	name
+		| fuzzy = case cmds of
+			[c] -> cmdname c
+			_ -> inputcmdname
+		| otherwise = inputcmdname
+
+#if 0
 	case getOptCmd args cmd commonoptions of
 		Right (flags, params) -> go flags params
 			=<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo))
@@ -59,10 +94,19 @@ dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do
 		when fuzzy $
 			autocorrect =<< Git.Config.global
 		maybe (throw e) (\a -> a params) (cmdnorepo cmd)
-	err msg = msg ++ "\n\n" ++ usage header allcmds
 	cmd = Prelude.head cmds
-	(fuzzy, cmds, name, args) = findCmd fuzzyok allargs allcmds err
-	autocorrect = Git.AutoCorrect.prepare name cmdname cmds
+#endif
+
+{- Parses command line and selects a command to run and gets the
+ - seek action for the command. -}
+parseCmd :: CmdParams -> [Command] -> O.ParserResult (Command, CommandSeek)
+parseCmd allargs allcmds = O.execParserPure (O.prefs O.idm) pinfo allargs
+  where
+	pinfo = O.info (O.subparser $ mconcat $ map mkcommand allcmds) O.idm
+	mkcommand c = O.command (cmdname c) (O.info (mkparser c) O.idm)
+	mkparser c = (,)
+		<$> pure c
+		<*> cmdparser c
 
 {- Parses command line params far enough to find the Command to run, and
  - returns the remaining params.
@@ -84,18 +128,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 { cmdseek = seek, cmdcheck = c, cmdname = name } params cont = do
+performCommandAction :: Command -> CommandSeek -> Annex () -> Annex ()
+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/GitAnnex.hs

@@ -16,6 +16,7 @@ import Utility.Env
 import Annex.Ssh
 
 import qualified Command.Add
+{-
 import qualified Command.Unannex
 import qualified Command.Drop
 import qualified Command.Move
@@ -116,15 +117,18 @@ import qualified Command.TestRemote
 #ifdef WITH_EKG
 import System.Remote.Monitoring
 #endif
+-}
 
 cmds :: [Command]
-cmds = concat
+cmds = 
 	[ Command.Add.cmd
+{-
 	, Command.Get.cmd
 	, Command.Drop.cmd
 	, Command.Move.cmd
 	, Command.Copy.cmd
 	, Command.Unlock.cmd
+	, Command.Unlock.editcmd
 	, Command.Lock.cmd
 	, Command.Sync.cmd
 	, Command.Mirror.cmd
@@ -217,6 +221,7 @@ cmds = concat
 	, Command.FuzzTest.cmd
 	, Command.TestRemote.cmd
 #endif
+-}
 	]
 
 header :: String

CmdLine/GitAnnexShell.hs

@@ -16,7 +16,6 @@ import qualified Git.Config
 import CmdLine
 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
@@ -100,12 +99,10 @@ builtin cmd dir params = do
 	checkNotReadOnly cmd
 	checkDirectory $ Just dir
 	let (params', fieldparams, opts) = partitionParams params
-	    fields = filter checkField $ parseFields fieldparams
-	    cmds' = map (newcmd $ unwords opts) cmds
-	dispatch False (cmd : params') cmds' options fields header mkrepo
+	    rsyncopts = ("RsyncOptions", unwords opts)
+	    fields = rsyncopts : filter checkField (parseFields fieldparams)
+	dispatch False (cmd : params') cmds options fields header mkrepo
   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
@@ -200,8 +197,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 = map $ addCheck okforshell . dontCheck repoExists
+gitAnnexShellCheck :: Command -> Command
+gitAnnexShellCheck = addCheck okforshell . dontCheck repoExists
   where
 	okforshell = unlessM (isInitialized <||> isJust . gcryptId <$> Annex.getGitConfig) $
 		error "Not a git-annex or gcrypt repository."

CmdLine/Seek.hs

@@ -29,11 +29,11 @@ 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,11 +142,11 @@ 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
@@ -160,7 +160,7 @@ getOptionField option converter = converter <=< Annex.getField $ optionName opti
 getOptionFlag :: Option -> Annex Bool
 getOptionFlag option = Annex.getFlag (optionName option)
 
-withNothing :: CommandStart -> CommandSeek
+withNothing :: CommandStart -> CmdParams -> CommandSeek
 withNothing a [] = seekActions $ return [a]
 withNothing _ _ = error "This command takes no parameters."
 
@@ -171,7 +171,7 @@ 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 :: Bool -> (Key -> CommandStart) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek
 withKeyOptions auto keyop = withKeyOptions' auto $ \getkeys -> do
 	matcher <- Limit.getMatcher
 	seekActions $ map (process matcher) <$> getkeys
@@ -181,7 +181,7 @@ withKeyOptions auto keyop = withKeyOptions' auto $ \getkeys -> do
 		, return Nothing
 		)
 
-withKeyOptions' :: Bool -> (Annex [Key] -> Annex ()) -> CommandSeek -> CommandSeek
+withKeyOptions' :: Bool -> (Annex [Key] -> Annex ()) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek
 withKeyOptions' auto keyop fallbackop params = do
 	bare <- fromRepo Git.repoIsLocalBare
 	allkeys <- Annex.getFlag "all"

Command.hs

@@ -7,6 +7,7 @@
 
 module Command (
 	command,
+	commandParser,
 	noRepo,
 	noCommit,
 	noMessages,
@@ -32,10 +33,17 @@ import CmdLine.Action as ReExported
 import CmdLine.Option as ReExported
 import CmdLine.GitAnnex.Options as ReExported
 
-{- Generates a normal command -}
-command :: String -> String -> CommandSeek -> CommandSection -> String -> Command
+import qualified Options.Applicative as O
+
+{- Generates a normal Command -}
+command :: String -> String -> CommandSection -> String -> CommandParser -> Command
 command = Command [] Nothing commonChecks False False
 
+{- Simple CommandParser generator, for when the CommandSeek wants all
+ - non-option parameters. -}
+commandParser :: (CmdParams -> CommandSeek) -> CommandParser
+commandParser mkseek = mkseek <$> O.many (O.argument O.str O.idm)
+
 {- Indicates that a command doesn't need to commit any changes to
  - the git-annex branch. -}
 noCommit :: Command -> Command

Command/Add.hs

@@ -34,9 +34,10 @@ import Utility.Tmp
 
 import Control.Exception (IOException)
 
-cmd :: [Command]
-cmd = [notBareRepo $ withOptions addOptions $
-	command "add" paramPaths seek SectionCommon "add files to annex"]
+cmd :: Command
+cmd = notBareRepo $ withOptions addOptions $
+	command "add" paramPaths SectionCommon "add files to annex"
+		(commandParser seek)
 
 addOptions :: [Option]
 addOptions = includeDotFilesOption : fileMatchingOptions
@@ -47,7 +48,7 @@ includeDotFilesOption = flagOption [] "include-dotfiles" "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 :: CmdParams -> CommandSeek
 seek ps = do
 	matcher <- largeFilesMatcher
 	let go a = flip a ps $ \file -> ifM (checkFileMatcher matcher file <||> Annex.getState Annex.force)

Command/AddUnused.hs

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

Command/AddUrl.hs

@@ -37,10 +37,10 @@ import Annex.Quvi
 import qualified Utility.Quvi as Quvi
 #endif
 
-cmd :: [Command]
-cmd = [notBareRepo $ withOptions [fileOption, pathdepthOption, relaxedOption, rawOption] $
+cmd :: Command
+cmd = notBareRepo $ withOptions [fileOption, pathdepthOption, relaxedOption, rawOption] $
 	command "addurl" (paramRepeating paramUrl) seek
-		SectionCommon "add urls to annex"]
+		SectionCommon "add urls to annex"
 
 fileOption :: Option
 fileOption = fieldOption [] "file" paramFile "specify what file the url is added to"

Command/Assistant.hs

@@ -19,10 +19,10 @@ import Assistant.Install
 
 import System.Environment
 
-cmd :: [Command]
-cmd = [noRepo checkNoRepoOpts $ dontCheck repoExists $ withOptions options $
+cmd :: Command
+cmd = noRepo checkNoRepoOpts $ dontCheck repoExists $ withOptions options $
 	notBareRepo $ command "assistant" paramNothing seek SectionCommon
-		"automatically sync changes"]
+		"automatically sync changes"
 
 options :: [Option]
 options =

Command/CheckPresentKey.hs

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

Command/Commit.hs

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

Command/ConfigList.hs

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

Command/ContentLocation.hs

@@ -12,10 +12,10 @@ import Command
 import CmdLine.Batch
 import Annex.Content
 
-cmd :: [Command]
-cmd = [withOptions [batchOption] $ noCommit $ noMessages $
+cmd :: Command
+cmd = withOptions [batchOption] $ noCommit $ noMessages $
 	command "contentlocation" (paramRepeating paramKey) seek
-		SectionPlumbing "looks up content for a key"]
+		SectionPlumbing "looks up content for a key"
 
 seek :: CommandSeek
 seek = batchable withKeys start

Command/Copy.hs

@@ -14,9 +14,9 @@ import qualified Remote
 import Annex.Wanted
 import Annex.NumCopies
 
-cmd :: [Command]
-cmd = [withOptions copyOptions $ command "copy" paramPaths seek
-	SectionCommon "copy content of files to/from another repository"]
+cmd :: Command
+cmd = withOptions copyOptions $ command "copy" paramPaths seek
+	SectionCommon "copy content of files to/from another repository"
 
 copyOptions :: [Option]
 copyOptions = Command.Move.moveOptions ++ [autoOption]

Command/Dead.hs

@@ -16,10 +16,10 @@ import Command.Trust (trustCommand)
 import Logs.Location
 import Remote (keyLocations)
 
-cmd :: [Command]
-cmd = [withOptions [keyOption] $ 
+cmd :: Command
+cmd = withOptions [keyOption] $ 
 	command "dead" (paramRepeating paramRemote) seek
-		SectionSetup "hide a lost repository or key"]
+		SectionSetup "hide a lost repository or key"
 
 seek :: CommandSeek
 seek ps = maybe (trustCommand "dead" DeadTrusted ps) (flip seekKey ps)

Command/Describe.hs

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

Command/DiffDriver.hs

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

Command/Direct.hs

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

Command/Drop.hs

@@ -22,9 +22,9 @@ import Annex.Notification
 
 import qualified Data.Set as S
 
-cmd :: [Command]
-cmd = [withOptions (dropOptions) $ command "drop" paramPaths seek
-	SectionCommon "indicate content of files not currently wanted"]
+cmd :: Command
+cmd = withOptions (dropOptions) $ command "drop" paramPaths seek
+	SectionCommon "indicate content of files not currently wanted"
 
 dropOptions :: [Option]
 dropOptions = dropFromOption : annexedMatchingOptions ++ [autoOption] ++ keyOptions

Command/DropKey.hs

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

Command/DropUnused.hs

@@ -16,10 +16,10 @@ import qualified Git
 import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
 import Annex.NumCopies
 
-cmd :: [Command]
-cmd = [withOptions [Command.Drop.dropFromOption] $
+cmd :: Command
+cmd = withOptions [Command.Drop.dropFromOption] $
 	command "dropunused" (paramRepeating paramNumRange)
-		seek SectionMaintenance "drop unused file content"]
+		seek SectionMaintenance "drop unused file content"
 
 seek :: CommandSeek
 seek ps = do

Command/EnableRemote.hs

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

Command/ExamineKey.hs

@@ -14,10 +14,10 @@ import qualified Utility.Format
 import Command.Find (formatOption, getFormat, showFormatted, keyVars)
 import Types.Key
 
-cmd :: [Command]
-cmd = [noCommit $ noMessages $ withOptions [formatOption, jsonOption, batchOption] $
+cmd :: Command
+cmd = noCommit $ noMessages $ withOptions [formatOption, jsonOption, batchOption] $
 	command "examinekey" (paramRepeating paramKey) seek
-	SectionPlumbing "prints information from a key"]
+	SectionPlumbing "prints information from a key"
 
 seek :: CommandSeek
 seek ps = do

Command/Expire.hs

@@ -20,9 +20,9 @@ import Utility.HumanTime
 import Data.Time.Clock.POSIX
 import qualified Data.Map as M
 
-cmd :: [Command]
-cmd = [withOptions [activityOption, noActOption] $ command "expire" paramExpire seek
-	SectionMaintenance "expire inactive repositories"]
+cmd :: Command
+cmd = withOptions [activityOption, noActOption] $ command "expire" paramExpire seek
+	SectionMaintenance "expire inactive repositories"
 
 paramExpire :: String
 paramExpire = (paramRepeating $ paramOptional paramRemote ++ ":" ++ paramTime)

Command/Find.hs

@@ -19,9 +19,9 @@ import qualified Utility.Format
 import Utility.DataUnits
 import Types.Key
 
-cmd :: [Command]
-cmd = [withOptions annexedMatchingOptions $ mkCommand $
-	command "find" paramPaths seek SectionQuery "lists available files"]
+cmd :: Command
+cmd = withOptions annexedMatchingOptions $ mkCommand $
+	command "find" paramPaths seek SectionQuery "lists available files"
 
 mkCommand :: Command -> Command
 mkCommand = noCommit . noMessages . withOptions [formatOption, print0Option, jsonOption]

Command/FindRef.hs

@@ -10,10 +10,10 @@ module Command.FindRef where
 import Command
 import qualified Command.Find as Find
 
-cmd :: [Command]
-cmd = [withOptions nonWorkTreeMatchingOptions $ Find.mkCommand $ 
+cmd :: Command
+cmd = withOptions nonWorkTreeMatchingOptions $ Find.mkCommand $ 
 	command "findref" paramRef seek SectionPlumbing
-		"lists files in a git ref"]
+		"lists files in a git ref"
 
 seek :: CommandSeek
 seek refs = do

Command/Fix.hs

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

Command/Forget.hs

@@ -15,9 +15,9 @@ import qualified Annex
 
 import Data.Time.Clock.POSIX
 
-cmd :: [Command]
-cmd = [withOptions forgetOptions $ command "forget" paramNothing seek
-		SectionMaintenance "prune git-annex branch history"]
+cmd :: Command
+cmd = withOptions forgetOptions $ command "forget" paramNothing seek
+		SectionMaintenance "prune git-annex branch history"
 
 forgetOptions :: [Option]
 forgetOptions = [dropDeadOption]

Command/FromKey.hs

@@ -19,10 +19,10 @@ import qualified Backend.URL
 
 import Network.URI
 
-cmd :: [Command]
-cmd = [notDirect $ notBareRepo $
+cmd :: Command
+cmd = notDirect $ notBareRepo $
 	command "fromkey" (paramPair paramKey paramPath) seek
-		SectionPlumbing "adds a file using a specific key"]
+		SectionPlumbing "adds a file using a specific key"
 
 seek :: CommandSeek
 seek ps = do

Command/Fsck.hs

@@ -40,9 +40,9 @@ import qualified Database.Fsck as FsckDb
 import Data.Time.Clock.POSIX
 import System.Posix.Types (EpochTime)
 
-cmd :: [Command]
-cmd = [withOptions fsckOptions $ command "fsck" paramPaths seek
-	SectionMaintenance "check for problems"]
+cmd :: Command
+cmd = withOptions fsckOptions $ command "fsck" paramPaths seek
+	SectionMaintenance "check for problems"
 
 fsckFromOption :: Option
 fsckFromOption = fieldOption ['f'] "from" paramRemote "check remote"

Command/FuzzTest.hs

@@ -20,9 +20,9 @@ import System.Random (getStdRandom, random, randomR)
 import Test.QuickCheck
 import Control.Concurrent
 
-cmd :: [Command]
-cmd = [ notBareRepo $ command "fuzztest" paramNothing seek SectionTesting
-	"generates fuzz test files"]
+cmd :: Command
+cmd = notBareRepo $ command "fuzztest" paramNothing seek SectionTesting
+	"generates fuzz test files"
 
 seek :: CommandSeek
 seek = withNothing start

Command/GCryptSetup.hs

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

Command/Get.hs

@@ -16,9 +16,9 @@ import Annex.NumCopies
 import Annex.Wanted
 import qualified Command.Move
 
-cmd :: [Command]
-cmd = [withOptions getOptions $ command "get" paramPaths seek
-	SectionCommon "make content of annexed files available"]
+cmd :: Command
+cmd = withOptions getOptions $ command "get" paramPaths seek
+	SectionCommon "make content of annexed files available"
 
 getOptions :: [Option]
 getOptions = fromOption : autoOption : jobsOption : annexedMatchingOptions

Command/Group.hs

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

Command/GroupWanted.hs

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

Command/Help.hs

@@ -21,9 +21,9 @@ import qualified Command.Fsck
 
 import System.Console.GetOpt
 
-cmd :: [Command]
-cmd = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $
-	command "help" (paramOptional "COMMAND") seek SectionCommon "display help"]
+cmd :: Command
+cmd = noCommit $ noRepo startNoRepo $ dontCheck repoExists $
+	command "help" (paramOptional "COMMAND") seek SectionCommon "display help"
 
 seek :: CommandSeek
 seek = withWords start

Command/Import.hs

@@ -22,9 +22,9 @@ import Annex.NumCopies
 import Types.TrustLevel
 import Logs.Trust
 
-cmd :: [Command]
-cmd = [withOptions opts $ notBareRepo $ command "import" paramPaths seek
-	SectionCommon "move and add files from outside git working copy"]
+cmd :: Command
+cmd = withOptions opts $ notBareRepo $ command "import" paramPaths seek
+	SectionCommon "move and add files from outside git working copy"
 
 opts :: [Option]
 opts = duplicateModeOptions ++ fileMatchingOptions

Command/ImportFeed.hs

@@ -43,10 +43,10 @@ import Types.MetaData
 import Logs.MetaData
 import Annex.MetaData
 
-cmd :: [Command]
-cmd = [notBareRepo $ withOptions [templateOption, relaxedOption, rawOption] $
+cmd :: Command
+cmd = notBareRepo $ withOptions [templateOption, relaxedOption, rawOption] $
 	command "importfeed" (paramRepeating paramUrl) seek
-		SectionCommon "import files from podcast feeds"]
+		SectionCommon "import files from podcast feeds"
 
 templateOption :: Option
 templateOption = fieldOption [] "template" paramFormat "template for filenames"

Command/InAnnex.hs

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

Command/Indirect.hs

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

Command/Info.hs

@@ -78,10 +78,10 @@ emptyStatInfo = StatInfo Nothing Nothing M.empty Nothing
 -- a state monad for running Stats in
 type StatState = StateT StatInfo Annex
 
-cmd :: [Command]
-cmd = [noCommit $ dontCheck repoExists $ withOptions (jsonOption : bytesOption : annexedMatchingOptions) $
+cmd :: Command
+cmd = noCommit $ dontCheck repoExists $ withOptions (jsonOption : bytesOption : annexedMatchingOptions) $
 	command "info" (paramOptional $ paramRepeating paramItem) seek 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"
 
 seek :: CommandSeek
 seek = withWords start

Command/Init.hs

@@ -11,9 +11,9 @@ import Common.Annex
 import Command
 import Annex.Init
 	
-cmd :: [Command]
-cmd = [dontCheck repoExists $
-	command "init" paramDesc seek SectionSetup "initialize git-annex"]
+cmd :: Command
+cmd = dontCheck repoExists $
+	command "init" paramDesc seek SectionSetup "initialize git-annex"
 
 seek :: CommandSeek
 seek = withWords start

Command/InitRemote.hs

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

Command/List.hs

@@ -23,10 +23,10 @@ import Annex.UUID
 import qualified Annex
 import Git.Types (RemoteName)
 
-cmd :: [Command]
-cmd = [noCommit $ withOptions (allrepos : annexedMatchingOptions) $
+cmd :: Command
+cmd = noCommit $ withOptions (allrepos : annexedMatchingOptions) $
 	command "list" paramPaths seek
-		SectionQuery "show which remotes contain files"]
+		SectionQuery "show which remotes contain files"
 
 allrepos :: Option
 allrepos = flagOption [] "allrepos" "show all repositories, not only remotes"

Command/Lock.hs

@@ -12,10 +12,10 @@ import Command
 import qualified Annex.Queue
 import qualified Annex
 	
-cmd :: [Command]
-cmd = [notDirect $ withOptions annexedMatchingOptions $
+cmd :: Command
+cmd = notDirect $ withOptions annexedMatchingOptions $
 	command "lock" paramPaths seek SectionCommon
-	"undo unlock command"]
+	"undo unlock command"
 
 seek :: CommandSeek
 seek ps = do

Command/Log.hs

@@ -38,9 +38,9 @@ data RefChange = RefChange
 
 type Outputter = Bool -> POSIXTime -> [UUID] -> Annex ()
 
-cmd :: [Command]
-cmd = [withOptions options $
-	command "log" paramPaths seek SectionQuery "shows location log"]
+cmd :: Command
+cmd = withOptions options $
+	command "log" paramPaths seek SectionQuery "shows location log"
 
 options :: [Option]
 options = passthruOptions ++ [gourceOption] ++ annexedMatchingOptions

Command/LookupKey.hs

@@ -13,10 +13,10 @@ import CmdLine.Batch
 import Annex.CatFile
 import Types.Key
 
-cmd :: [Command]
-cmd = [withOptions [batchOption] $ notBareRepo $ noCommit $ noMessages $
+cmd :: Command
+cmd = withOptions [batchOption] $ notBareRepo $ noCommit $ noMessages $
 	command "lookupkey" (paramRepeating paramFile) seek
-		SectionPlumbing "looks up key used for file"]
+		SectionPlumbing "looks up key used for file"
 
 seek :: CommandSeek
 seek = batchable withStrings start

Command/Map.hs

@@ -25,10 +25,10 @@ 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 = [dontCheck repoExists $
+cmd :: Command
+cmd = dontCheck repoExists $
 	command "map" paramNothing seek SectionQuery
-		"generate map of repositories"]
+		"generate map of repositories"
 
 seek :: CommandSeek
 seek = withNothing start

Command/Merge.hs

@@ -13,9 +13,9 @@ import qualified Annex.Branch
 import qualified Git.Branch
 import Command.Sync (prepMerge, mergeLocal)
 
-cmd :: [Command]
-cmd = [command "merge" paramNothing seek SectionMaintenance
-	"automatically merge changes from remotes"]
+cmd :: Command
+cmd = command "merge" paramNothing seek SectionMaintenance
+	"automatically merge changes from remotes"
 
 seek :: CommandSeek
 seek ps = do

Command/MetaData.hs

@@ -16,10 +16,10 @@ import Logs.MetaData
 import qualified Data.Set as S
 import Data.Time.Clock.POSIX
 
-cmd :: [Command]
-cmd = [withOptions metaDataOptions $
+cmd :: Command
+cmd = withOptions metaDataOptions $
 	command "metadata" paramPaths seek
-	SectionMetaData "sets or gets metadata of a file"]
+	SectionMetaData "sets or gets metadata of a file"
 
 metaDataOptions :: [Option]
 metaDataOptions =

Command/Migrate.hs

@@ -18,10 +18,10 @@ import qualified Command.ReKey
 import qualified Command.Fsck
 import qualified Annex
 
-cmd :: [Command]
-cmd = [notDirect $ withOptions annexedMatchingOptions $
+cmd :: Command
+cmd = notDirect $ withOptions annexedMatchingOptions $
 	command "migrate" paramPaths seek
-		SectionUtility "switch data to different backend"]
+		SectionUtility "switch data to different backend"
 
 seek :: CommandSeek
 seek = withFilesInGit $ whenAnnexed start

Command/Mirror.hs

@@ -16,9 +16,9 @@ import qualified Remote
 import Annex.Content
 import Annex.NumCopies
 
-cmd :: [Command]
-cmd = [withOptions mirrorOptions $ command "mirror" paramPaths seek
-	SectionCommon "mirror content of files to/from another repository"]
+cmd :: Command
+cmd = withOptions mirrorOptions $ command "mirror" paramPaths seek
+	SectionCommon "mirror content of files to/from another repository"
 
 mirrorOptions :: [Option]
 mirrorOptions = fromToOptions ++ [jobsOption] ++ annexedMatchingOptions ++ keyOptions

Command/Move.hs

@@ -17,9 +17,9 @@ import Annex.UUID
 import Annex.Transfer
 import Logs.Presence
 
-cmd :: [Command]
-cmd = [withOptions moveOptions $ command "move" paramPaths seek
-	SectionCommon "move content of files to/from another repository"]
+cmd :: Command
+cmd = withOptions moveOptions $ command "move" paramPaths seek
+	SectionCommon "move content of files to/from another repository"
 
 moveOptions :: [Option]
 moveOptions = fromToOptions ++ [jobsOption] ++ keyOptions ++ annexedMatchingOptions

Command/NotifyChanges.hs

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

Command/NumCopies.hs

@@ -13,9 +13,9 @@ import Command
 import Annex.NumCopies
 import Types.Messages
 
-cmd :: [Command]
-cmd = [command "numcopies" paramNumber seek
-	SectionSetup "configure desired number of copies"]
+cmd :: Command
+cmd = command "numcopies" paramNumber seek
+	SectionSetup "configure desired number of copies"
 
 seek :: CommandSeek
 seek = withWords start

Command/PreCommit.hs

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

Command/Proxy.hs

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

Command/ReKey.hs

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

Command/ReadPresentKey.hs

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

Command/RecvKey.hs

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

Command/RegisterUrl.hs

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

Command/Reinit.hs

@@ -15,8 +15,9 @@ import Types.UUID
 import qualified Remote
 	
 cmd :: [Command]
-cmd = [dontCheck repoExists $
-	command "reinit" (paramUUID ++ "|" ++ paramDesc) seek SectionUtility "initialize repository, reusing old UUID"]
+cmd = dontCheck repoExists $
+	command "reinit" (paramUUID ++ "|" ++ paramDesc) seek
+		SectionUtility "initialize repository, reusing old UUID"
 
 seek :: CommandSeek
 seek = withWords start

Command/Reinject.hs

@@ -15,8 +15,8 @@ import qualified Command.Fsck
 import qualified Backend
 
 cmd :: [Command]
-cmd = [command "reinject" (paramPair "SRC" "DEST") seek
-	SectionUtility "sets content of annexed file"]
+cmd = command "reinject" (paramPair "SRC" "DEST") seek
+	SectionUtility "sets content of annexed file"
 
 seek :: CommandSeek
 seek = withWords start

Command/RemoteDaemon.hs

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

Command/Repair.hs

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

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,9 +14,9 @@ import Git.Sha
 import qualified Git.Branch
 import Annex.AutoMerge
 
-cmd :: [Command]
-cmd = [command "resolvemerge" paramNothing seek SectionPlumbing
-	"resolve merge conflicts"]
+cmd :: Command
+cmd = command "resolvemerge" paramNothing seek SectionPlumbing
+	"resolve merge conflicts"
 
 seek :: CommandSeek
 seek = withNothing start

Command/RmUrl.hs

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

Command/Schedule.hs

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

Command/Semitrust.hs

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

Command/SendKey.hs

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

Command/SetKey.hs

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

Command/SetPresentKey.hs

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

Command/Status.hs

@@ -16,10 +16,10 @@ import qualified Git.LsFiles as LsFiles
 import qualified Git.Ref
 import qualified Git
 
-cmd :: [Command]
-cmd = [notBareRepo $ noCommit $ noMessages $ withOptions [jsonOption] $
+cmd :: Command
+cmd = notBareRepo $ noCommit $ noMessages $ withOptions [jsonOption] $
 	command "status" paramPaths seek SectionCommon
-		"show the working tree status"]
+		"show the working tree status"
 
 seek :: CommandSeek
 seek = withWords start

Command/Sync.hs

@@ -51,10 +51,10 @@ import Utility.Bloom
 import Control.Concurrent.MVar
 import qualified Data.Map as M
 
-cmd :: [Command]
-cmd = [withOptions syncOptions $
+cmd :: Command
+cmd = withOptions syncOptions $
 	command "sync" (paramOptional (paramRepeating paramRemote))
-	seek SectionCommon "synchronize local repository with remotes"]
+	seek SectionCommon "synchronize local repository with remotes"
 
 syncOptions :: [Option]
 syncOptions =

Command/Test.hs

@@ -11,10 +11,10 @@ import Common
 import Command
 import Messages
 
-cmd :: [Command]
-cmd = [ noRepo startIO $ dontCheck repoExists $
+cmd :: Command
+cmd = noRepo startIO $ dontCheck repoExists $
 	command "test" paramNothing seek SectionTesting
-		"run built-in test suite"]
+		"run built-in test suite"
 
 seek :: CommandSeek
 seek = withWords start

Command/TestRemote.hs

@@ -36,10 +36,10 @@ import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
 
-cmd :: [Command]
-cmd = [ withOptions [sizeOption] $
+cmd :: Command
+cmd = withOptions [sizeOption] $
 		command "testremote" paramRemote seek SectionTesting
-			"test transfers to/from a remote"]
+			"test transfers to/from a remote"
 
 sizeOption :: Option
 sizeOption = fieldOption [] "size" paramSize "base key size (default 1MiB)"

Command/TransferInfo.hs

@@ -15,11 +15,12 @@ import Types.Key
 import qualified CmdLine.GitAnnexShell.Fields as Fields
 import Utility.Metered
 
-cmd :: [Command]
-cmd = [noCommit $ command "transferinfo" paramKey seek SectionPlumbing
-	"updates sender on number of bytes of content received"]
+cmd :: Command
+cmd = noCommit $ command "transferinfo" paramKey SectionPlumbing
+	"updates sender on number of bytes of content received"
+	(commandParser seek)
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withWords start
 
 {- Security:

Command/TransferKey.hs

@@ -15,10 +15,10 @@ import Annex.Transfer
 import qualified Remote
 import Types.Remote
 
-cmd :: [Command]
-cmd = [withOptions transferKeyOptions $
+cmd :: Command
+cmd = withOptions transferKeyOptions $
 	noCommit $ command "transferkey" paramKey seek SectionPlumbing
-		"transfers a key from or to a remote"]
+		"transfers a key from or to a remote"
 
 transferKeyOptions :: [Option]
 transferKeyOptions = fileOption : fromToOptions

Command/TransferKeys.hs

@@ -21,9 +21,9 @@ import Git.Types (RemoteName)
 
 data TransferRequest = TransferRequest Direction Remote Key AssociatedFile
 
-cmd :: [Command]
-cmd = [command "transferkeys" paramNothing seek
-	SectionPlumbing "transfers keys"]
+cmd :: Command
+cmd = command "transferkeys" paramNothing seek
+	SectionPlumbing "transfers keys"
 
 seek :: CommandSeek
 seek = withNothing start

Command/Trust.hs

@@ -16,9 +16,9 @@ import Logs.Group
 
 import qualified Data.Set as S
 
-cmd :: [Command]
-cmd = [command "trust" (paramRepeating paramRemote) seek
-	SectionSetup "trust a repository"]
+cmd :: Command
+cmd = command "trust" (paramRepeating paramRemote) seek
+	SectionSetup "trust a repository"
 
 seek :: CommandSeek
 seek = trustCommand "trust" Trusted

Command/Unannex.hs

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

Command/Undo.hs

@@ -21,10 +21,10 @@ import qualified Git.Command as Git
 import qualified Git.Branch
 import qualified Command.Sync
 
-cmd :: [Command]
-cmd = [notBareRepo $
+cmd :: Command
+cmd = notBareRepo $
 	command "undo" paramPaths seek
-		SectionCommon "undo last change to a file or directory"]
+		SectionCommon "undo last change to a file or directory"
 
 seek :: CommandSeek
 seek ps = do

Command/Ungroup.hs

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

Command/Uninit.hs

@@ -21,9 +21,10 @@ import Utility.FileMode
 import System.IO.HVFS
 import System.IO.HVFS.Utils
 
-cmd :: [Command]
-cmd = [addCheck check $ command "uninit" paramPaths seek 
-	SectionUtility "de-initialize git-annex and clean out repository"]
+cmd :: Command
+cmd = addCheck check $ command "uninit" paramPaths
+	SectionUtility "de-initialize git-annex and clean out repository"
+	(commandParser seek)
 
 check :: Annex ()
 check = do
@@ -39,7 +40,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,13 +13,14 @@ import Annex.Content
 import Annex.CatFile
 import Utility.CopyFile
 
-cmd :: [Command]
-cmd =
-	[ c "unlock" "unlock files for modification"
-	, c "edit" "same as unlock"
-	]
-  where
-	c n = notDirect . withOptions annexedMatchingOptions 
+cmd :: Command
+cmd = mkcmd "unlock" "unlock files for modification"
+
+editcmd :: Command
+editcmd = mkcmd "edit" "same as unlock"
+
+mkcmd :: String -> String -> Command
+mkcmd n = notDirect . withOptions annexedMatchingOptions 
 	. command n paramPaths seek SectionCommon
 
 seek :: CommandSeek

Command/Untrust.hs

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

Command/Unused.hs

@@ -34,10 +34,11 @@ import Git.FilePath
 import Logs.View (is_branchView)
 import Annex.BloomFilter
 
-cmd :: [Command]
-cmd = [withOptions [unusedFromOption, refSpecOption] $
-	command "unused" paramNothing seek
-		SectionMaintenance "look for unused file content"]
+cmd :: Command
+cmd = withOptions [unusedFromOption, refSpecOption] $
+	command "unused" paramNothing
+		SectionMaintenance "look for unused file content"
+		(commandParser seek)
 
 unusedFromOption :: Option
 unusedFromOption = fieldOption ['f'] "from" paramRemote "remote to check for unused content"
@@ -45,7 +46,7 @@ unusedFromOption = fieldOption ['f'] "from" paramRemote "remote to check for unu
 refSpecOption :: Option
 refSpecOption = fieldOption [] "used-refspec" paramRefSpec "refs to consider used (default: all refs)"
 
-seek :: CommandSeek
+seek :: CmdParams -> CommandSeek
 seek = withNothing start
 
 {- Finds unused content in the annex. -} 

Command/Upgrade.hs

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

Command/VAdd.hs

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

Command/VCycle.hs

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

Command/VFilter.hs

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

Command/VPop.hs

@@ -16,10 +16,10 @@ import Types.View
 import Logs.View
 import Command.View (checkoutViewBranch)
 
-cmd :: [Command]
-cmd = [notBareRepo $ notDirect $
+cmd :: Command
+cmd = notBareRepo $ notDirect $
 	command "vpop" (paramOptional paramNumber) seek SectionMetaData
-	"switch back to previous view"]
+	"switch back to previous view"
 
 seek :: CommandSeek
 seek = withWords start

Command/Version.hs

@@ -17,10 +17,10 @@ import qualified Types.Remote as R
 import qualified Remote
 import qualified Backend
 
-cmd :: [Command]
-cmd = [withOptions [rawOption] $
+cmd :: Command
+cmd = withOptions [rawOption] $
 	noCommit $ noRepo startNoRepo $ dontCheck repoExists $
-	command "version" paramNothing seek SectionQuery "show version info"]
+	command "version" paramNothing seek SectionQuery "show version info"
 
 rawOption :: Option
 rawOption = flagOption [] "raw" "output only program version"

Command/Vicfg.hs

@@ -29,9 +29,9 @@ import Types.StandardGroups
 import Types.ScheduledActivity
 import Remote
 
-cmd :: [Command]
-cmd = [command "vicfg" paramNothing seek
-	SectionSetup "edit git-annex's configuration"]
+cmd :: Command
+cmd = command "vicfg" paramNothing seek
+	SectionSetup "edit git-annex's configuration"
 
 seek :: CommandSeek
 seek = withNothing start

Command/View.hs

@@ -17,9 +17,9 @@ import Types.View
 import Annex.View
 import Logs.View
 
-cmd :: [Command]
-cmd = [notBareRepo $ notDirect $
-	command "view" paramView seek SectionMetaData "enter a view branch"]
+cmd :: Command
+cmd = notBareRepo $ notDirect $
+	command "view" paramView seek SectionMetaData "enter a view branch"
 
 seek :: CommandSeek
 seek = withWords start

Command/Wanted.hs

@@ -17,7 +17,7 @@ import Types.StandardGroups
 
 import qualified Data.Map as M
 
-cmd :: [Command]
+cmd :: Command
 cmd = cmd' "wanted" "get or set preferred content expression" 
 	preferredContentMapRaw
 	preferredContentSet
@@ -27,8 +27,8 @@ cmd'
 	-> String
 	-> Annex (M.Map UUID PreferredContentExpression)
 	-> (UUID -> PreferredContentExpression -> Annex ())
-	-> [Command]
-cmd' name desc getter setter = [command name pdesc seek SectionSetup desc]
+	-> Command
+cmd' name desc getter setter = command name pdesc seek SectionSetup desc
   where
 	pdesc = paramPair paramRemote (paramOptional paramExpression)
 

Command/Watch.hs

@@ -12,9 +12,9 @@ import Assistant
 import Command
 import Utility.HumanTime
 
-cmd :: [Command]
-cmd = [notBareRepo $ withOptions [foregroundOption, stopOption] $ 
-	command "watch" paramNothing seek SectionCommon "watch for changes and autocommit"]
+cmd :: Command
+cmd = notBareRepo $ withOptions [foregroundOption, stopOption] $ 
+	command "watch" paramNothing seek SectionCommon "watch for changes and autocommit"
 
 seek :: CommandSeek
 seek ps = do

Command/WebApp.hs

@@ -37,10 +37,10 @@ import Control.Concurrent.STM
 import Network.Socket (HostName)
 import System.Environment (getArgs)
 
-cmd :: [Command]
-cmd = [ withOptions [listenOption] $
+cmd :: Command
+cmd = withOptions [listenOption] $
 	noCommit $ noRepo startNoRepo $ dontCheck repoExists $ notBareRepo $
-	command "webapp" paramNothing seek SectionCommon "launch webapp"]
+	command "webapp" paramNothing seek SectionCommon "launch webapp"
 
 listenOption :: Option
 listenOption = fieldOption [] "listen" paramAddress