diff options
Diffstat (limited to 'Annex')
| -rw-r--r-- | Annex/Content.hs | 6 | ||||
| -rw-r--r-- | Annex/Exception.hs | 15 |
2 files changed, 19 insertions, 2 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index 8ad3d5e65..eb84f2fe9 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -16,6 +16,7 @@ module Annex.Content ( getViaTmpChecked, getViaTmpUnchecked, prepGetViaTmpChecked, + prepTmp, withTmp, checkDiskSpace, moveAnnex, @@ -264,7 +265,10 @@ prepTmp key = do createAnnexDirectory (parentDir tmp) return tmp -{- Creates a temp file, runs an action on it, and cleans up the temp file. -} +{- Creates a temp file for a key, runs an action on it, and cleans up + - the temp file. If the action throws an exception, the temp file is + - left behind, which allows for resuming. + -} withTmp :: Key -> (FilePath -> Annex a) -> Annex a withTmp key action = do tmp <- prepTmp key diff --git a/Annex/Exception.hs b/Annex/Exception.hs index 41a9ed921..5ecbd28a0 100644 --- a/Annex/Exception.hs +++ b/Annex/Exception.hs @@ -5,12 +5,13 @@ - AnnexState are retained. This works because the Annex monad - internally stores the AnnexState in a MVar. - - - Copyright 2011-2013 Joey Hess <joey@kitenet.net> + - Copyright 2011-2014 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} {-# LANGUAGE PackageImports #-} +{-# LANGUAGE ScopedTypeVariables #-} module Annex.Exception ( bracketIO, @@ -19,6 +20,8 @@ module Annex.Exception ( tryAnnexIO, throwAnnex, catchAnnex, + catchNonAsyncAnnex, + tryNonAsyncAnnex, ) where import qualified Control.Monad.Catch as M @@ -48,3 +51,13 @@ throwAnnex = M.throwM {- catch in the Annex monad -} catchAnnex :: Exception e => Annex a -> (e -> Annex a) -> Annex a catchAnnex = M.catch + +{- catchs all exceptions except for async exceptions -} +catchNonAsyncAnnex :: Annex a -> (SomeException -> Annex a) -> Annex a +catchNonAsyncAnnex a onerr = a `M.catches` + [ M.Handler (\ (e :: AsyncException) -> throwAnnex e) + , M.Handler (\ (e :: SomeException) -> onerr e) + ] + +tryNonAsyncAnnex :: Annex a -> Annex (Either SomeException a) +tryNonAsyncAnnex a = (Right <$> a) `catchNonAsyncAnnex` (return . Left) |