diff --git a/Core.hs b/Core.hs index ab7291affa..d3d0d7899c 100644 --- a/Core.hs +++ b/Core.hs @@ -7,6 +7,7 @@ module Core where +import IO (try) import System.IO import System.Directory import Control.Monad.State (liftIO) @@ -22,6 +23,29 @@ import qualified GitRepo as Git import qualified GitQueue import qualified Annex import Utility + +{- 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 Bool] -> IO () +tryRun state actions = tryRun' state 0 actions +tryRun' :: AnnexState -> Integer -> [Annex Bool] -> IO () +tryRun' state errnum (a:as) = do + result <- try $ Annex.run state a + case (result) of + Left err -> do + Annex.eval state $ showErr err + tryRun' state (errnum + 1) as + Right (True,state') -> tryRun' state' errnum as + Right (False,state') -> tryRun' state' (errnum + 1) as +tryRun' _ errnum [] = + when (errnum > 0) $ error $ (show errnum) ++ " failed" {- Sets up a git repo for git-annex. -} startup :: Annex Bool diff --git a/git-annex.hs b/git-annex.hs index e958ac2f96..370c22a1ef 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -5,12 +5,9 @@ - Licensed under the GNU GPL version 3 or higher. -} -import IO (try) import System.Environment -import Monad import qualified Annex -import Types import Core import Commands import qualified GitRepo as Git @@ -23,26 +20,3 @@ main = do state <- Annex.new gitrepo allBackends (configure, actions) <- parseCmd args state tryRun state $ [startup] ++ configure ++ 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 Bool] -> IO () -tryRun state actions = tryRun' state 0 actions -tryRun' :: AnnexState -> Integer -> [Annex Bool] -> IO () -tryRun' state errnum (a:as) = do - result <- try $ Annex.run state a - case (result) of - Left err -> do - Annex.eval state $ showErr err - tryRun' state (errnum + 1) as - Right (True,state') -> tryRun' state' errnum as - Right (False,state') -> tryRun' state' (errnum + 1) as -tryRun' _ errnum [] = - when (errnum > 0) $ error $ (show errnum) ++ " failed"