add git-annex-shell command

This is not yet complete, as it does not allow starting rsync or scp.

CmdLine.hs

@@ -6,14 +6,13 @@
  -}
 
 module CmdLine (
-	cmdLine,
+	dispatch,
 	parseCmd,
 	Option,
 	storeOptBool,
 	storeOptString,
 ) where
 
-import System.Environment
 import System.Console.GetOpt
 import Control.Monad (when)
 import Control.Monad.State (liftIO)
@@ -25,21 +24,11 @@ import Command
 import BackendList
 import Core
 import Upgrade
+import Options
 
-{- Each dashed command-line option results in generation of an action
- - in the Annex monad that performs the necessary setting.
- -}
-type Option = OptDescr (Annex ())
-
-storeOptBool :: FlagName -> Bool -> Annex ()
-storeOptBool name val = Annex.flagChange name $ FlagBool val
-storeOptString :: FlagName -> String -> Annex ()
-storeOptString name val = Annex.flagChange name $ FlagString val
-
-{- It all starts here. -}
-cmdLine :: [Command] -> [Option] -> String -> IO ()
-cmdLine cmds options header = do
-	args <- getArgs
+{- Runs the passed command line. -}
+dispatch :: [String] -> [Command] -> [Option] -> String -> IO ()
+dispatch args cmds options header = do
 	gitrepo <- Git.repoFromCwd
 	state <- Annex.new gitrepo allBackends
 	(actions, state') <- Annex.run state $ parseCmd args header cmds options
@@ -50,24 +39,27 @@ cmdLine cmds options header = do
 parseCmd :: [String] -> String -> [Command] -> [Option] -> Annex [Annex Bool]
 parseCmd argv header cmds options = do
 	(flags, params) <- liftIO $ getopt
-	when (null params) $ error usagemsg
+	when (null params) $ error $ "missing command" ++ usagemsg
 	case lookupCmd (head params) of
-		[] -> error usagemsg
+		[] -> error $ "unknown command" ++ usagemsg
 		[command] -> do
 			_ <- sequence flags
 			prepCmd command (drop 1 params)
 		_ -> error "internal error: multiple matching commands"
 	where
 		getopt = case getOpt Permute options argv of
-			(flags, params, []) -> return (flags, params)
-			(_, _, errs) -> ioError (userError (concat errs ++ usagemsg))
+			(flags, params, []) ->
+				return (flags, params)
+			(_, _, errs) ->
+				ioError (userError (concat errs ++ usagemsg))
 		lookupCmd cmd = filter (\c -> cmd  == cmdname c) cmds
-		usagemsg = usage header cmds options
+		usagemsg = "\n\n" ++ 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
+	usageInfo (header ++ "\n\nOptions:") options ++
+		"\nCommands:\n" ++ cmddescs
 	where
 		cmddescs = unlines $ map (indent . showcmd) cmds
 		showcmd c =