diff options
| author |  Joey Hess <joey@kitenet.net> | 2014-07-26 23:24:27 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2014-07-26 23:24:27 -0400 |
| commit | 24c1d3fe0b720ad78399284a3645d0bb6dc15b0d (patch) | |
| tree | 93104a7d0ebf039a3b3fdbd666b46cb71eda4459 | |
| parent | 0950b8314a21e125aec383db078afc648bd4444e (diff) | |
add some more exception handling primitives
| -rw-r--r-- | Annex/Exception.hs | 15 |
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) |