This commit is contained in:
Joey Hess 2010-11-01 03:01:58 -04:00
parent 524125e52e
commit 0655ae4b8a
2 changed files with 24 additions and 26 deletions

24
Core.hs
View file

@ -7,6 +7,7 @@
module Core where module Core where
import IO (try)
import System.IO import System.IO
import System.Directory import System.Directory
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
@ -23,6 +24,29 @@ import qualified GitQueue
import qualified Annex import qualified Annex
import Utility 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. -} {- Sets up a git repo for git-annex. -}
startup :: Annex Bool startup :: Annex Bool
startup = do startup = do

View file

@ -5,12 +5,9 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
import IO (try)
import System.Environment import System.Environment
import Monad
import qualified Annex import qualified Annex
import Types
import Core import Core
import Commands import Commands
import qualified GitRepo as Git import qualified GitRepo as Git
@ -23,26 +20,3 @@ main = do
state <- Annex.new gitrepo allBackends state <- Annex.new gitrepo allBackends
(configure, actions) <- parseCmd args state (configure, actions) <- parseCmd args state
tryRun state $ [startup] ++ configure ++ actions ++ [shutdown] 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"