wip

Current status:

* building again, but several commands are commented out
* still need to implement global options, file matching options, etc

3 files changed, 64 insertions, 63 deletions

diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs
index c42ba2a2d..2e9bc537f 100644
--- a/CmdLine/GitAnnex.hs
+++ b/CmdLine/GitAnnex.hs
@@ -15,7 +15,7 @@ import Command
 import Utility.Env
 import Annex.Ssh
 
-import qualified Command.Help
+--import qualified Command.Help
 import qualified Command.Add
 import qualified Command.Unannex
 import qualified Command.Drop
@@ -25,7 +25,7 @@ import qualified Command.Get
 import qualified Command.Fsck
 import qualified Command.LookupKey
 import qualified Command.ContentLocation
-import qualified Command.ExamineKey
+--import qualified Command.ExamineKey
 import qualified Command.FromKey
 import qualified Command.RegisterUrl
 import qualified Command.SetKey
@@ -56,15 +56,15 @@ import qualified Command.AddUnused
 import qualified Command.Unlock
 import qualified Command.Lock
 import qualified Command.PreCommit
-import qualified Command.Find
-import qualified Command.FindRef
-import qualified Command.Whereis
+--import qualified Command.Find
+--import qualified Command.FindRef
+--import qualified Command.Whereis
 --import qualified Command.List
 import qualified Command.Log
 import qualified Command.Merge
 import qualified Command.ResolveMerge
-import qualified Command.Info
-import qualified Command.Status
+--import qualified Command.Info
+--import qualified Command.Status
 import qualified Command.Migrate
 import qualified Command.Uninit
 import qualified Command.Reinit
@@ -95,7 +95,7 @@ import qualified Command.Upgrade
 import qualified Command.Forget
 import qualified Command.Proxy
 import qualified Command.DiffDriver
-import qualified Command.Undo
+--import qualified Command.Undo
 import qualified Command.Version
 #ifdef WITH_ASSISTANT
 import qualified Command.Watch
@@ -119,8 +119,8 @@ import System.Remote.Monitoring
 
 cmds :: [Command]
 cmds = 
-	[ Command.Help.cmd
-	, Command.Add.cmd
+--	[ Command.Help.cmd
+	[ Command.Add.cmd
 	, Command.Get.cmd
 	, Command.Drop.cmd
 	, Command.Move.cmd
@@ -160,7 +160,7 @@ cmds =
 --	, Command.Vicfg.cmd
 	, Command.LookupKey.cmd
 	, Command.ContentLocation.cmd
-	, Command.ExamineKey.cmd
+--	, Command.ExamineKey.cmd
 	, Command.FromKey.cmd
 	, Command.RegisterUrl.cmd
 	, Command.SetKey.cmd
@@ -183,15 +183,15 @@ cmds =
 --	, Command.Unused.cmd
 --	, Command.DropUnused.cmd
 	, Command.AddUnused.cmd
-	, Command.Find.cmd
-	, Command.FindRef.cmd
-	, Command.Whereis.cmd
+--	, Command.Find.cmd
+--	, Command.FindRef.cmd
+--	, Command.Whereis.cmd
 --	, Command.List.cmd
 	, Command.Log.cmd
 	, Command.Merge.cmd
 	, Command.ResolveMerge.cmd
-	, Command.Info.cmd
-	, Command.Status.cmd
+--	, Command.Info.cmd
+--	, Command.Status.cmd
 	, Command.Migrate.cmd
 	, Command.Map.cmd
 	, Command.Direct.cmd
@@ -200,7 +200,7 @@ cmds =
 	, Command.Forget.cmd
 	, Command.Proxy.cmd
 	, Command.DiffDriver.cmd
-	, Command.Undo.cmd
+--	, Command.Undo.cmd
 	, Command.Version.cmd
 #ifdef WITH_ASSISTANT
 	, Command.Watch.cmd
diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs
index c027c602c..4ec7bc875 100644
--- a/CmdLine/GitAnnex/Options.hs
+++ b/CmdLine/GitAnnex/Options.hs
@@ -99,11 +99,7 @@ parseKeyOptions allowincomplete = if allowincomplete
 			)
 	else base
   where
-	base =
-		flag' WantAllKeys
-			( long "all" <> short 'A'
-			<> help "operate on all versions of all files"
-			)
+	base = parseAllOption
 		<|> flag' WantUnusedKeys
 			( long "unused" <> short 'U'
 			<> help "operate on files found by last run of git-annex unused"
@@ -113,6 +109,12 @@ parseKeyOptions allowincomplete = if allowincomplete
 			<> 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
 
@@ -121,13 +123,13 @@ annexedMatchingOptions :: [Option]
 annexedMatchingOptions = concat
 	[ nonWorkTreeMatchingOptions'
 	, fileMatchingOptions'
-	, combiningOptions
-	, [timeLimitOption]
+	-- , combiningOptions
+	-- , [timeLimitOption]
 	]
 
 -- Matching options that don't need to examine work tree files.
 nonWorkTreeMatchingOptions :: [Option]
-nonWorkTreeMatchingOptions = nonWorkTreeMatchingOptions' ++ combiningOptions
+nonWorkTreeMatchingOptions = nonWorkTreeMatchingOptions' -- ++ combiningOptions
 
 nonWorkTreeMatchingOptions' :: [Option]
 nonWorkTreeMatchingOptions' = 
@@ -153,7 +155,7 @@ nonWorkTreeMatchingOptions' =
 
 -- Options to match files which may not yet be annexed.
 fileMatchingOptions :: [Option]
-fileMatchingOptions = fileMatchingOptions' ++ combiningOptions
+fileMatchingOptions = fileMatchingOptions' -- ++ combiningOptions
 
 fileMatchingOptions' :: [Option]
 fileMatchingOptions' =
@@ -167,37 +169,37 @@ fileMatchingOptions' =
 		"match files smaller than a size"
 	]
 
-combiningOptions :: [Option]
-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 ")" "close group of options"
-	]
-  where
-	longopt o = Option [] [o] $ NoArg $ Limit.addToken o
-	shortopt o = Option o [] $ NoArg $ Limit.addToken o
-
-jsonOption :: Option
-jsonOption = Option ['j'] ["json"] (NoArg (Annex.setOutput JSONOutput))
-	"enable JSON output"
-
-jobsOption :: Option
-jobsOption = Option ['J'] ["jobs"] (ReqArg set paramNumber)
-	"enable concurrent jobs"
+parseCombiningOptions :: Parser [GlobalSetter]
+parseCombiningOptions = 
+	many $ 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 ')' "close group of options"
   where
-	set s = case readish s of
-		Nothing -> error "Bad --jobs number"
-		Just n -> Annex.setOutput (ParallelOutput n)
-
-timeLimitOption :: Option
-timeLimitOption = Option ['T'] ["time-limit"]
-	(ReqArg Limit.addTimeLimit paramTime)
-	"stop after the specified amount of time"
+	longopt o h = globalOpt (Limit.addToken o) $ switch
+		( long o <> help h )
+	shortopt o h = globalOpt (Limit.addToken [o]) $ switch
+		( short o <> help h)
+
+parseJsonOption :: Parser GlobalSetter
+parseJsonOption = globalOpt (Annex.setOutput JSONOutput) $ switch
+	( long "json" <> short 'j'
+	<> help "enable JSON output"
+	)
 
-autoOption :: Option
-autoOption = flagOption ['a'] "auto" "automatic mode"
+parseJobsOption :: Parser GlobalSetter
+parseJobsOption = globalSetter (Annex.setOutput . ParallelOutput) $ 
+	option auto
+		( long "jobs" <> short 'J' <> metavar paramNumber
+		<> help "enable concurrent jobs"
+		)
+
+parseTimeLimitOption :: Parser GlobalSetter
+parseTimeLimitOption = globalSetter Limit.addTimeLimit $ strOption
+	( long "time-limit" <> short 'T' <> metavar paramTime
+	<> help "stop after the specified amount of time"
+	)
 
 parseAutoOption :: Parser Bool
 parseAutoOption = switch
diff --git a/CmdLine/GitAnnexShell.hs b/CmdLine/GitAnnexShell.hs
index bda4f7907..386780add 100644
--- a/CmdLine/GitAnnexShell.hs
+++ b/CmdLine/GitAnnexShell.hs
@@ -73,9 +73,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
@@ -142,14 +139,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)
-	| field == fieldName remoteUUID = fieldCheck remoteUUID value
-	| field == fieldName associatedFile = fieldCheck associatedFile value
-	| field == fieldName direct = fieldCheck direct value
+checkField (field, val)
+	| field == fieldName remoteUUID = fieldCheck remoteUUID val
+	| field == fieldName associatedFile = fieldCheck associatedFile val
+	| 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"