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.

4 files changed, 33 insertions, 31 deletions

diff --git a/CmdLine/Action.hs b/CmdLine/Action.hs
index 2838e4ff8..15064fe42 100644
--- a/CmdLine/Action.hs
+++ b/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
diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs
index 354f451e7..5619129f5 100644
--- a/CmdLine/GitAnnex.hs
+++ b/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
diff --git a/CmdLine/GitAnnexShell.hs b/CmdLine/GitAnnexShell.hs
index adf6da04e..fca37790b 100644
--- a/CmdLine/GitAnnexShell.hs
+++ b/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."
diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs
index 47e2c79bc..66f57e1b0 100644
--- a/CmdLine/Seek.hs
+++ b/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"