better option handling

multiple-file support for all modes

Annex.hs

@@ -25,15 +25,14 @@ startAnnex = do
  - the annex directory and setting up the symlink pointing to its content. -}
 annexFile :: State -> FilePath -> IO ()
 annexFile state file = do
-	checkExists file
-	checkLegal file
 	alreadyannexed <- lookupBackend (backends state) (repo state) file
 	case (alreadyannexed) of
-		Just _ -> error $ "already annexed " ++ file
+		Just _ -> error $ "already annexed: " ++ file
 		Nothing -> do
+			checkLegal file
 			stored <- storeFile (backends state) (repo state) file
 			case (stored) of
-				Nothing -> error $ "no backend could store " ++ file
+				Nothing -> error $ "no backend could store: " ++ file
 				Just key -> symlink key
 	where
 		symlink key = do
@@ -42,11 +41,6 @@ annexFile state file = do
 			renameFile file dest
 			createSymbolicLink dest file
 			gitAdd (repo state) file
-		checkExists file = do
-			exists <- doesFileExist file
-			if (not exists)
-				then error $ "does not exist: " ++ file
-				else return ()
 		checkLegal file = do
 			s <- getSymbolicLinkStatus file
 			if ((isSymbolicLink s) || (not $ isRegularFile s))

CmdLine.hs

@@ -10,34 +10,35 @@ import System.Console.GetOpt
 import Types
 import Annex
 
-data Flag = Add FilePath | Push String | Pull String | Want FilePath | 
+data Mode = Add | Push | Pull | Want | Get | Drop | Unannex
-		Get (Maybe FilePath) | Drop FilePath | Unannex FilePath
 	deriving Show
 
-options :: [OptDescr Flag]
+options :: [OptDescr Mode]
 options =
-	[ Option ['a'] ["add"] (ReqArg Add "FILE") "add file to annex"
+	[ Option ['a'] ["add"] (NoArg Add) "add files to annex"
-	, Option ['p'] ["push"] (ReqArg Push "REPO") "push annex to repo"
+	, Option ['p'] ["push"] (NoArg Push) "push annex to repos"
-	, Option ['P'] ["pull"] (ReqArg Pull "REPO") "pull annex from repo"
+	, Option ['P'] ["pull"] (NoArg Pull) "pull annex from repos"
-	, Option ['w'] ["want"] (ReqArg Want "FILE") "request file contents"
+	, Option ['w'] ["want"] (NoArg Want) "request file contents"
-	, Option ['g'] ["get"] (OptArg Get "FILE") "transfer file contents"
+	, Option ['g'] ["get"] (NoArg Get) "transfer file contents"
-	, Option ['d'] ["drop"] (ReqArg Drop "FILE") "indicate file content not needed"
+	, Option ['d'] ["drop"] (NoArg Drop) "indicate file contents not needed"
-	, Option ['u'] ["unannex"] (ReqArg Unannex "FILE") "undo --add"
+	, Option ['u'] ["unannex"] (NoArg Unannex) "undo --add"
 	]
 
-argvToFlags argv = do
+argvToMode argv = do
 	case getOpt Permute options argv of
-		-- no options? add listed files
+		-- default mode is Add
-		([],p,[]  ) -> return $ map (\f -> Add f) p
+		([],files,[]) -> return (Add, files)
-		-- all options parsed, return flags
+		-- one mode is normal case
-		(o,[],[]  ) -> return o
+		(m:[],files,[]) -> return (m, files)
+		-- multiple modes is an error
+		(ms,files,[]) -> ioError (userError ("only one mode should be specified\n" ++ usageInfo header options))
 		-- error case
-		(_,n,errs) -> ioError (userError (concat errs ++ usageInfo header options))
+		(_,files,errs) -> ioError (userError (concat errs ++ usageInfo header options))
-	where header = "Usage: git-annex [option] file"
+	where header = "Usage: git-annex [mode] file"
 
-dispatch :: Flag -> State -> IO ()
+dispatch :: State -> Mode -> FilePath -> IO ()
-dispatch flag state = do
+dispatch state mode file = do
-	case (flag) of
+	case (mode) of
-		Add f -> annexFile state f
+		Add -> annexFile state file
-		Unannex f -> unannexFile state f
+		Unannex -> unannexFile state file
 		_ -> error "not implemented"

git-annex.hs

@@ -1,16 +1,37 @@
 {- git-annex main program
  - -}
 
+import System.IO
 import System.Environment
-import GitRepo
+import Control.Exception
 import CmdLine
 import Annex
-import BackendList
 
 main = do
 	args <- getArgs
-	flags <- argvToFlags args
+	(mode, files) <- argvToMode args
 	
 	state <- startAnnex
 
-	mapM (\f -> dispatch f state) flags
+	tryRun 0 $ map (\f -> dispatch state mode f) files
+
+{- Tries to run a series of actions, not stopping if some error out,
+ - and propigating an overall error status at the end. -}
+tryRun errflag [] = do
+	if (errflag > 0)
+		then error "unsuccessful"
+		else return ()
+tryRun errflag (a:as) = do
+	result <- try (a)::IO (Either SomeException ())
+	case (result) of
+		Left err -> do
+			showErr err
+			tryRun 1 as
+		Right _ -> tryRun errflag as
+
+{- Exception pretty-printing. -}
+showErr :: SomeException -> IO ()
+showErr e = do
+	let err = show e
+	hPutStrLn stderr $ "git-annex: " ++ err
+	return ()