diff options
| author |  Joey Hess <joey@kitenet.net> | 2014-08-01 18:00:47 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2014-08-01 18:00:47 -0400 |
| commit | ddbf5df3c9940473663a6e562f8ee3583867046e (patch) | |
| tree | 40dc81d0c2693b5fd5fc3e5b9cd8df17e0505ec5 /Annex | |
| parent | 154cb13180fbe877d2030d83a415b30150ac7298 (diff) | |
| parent | d0a8e3d6217f2924b864393d425b6d7582370d07 (diff) | |
Merge branch 'newchunks'
I am happy enough with this to make it live!
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) |