refactor in preparation for adding a git-annex-shell command

24 files changed, 202 insertions, 134 deletions

diff --git a/CmdLine.hs b/CmdLine.hs
index 40ce4b121..54c2289c6 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -1,11 +1,16 @@
-{- git-annex command line
+{- git-annex command line parsing
  -
  - Copyright 2010 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module CmdLine (parseCmd) where
+module CmdLine (
+	parseCmd,
+	Option,
+	storeOptBool,
+	storeOptString,
+) where
 
 import System.Console.GetOpt
 import Control.Monad (when)
@@ -13,135 +18,26 @@ import Control.Monad.State (liftIO)
 
 import qualified Annex
 import Types
-
 import Command
-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.FromKey
-import qualified Command.DropKey
-import qualified Command.SetKey
-import qualified Command.Fix
-import qualified Command.Init
-import qualified Command.Fsck
-import qualified Command.Unused
-import qualified Command.DropUnused
-import qualified Command.Unlock
-import qualified Command.Lock
-import qualified Command.PreCommit
-import qualified Command.Find
-import qualified Command.Uninit
-import qualified Command.Trust
-import qualified Command.Untrust
-
-cmds :: [Command]
-cmds =
-	[ Command.Add.command
-	, Command "get" path		Command.Get.seek
-		"make content of annexed files available"
-	, Command "drop" path	Command.Drop.seek
-		"indicate content of files not currently wanted"
-	, Command "move" path	Command.Move.seek
-		"move content of files to/from another repository"
-	, Command "copy" path	Command.Copy.seek
-		"copy content of files to/from another repository"
-	, Command "unlock" path	Command.Unlock.seek
-		"unlock files for modification"
-	, Command "edit" path	Command.Unlock.seek
-		"same as unlock"
-	, Command "lock" path	Command.Lock.seek
-		"undo unlock command"
-	, Command "init" desc	Command.Init.seek
-		"initialize git-annex with repository description"
-	, Command "unannex" path	Command.Unannex.seek
-		"undo accidential add command"
-	, Command "uninit" path	Command.Uninit.seek
-		"de-initialize git-annex and clean out repository"
-	, Command "pre-commit" path	Command.PreCommit.seek
-		"run by git pre-commit hook"
-	, Command "trust" remote	Command.Trust.seek
-		"trust a repository"
-	, Command "untrust" remote	Command.Untrust.seek
-		"do not trust a repository"
-	, Command "fromkey" key	Command.FromKey.seek
-		"adds a file using a specific key"
-	, Command "dropkey"	key	Command.DropKey.seek
-		"drops annexed content for specified keys"
-	, Command "setkey" key	Command.SetKey.seek
-		"sets annexed content for a key using a temp file"
-	, Command "fix" path		Command.Fix.seek
-		"fix up symlinks to point to annexed content"
-	, Command "fsck" maybepath	Command.Fsck.seek
-		"check for problems"
-	, Command "unused" nothing	Command.Unused.seek
-		"look for unused file content"
-	, Command "dropunused" number Command.DropUnused.seek
-		"drop unused file content"
-	, Command "find" maybepath	Command.Find.seek
-		"lists available files"
-	]
-	where
-		path = "PATH ..."
-		maybepath = "[PATH ...]"
-		key = "KEY ..."
-		desc = "DESCRIPTION"
-		number = "NUMBER ..."
-		remote = "REMOTE ..."
-		nothing = ""
 
--- Each dashed command-line option results in generation of an action
--- in the Annex monad that performs the necessary setting.
-options :: [OptDescr (Annex ())]
-options = [
-	    Option ['f'] ["force"] (NoArg (storebool "force" True))
-		"allow actions that may lose annexed data"
-	  , Option ['q'] ["quiet"] (NoArg (storebool "quiet" True))
-		"avoid verbose output"
-	  , Option ['v'] ["verbose"] (NoArg (storebool "quiet" False))
-		"allow verbose output"
-	  , Option ['b'] ["backend"] (ReqArg (storestring "backend") "NAME")
-		"specify default key-value backend to use"
-	  , Option ['k'] ["key"] (ReqArg (storestring "key") "KEY")
-		"specify a key to use"
-	  , Option ['t'] ["to"] (ReqArg (storestring "torepository") "REPOSITORY")
-		"specify to where to transfer content"
-	  , Option ['f'] ["from"] (ReqArg (storestring "fromrepository") "REPOSITORY")
-		"specify from where to transfer content"
-	  , Option ['x'] ["exclude"] (ReqArg (storestring "exclude") "GLOB")
-		"skip files matching the glob pattern"
-	  ]
-	where
-		storebool n b = Annex.flagChange n $ FlagBool b
-		storestring n s = Annex.flagChange n $ FlagString s
+{- Each dashed command-line option results in generation of an action
+ - in the Annex monad that performs the necessary setting.
+ -}
+type Option = OptDescr (Annex ())
 
-header :: String
-header = "Usage: git-annex subcommand [option ..]"
-
-{- Usage message with lists of options and subcommands. -}
-usage :: String
-usage = usageInfo header options ++ "\nSubcommands:\n" ++ cmddescs
-	where
-		cmddescs = unlines $ map (indent . showcmd) cmds
-		showcmd c =
-			cmdname c ++
-			pad 11 (cmdname c) ++
-			cmdparams c ++
-			pad 13 (cmdparams c) ++
-			cmddesc c
-		indent l = "  " ++ l
-		pad n s = replicate (n - length s) ' '
+storeOptBool :: FlagName -> Bool -> Annex ()
+storeOptBool name val = Annex.flagChange name $ FlagBool val
+storeOptString :: FlagName -> String -> Annex ()
+storeOptString name val = Annex.flagChange name $ FlagString val
 
 {- Parses command line, stores configure flags, and returns a 
  - list of actions to be run in the Annex monad. -}
-parseCmd :: [String] -> Annex [Annex Bool]
-parseCmd argv = do
+parseCmd :: [String] -> String -> [Command] -> [Option] -> Annex [Annex Bool]
+parseCmd argv header cmds options = do
 	(flags, params) <- liftIO $ getopt
-	when (null params) $ error usage
+	when (null params) $ error usagemsg
 	case lookupCmd (head params) of
-		[] -> error usage
+		[] -> error usagemsg
 		[command] -> do
 			_ <- sequence flags
 			prepCmd command (drop 1 params)
@@ -149,5 +45,21 @@ parseCmd argv = do
 	where
 		getopt = case getOpt Permute options argv of
 			(flags, params, []) -> return (flags, params)
-			(_, _, errs) -> ioError (userError (concat errs ++ usage))
+			(_, _, errs) -> ioError (userError (concat errs ++ usagemsg))
 		lookupCmd cmd = filter (\c -> cmd  == cmdname c) cmds
+		usagemsg = usage header cmds options
+
+{- Usage message with lists of commands and options. -}
+usage :: String -> [Command] -> [Option] -> String
+usage header cmds options =
+	usageInfo header options ++ "\nSubcommands:\n" ++ cmddescs
+	where
+		cmddescs = unlines $ map (indent . showcmd) cmds
+		showcmd c =
+			cmdname c ++
+			pad 11 (cmdname c) ++
+			cmdparams c ++
+			pad 13 (cmdparams c) ++
+			cmddesc c
+		indent l = "  " ++ l
+		pad n s = replicate (n - length s) ' '
diff --git a/Command.hs b/Command.hs
index 2144da353..690dd20ec 100644
--- a/Command.hs
+++ b/Command.hs
@@ -205,18 +205,24 @@ notSymlink f = do
 	s <- liftIO $ getSymbolicLinkStatus f
 	return $ not $ isSymbolicLink s
 
-{- descriptions of params used in usage message -}
+{- Descriptions of params used in usage messages. -}
+paramRepeating :: String -> String
+paramRepeating s = s ++ " ..."
+paramOptional :: String -> String
+paramOptional s = "[" ++ s ++ "]"
 paramPath :: String
-paramPath = "PATH ..."
-paramMaybePath :: String
-paramMaybePath = "[PATH ...]"
+paramPath = "PATH"
 paramKey :: String
-paramKey = "KEY ..."
+paramKey = "KEY"
 paramDesc :: String
 paramDesc = "DESCRIPTION"
 paramNumber :: String
-paramNumber = "NUMBER ..."
+paramNumber = "NUMBER"
 paramRemote :: String
-paramRemote = "REMOTE ..."
+paramRemote = "REMOTE"
+paramGlob :: String
+paramGlob = "GLOB"
+paramName :: String
+paramName = "NAME"
 paramNothing :: String
 paramNothing = ""
diff --git a/Command/Add.hs b/Command/Add.hs
index 08a880206..bc869a67d 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -18,8 +18,8 @@ import Types
 import Core
 import Messages
 
-command :: Command
-command = Command "add" paramPath seek "add files to annex"
+command :: [Command]
+command = [Command "add" paramPath seek "add files to annex"]
 
 {- Add acts on both files not checked into git yet, and unlocked files. -}
 seek :: [CommandSeek]
diff --git a/Command/Copy.hs b/Command/Copy.hs
index 873df7ef2..93342e11b 100644
--- a/Command/Copy.hs
+++ b/Command/Copy.hs
@@ -10,6 +10,10 @@ module Command.Copy where
 import Command
 import qualified Command.Move
 
+command :: [Command]
+command = [Command "copy" paramPath seek
+	"copy content of files to/from another repository"]
+
 -- A copy is just a move that does not delete the source file.
 seek :: [CommandSeek]
 seek = [withFilesInGit $ Command.Move.start False]
diff --git a/Command/Drop.hs b/Command/Drop.hs
index 3f2740570..a425c6138 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -17,6 +17,10 @@ import Core
 import Messages
 import Utility
 
+command :: [Command]
+command = [Command "drop" paramPath seek
+	"indicate content of files not currently wanted"]
+
 seek :: [CommandSeek]
 seek = [withAttrFilesInGit "annex.numcopies" start]
 
diff --git a/Command/DropKey.hs b/Command/DropKey.hs
index 870e9a7ab..29056139d 100644
--- a/Command/DropKey.hs
+++ b/Command/DropKey.hs
@@ -15,6 +15,10 @@ import Types
 import Core
 import Messages
 
+command :: [Command]
+command = [Command "dropkey" (paramRepeating paramKey) seek
+	"drops annexed content for specified keys"] 
+
 seek :: [CommandSeek]
 seek = [withKeys start]
 
diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs
index 9984e49f3..ea2ff46eb 100644
--- a/Command/DropUnused.hs
+++ b/Command/DropUnused.hs
@@ -18,6 +18,10 @@ import qualified Annex
 import qualified Command.Drop
 import Backend
 
+command :: [Command]
+command = [Command "dropunused" (paramRepeating paramNumber) seek
+	"drop unused file content"]
+
 seek :: [CommandSeek]
 seek = [withStrings start]
 
diff --git a/Command/Find.hs b/Command/Find.hs
index 9927b692d..7cb781ce8 100644
--- a/Command/Find.hs
+++ b/Command/Find.hs
@@ -13,6 +13,10 @@ import Control.Monad.State (liftIO)
 import Command
 import Core
 
+command :: [Command]
+command = [Command "find" (paramOptional $ paramRepeating paramPath) seek
+	"lists available files"]
+
 seek :: [CommandSeek]
 seek = [withDefault "." withFilesInGit start]
 
diff --git a/Command/Fix.hs b/Command/Fix.hs
index accdadd31..8b08a26f6 100644
--- a/Command/Fix.hs
+++ b/Command/Fix.hs
@@ -17,6 +17,10 @@ import Utility
 import Core
 import Messages
 
+command :: [Command]
+command = [Command "fix" paramPath seek
+	"fix up symlinks to point to annexed content"]
+
 seek :: [CommandSeek]
 seek = [withFilesInGit start]
 
diff --git a/Command/FromKey.hs b/Command/FromKey.hs
index 991428136..f1cb717fa 100644
--- a/Command/FromKey.hs
+++ b/Command/FromKey.hs
@@ -20,6 +20,10 @@ import Types
 import Core
 import Messages
 
+command :: [Command]
+command = [Command "fromkey" (paramRepeating paramKey) seek
+	"adds a file using a specific key"]
+
 seek :: [CommandSeek]
 seek = [withFilesMissing start]
 
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 034bdc388..d870bd419 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -13,6 +13,10 @@ import Types
 import Messages
 import Utility
 
+command :: [Command]
+command = [Command "fsck" (paramOptional $ paramRepeating paramPath) seek
+	"check for problems"]
+
 seek :: [CommandSeek]
 seek = [withAll (withAttrFilesInGit "annex.numcopies") start]
 
diff --git a/Command/Get.hs b/Command/Get.hs
index 214b689b8..e3668649e 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -13,6 +13,10 @@ import Types
 import Core
 import Messages
 
+command :: [Command]
+command = [Command "get" paramPath seek
+		"make content of annexed files available"]
+
 seek :: [CommandSeek]
 seek = [withFilesInGit start]
 
diff --git a/Command/Init.hs b/Command/Init.hs
index 806c34c98..8ad9f79d7 100644
--- a/Command/Init.hs
+++ b/Command/Init.hs
@@ -19,6 +19,10 @@ import Version
 import Messages
 import Locations
 import Types
+	
+command :: [Command]
+command = [Command "init" paramDesc seek
+		"initialize git-annex with repository description"]
 
 seek :: [CommandSeek]
 seek = [withString start]
diff --git a/Command/Lock.hs b/Command/Lock.hs
index 381162536..00a553e95 100644
--- a/Command/Lock.hs
+++ b/Command/Lock.hs
@@ -14,6 +14,9 @@ import Command
 import Messages
 import qualified Annex
 import qualified GitRepo as Git
+	
+command :: [Command]
+command = [Command "lock" paramPath seek "undo unlock command"]
 
 seek :: [CommandSeek]
 seek = [withFilesUnlocked start]
diff --git a/Command/Move.hs b/Command/Move.hs
index 8ba8dbfac..addeeae8a 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -20,6 +20,10 @@ import qualified GitRepo as Git
 import qualified Remotes
 import UUID
 import Messages
+	
+command :: [Command]
+command = [Command "move" paramPath seek
+	"move content of files to/from another repository"]
 
 seek :: [CommandSeek]
 seek = [withFilesInGit $ start True]
diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs
index 8d488514a..12e5ed806 100644
--- a/Command/PreCommit.hs
+++ b/Command/PreCommit.hs
@@ -15,6 +15,9 @@ import qualified GitRepo as Git
 import qualified Command.Add
 import qualified Command.Fix
 
+command :: [Command]
+command = [Command "pre-commit" paramPath seek "run by git pre-commit hook"]
+
 {- The pre-commit hook needs to fix symlinks to all files being committed.
  - And, it needs to inject unlocked files into the annex. -}
 seek :: [CommandSeek]
diff --git a/Command/SetKey.hs b/Command/SetKey.hs
index 4c82de3a5..5048d052f 100644
--- a/Command/SetKey.hs
+++ b/Command/SetKey.hs
@@ -19,6 +19,10 @@ import Types
 import Core
 import Messages
 
+command :: [Command]
+command = [Command "setkey" (paramRepeating paramKey) seek
+	"sets annexed content for a key using a temp file"]
+
 seek :: [CommandSeek]
 seek = [withTempFile start]
 
diff --git a/Command/Trust.hs b/Command/Trust.hs
index 3c3ec3b7e..35ddefe84 100644
--- a/Command/Trust.hs
+++ b/Command/Trust.hs
@@ -17,6 +17,10 @@ import qualified Remotes
 import UUID
 import Messages
 
+command :: [Command]
+command = [Command "trust" (paramRepeating paramRemote) seek
+	"trust a repository"]
+
 seek :: [CommandSeek]
 seek = [withString start]
 
diff --git a/Command/Unannex.hs b/Command/Unannex.hs
index 42354b8c4..288f9da44 100644
--- a/Command/Unannex.hs
+++ b/Command/Unannex.hs
@@ -20,6 +20,9 @@ import Core
 import qualified GitRepo as Git
 import Messages
 
+command :: [Command]
+command = [Command "unannex" paramPath seek "undo accidential add command"]
+
 seek :: [CommandSeek]
 seek = [withFilesInGit start]
 
diff --git a/Command/Uninit.hs b/Command/Uninit.hs
index 6001c55cd..1a4e9b0d7 100644
--- a/Command/Uninit.hs
+++ b/Command/Uninit.hs
@@ -20,6 +20,10 @@ import qualified Annex
 import qualified Command.Unannex
 import qualified Command.Init
 
+command :: [Command]
+command = [Command "uninit" paramPath seek 
+        "de-initialize git-annex and clean out repository"]
+
 seek :: [CommandSeek]
 seek = [withAll withFilesInGit Command.Unannex.start, withNothing start]
 
diff --git a/Command/Unlock.hs b/Command/Unlock.hs
index 21f34d1db..0e55585ae 100644
--- a/Command/Unlock.hs
+++ b/Command/Unlock.hs
@@ -18,6 +18,12 @@ import Locations
 import Core
 import CopyFile
 
+command :: [Command]
+command =
+	[ Command "unlock" paramPath seek "unlock files for modification"
+	, Command "edit" paramPath seek "same as unlock"
+	]
+
 seek :: [CommandSeek]
 seek = [withFilesInGit start]
 
diff --git a/Command/Untrust.hs b/Command/Untrust.hs
index 6458040b3..f49a2e989 100644
--- a/Command/Untrust.hs
+++ b/Command/Untrust.hs
@@ -17,6 +17,10 @@ import qualified Remotes
 import UUID
 import Messages
 
+command :: [Command]
+command = [Command "untrust" (paramRepeating paramRemote) seek
+	"do not trust a repository"]
+
 seek :: [CommandSeek]
 seek = [withString start]
 
diff --git a/Command/Unused.hs b/Command/Unused.hs
index dba9aa517..d2dfc9aa3 100644
--- a/Command/Unused.hs
+++ b/Command/Unused.hs
@@ -17,6 +17,9 @@ import Messages
 import Locations
 import qualified Annex
 
+command :: [Command]
+command = [Command "unused" paramNothing seek "look for unused file content"]
+
 seek :: [CommandSeek]
 seek = [withNothing start]
 
diff --git a/git-annex.hs b/git-annex.hs
index 1173ab913..31d90e4fc 100644
--- a/git-annex.hs
+++ b/git-annex.hs
@@ -6,6 +6,7 @@
  -}
 
 import System.Environment
+import System.Console.GetOpt
 
 import qualified Annex
 import Core
@@ -14,10 +15,81 @@ import CmdLine
 import qualified GitRepo as Git
 import BackendList
 
+import Command
+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.FromKey
+import qualified Command.DropKey
+import qualified Command.SetKey
+import qualified Command.Fix
+import qualified Command.Init
+import qualified Command.Fsck
+import qualified Command.Unused
+import qualified Command.DropUnused
+import qualified Command.Unlock
+import qualified Command.Lock
+import qualified Command.PreCommit
+import qualified Command.Find
+import qualified Command.Uninit
+import qualified Command.Trust
+import qualified Command.Untrust
+
+cmds :: [Command]
+cmds = concat
+	[ Command.Add.command
+	, Command.Get.command
+	, Command.Drop.command
+	, Command.Move.command
+	, Command.Copy.command
+	, Command.Unlock.command
+	, Command.Lock.command
+	, Command.Init.command
+	, Command.Unannex.command
+	, Command.Uninit.command
+	, Command.PreCommit.command
+	, Command.Trust.command
+	, Command.Untrust.command
+	, Command.FromKey.command
+	, Command.DropKey.command
+	, Command.SetKey.command
+	, Command.Fix.command
+	, Command.Fsck.command
+	, Command.Unused.command
+	, Command.DropUnused.command
+	, Command.Find.command
+	]
+
+options :: [Option]
+options = [
+	    Option ['f'] ["force"] (NoArg (storeOptBool "force" True))
+		"allow actions that may lose annexed data"
+	  , Option ['q'] ["quiet"] (NoArg (storeOptBool "quiet" True))
+		"avoid verbose output"
+	  , Option ['v'] ["verbose"] (NoArg (storeOptBool "quiet" False))
+		"allow verbose output"
+	  , Option ['b'] ["backend"] (ReqArg (storeOptString "backend") paramName)
+		"specify default key-value backend to use"
+	  , Option ['k'] ["key"] (ReqArg (storeOptString "key") paramKey)
+		"specify a key to use"
+	  , Option ['t'] ["to"] (ReqArg (storeOptString "torepository") paramRemote)
+		"specify to where to transfer content"
+	  , Option ['f'] ["from"] (ReqArg (storeOptString "fromrepository") paramRemote)
+		"specify from where to transfer content"
+	  , Option ['x'] ["exclude"] (ReqArg (storeOptString "exclude") paramGlob)
+		"skip files matching the glob pattern"
+	  ]
+
+header :: String
+header = "Usage: git-annex subcommand [option ..]"
+
 main :: IO ()
 main = do
 	args <- getArgs
 	gitrepo <- Git.repoFromCwd
 	state <- Annex.new gitrepo allBackends
-	(actions, state') <- Annex.run state $ parseCmd args
+	(actions, state') <- Annex.run state $ parseCmd args header cmds options
 	tryRun state' $ [startup, upgrade] ++ actions