add some more exception handling primitives

1 files changed, 14 insertions, 1 deletions

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)