diff options
author | Joey Hess <joey@kitenet.net> | 2010-10-10 21:00:42 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-10-10 21:00:42 -0400 |
commit | 200bc6fdb84658593bfb02f34f984531b6710d26 (patch) | |
tree | 7361961de5e90c8be6d1a56010214304cdd18659 | |
parent | 344f13394fe5b12cbdd5eeb99bb63892c7096bfd (diff) |
better option handling
multiple-file support for all modes
-rw-r--r-- | Annex.hs | 12 | ||||
-rw-r--r-- | CmdLine.hs | 45 | ||||
-rw-r--r-- | git-annex.hs | 29 |
3 files changed, 51 insertions, 35 deletions
@@ -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)) diff --git a/CmdLine.hs b/CmdLine.hs index 3709f836b..c956f29a5 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -10,34 +10,35 @@ import System.Console.GetOpt import Types import Annex -data Flag = Add FilePath | Push String | Pull String | Want FilePath | - Get (Maybe FilePath) | Drop FilePath | Unannex FilePath +data Mode = Add | Push | Pull | Want | Get | Drop | Unannex deriving Show -options :: [OptDescr Flag] +options :: [OptDescr Mode] options = - [ Option ['a'] ["add"] (ReqArg Add "FILE") "add file to annex" - , Option ['p'] ["push"] (ReqArg Push "REPO") "push annex to repo" - , Option ['P'] ["pull"] (ReqArg Pull "REPO") "pull annex from repo" - , Option ['w'] ["want"] (ReqArg Want "FILE") "request file contents" - , Option ['g'] ["get"] (OptArg Get "FILE") "transfer file contents" - , Option ['d'] ["drop"] (ReqArg Drop "FILE") "indicate file content not needed" - , Option ['u'] ["unannex"] (ReqArg Unannex "FILE") "undo --add" + [ Option ['a'] ["add"] (NoArg Add) "add files to annex" + , Option ['p'] ["push"] (NoArg Push) "push annex to repos" + , Option ['P'] ["pull"] (NoArg Pull) "pull annex from repos" + , Option ['w'] ["want"] (NoArg Want) "request file contents" + , Option ['g'] ["get"] (NoArg Get) "transfer file contents" + , Option ['d'] ["drop"] (NoArg Drop) "indicate file contents not needed" + , Option ['u'] ["unannex"] (NoArg Unannex) "undo --add" ] -argvToFlags argv = do +argvToMode argv = do case getOpt Permute options argv of - -- no options? add listed files - ([],p,[] ) -> return $ map (\f -> Add f) p - -- all options parsed, return flags - (o,[],[] ) -> return o + -- default mode is Add + ([],files,[]) -> return (Add, files) + -- one mode is normal case + (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)) - where header = "Usage: git-annex [option] file" + (_,files,errs) -> ioError (userError (concat errs ++ usageInfo header options)) + where header = "Usage: git-annex [mode] file" -dispatch :: Flag -> State -> IO () -dispatch flag state = do - case (flag) of - Add f -> annexFile state f - Unannex f -> unannexFile state f +dispatch :: State -> Mode -> FilePath -> IO () +dispatch state mode file = do + case (mode) of + Add -> annexFile state file + Unannex -> unannexFile state file _ -> error "not implemented" diff --git a/git-annex.hs b/git-annex.hs index 2c9b1315f..22fbe60ca 100644 --- a/git-annex.hs +++ b/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 () |