git-annex-shell mostly done now, only needs 2 more subcommands

1 files changed, 46 insertions, 26 deletions

diff --git a/git-annex-shell.hs b/git-annex-shell.hs
index 7adb5e790..492d18446 100644
--- a/git-annex-shell.hs
+++ b/git-annex-shell.hs
@@ -5,48 +5,68 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-import System.Console.GetOpt
 import System.Environment
 import Control.Monad (when)
 
+import qualified GitRepo as Git
 import CmdLine
 import Command
 import Utility
 import Options
 
-import qualified Command.FromKey
+import qualified Command.ConfigList
+import qualified Command.InAnnex
 import qualified Command.DropKey
-import qualified Command.SetKey
+--import qualified Command.RecvKey
+--import qualified Command.SendKey
 
 cmds :: [Command]
-cmds = concat
-	[ Command.FromKey.command
+cmds = map adddirparam $ concat
+	[ Command.ConfigList.command
+	, Command.InAnnex.command
 	, Command.DropKey.command
-	, Command.SetKey.command
+--	, Command.RecvKey.command
+--	, Command.SendKey.command
 	]
-
-options :: [Option]
-options = [ Option ['c'] ["command"] (NoArg (storeOptBool "command" True))
-		"ignored for compatability with git-shell"
-	  ] ++ commonOptions
+	where
+		adddirparam c = c { cmdparams = "DIRECTORY " ++ cmdparams c }
 
 header :: String
-header = "Usage:\n" ++
-	"\tgit-annex-shell -c git-annex command [option ..]\n" ++
-	"\tgit-annex-shell -c shellcommand argument"
+header = "Usage: git-annex-shell [-c] command [option ..]"
 
 main :: IO ()
 main = do
 	args <- getArgs
-	-- dispatch git-annex commands to builtin versions,
-	-- and pass everything else to git-shell
-	case args of
-		("git-annex":as) -> builtin as
-		[] -> builtin []
-		_ -> external args
-	where
-		builtin l = dispatch l cmds options header
-		external l = do
-			ret <- boolSystem "git-shell" l
-			when (not ret) $
-				error "git-shell failed"
+	main' args
+
+main' :: [String] -> IO ()
+main' [] = failure
+-- skip leading -c options, passed by eg, ssh
+main' ("-c":p) = main' p
+-- Since git-annex explicitly runs git-annex-shell, we will be passed 
+-- a redundant "git-annex-shell" parameter when we're the user's login shell.
+main' ("git-annex-shell":p) = main' p
+-- a command can be either a builtin or something to pass to git-shell
+main' c@(cmd:dir:params)
+	| elem cmd builtins = builtin cmd dir params
+	| otherwise = external c
+main' c@(cmd:_)
+	| elem cmd builtins = failure
+	| otherwise = external c
+
+builtins :: [String]
+builtins = map cmdname cmds
+
+builtin :: String -> String -> [String] -> IO ()
+builtin cmd dir params = do
+	let gitrepo = Git.repoFromPath dir
+	dispatch gitrepo (cmd:params) cmds commonOptions header
+
+external :: [String] -> IO ()
+external l = do
+	ret <- boolSystem "git-shell" ("-c":l)
+	when (not ret) $
+		error "git-shell failed"
+
+failure :: IO ()
+failure = error $ "bad parameters\n\n" ++ usage header cmds commonOptions