diff options
Diffstat (limited to 'git-annex.hs')
-rw-r--r-- | git-annex.hs | 47 |
1 files changed, 47 insertions, 0 deletions
diff --git a/git-annex.hs b/git-annex.hs new file mode 100644 index 000000000..71a21379d --- /dev/null +++ b/git-annex.hs @@ -0,0 +1,47 @@ +{- git-annex main program -} + +import IO (try) +import System.IO +import System.Environment + +import qualified Annex +import Types +import Core +import Commands +import qualified GitRepo as Git +import BackendList + +main = do + args <- getArgs + gitrepo <- Git.repoFromCwd + state <- Annex.new gitrepo allBackends + (flags, actions) <- parseCmd args state + tryRun state $ [startup flags] ++ actions ++ [shutdown] + +{- Runs a list of Annex actions. Catches IO errors and continues + - (but explicitly thrown errors terminate the whole command). + - Propigates an overall error status at the end. + - + - This runs in the IO monad, not in the Annex monad. It seems that + - exceptions can only be caught in the IO monad, not in a stacked monad; + - or more likely I missed an easy way to do it. So, I have to laboriously + - thread AnnexState through this function. + -} +tryRun :: AnnexState -> [Annex ()] -> IO () +tryRun state actions = tryRun' state 0 actions +tryRun' state errnum (a:as) = do + result <- try $ Annex.run state a + case (result) of + Left err -> do + showErr err + tryRun' state (errnum + 1) as + Right (_,state') -> tryRun' state' errnum as +tryRun' state errnum [] = do + if (errnum > 0) + then error $ (show errnum) ++ " failed" + else return () + +{- Exception pretty-printing. -} +showErr e = do + hPutStrLn stderr $ "git-annex: " ++ (show e) + return () |