From 24c1d3fe0b720ad78399284a3645d0bb6dc15b0d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 26 Jul 2014 23:24:27 -0400 Subject: add some more exception handling primitives --- Annex/Exception.hs | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) (limited to 'Annex') 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 + - Copyright 2011-2014 Joey Hess - - 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) -- cgit v1.2.3