{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ImplicitParams #-}
module Control.Exception.Safe
(
throw
, throwIO
, throwM
, throwString
, StringException (..)
, throwTo
, impureThrow
, catch
, catchIO
, catchAny
, catchDeep
, catchAnyDeep
, catchAsync
, catchJust
, handle
, handleIO
, handleAny
, handleDeep
, handleAnyDeep
, handleAsync
, handleJust
, try
, tryIO
, tryAny
, tryDeep
, tryAnyDeep
, tryAsync
, tryJust
, Handler(..)
, catches
, catchesDeep
, catchesAsync
, onException
, bracket
, bracket_
, finally
, withException
, bracketOnError
, bracketOnError_
, bracketWithError
, SyncExceptionWrapper (..)
, toSyncException
, AsyncExceptionWrapper (..)
, toAsyncException
, isSyncException
, isAsyncException
, C.MonadThrow
, C.MonadCatch
, C.MonadMask (..)
, C.mask_
, C.uninterruptibleMask_
, C.catchIOError
, C.handleIOError
, Exception (..)
, Typeable
, SomeException (..)
, SomeAsyncException (..)
, E.IOException
, E.assert
#if !MIN_VERSION_base(4,8,0)
, displayException
#endif
) where
import Control.Concurrent (ThreadId)
import Control.DeepSeq (($!!), NFData)
import Control.Exception (Exception (..), SomeException (..), SomeAsyncException (..))
import qualified Control.Exception as E
import qualified Control.Monad.Catch as C
import Control.Monad.Catch (Handler (..))
import Control.Monad (liftM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Typeable (Typeable, cast)
#if MIN_VERSION_base(4,9,0)
import GHC.Stack (prettySrcLoc)
import GHC.Stack.Types (HasCallStack, CallStack, getCallStack)
#endif
throw :: (C.MonadThrow m, Exception e) => e -> m a
throw :: e -> m a
throw = SomeException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
C.throwM (SomeException -> m a) -> (e -> SomeException) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeException
forall e. Exception e => e -> SomeException
toSyncException
throwIO :: (C.MonadThrow m, Exception e) => e -> m a
throwIO :: e -> m a
throwIO = e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw
throwM :: (C.MonadThrow m, Exception e) => e -> m a
throwM :: e -> m a
throwM = e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw
#if MIN_VERSION_base(4,9,0)
throwString :: (C.MonadThrow m, HasCallStack) => String -> m a
throwString :: String -> m a
throwString s :: String
s = StringException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (String -> CallStack -> StringException
StringException String
s ?callStack::CallStack
CallStack
?callStack)
#else
throwString :: C.MonadThrow m => String -> m a
throwString s = throwM (StringException s ())
#endif
#if MIN_VERSION_base(4,9,0)
data StringException = StringException String CallStack
deriving Typeable
instance Show StringException where
show :: StringException -> String
show (StringException s :: String
s cs :: CallStack
cs) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ "Control.Exception.Safe.throwString called with:\n\n"
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
s
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: "\nCalled from:\n"
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((String, SrcLoc) -> String) -> [(String, SrcLoc)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, SrcLoc) -> String
go (CallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs)
where
go :: (String, SrcLoc) -> String
go (x :: String
x, y :: SrcLoc
y) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ " "
, String
x
, " ("
, SrcLoc -> String
prettySrcLoc SrcLoc
y
, ")\n"
]
#else
data StringException = StringException String ()
deriving Typeable
instance Show StringException where
show (StringException s _) = "Control.Exception.Safe.throwString called with:\n\n" ++ s
#endif
instance Exception StringException
throwTo :: (Exception e, MonadIO m) => ThreadId -> e -> m ()
throwTo :: ThreadId -> e -> m ()
throwTo tid :: ThreadId
tid = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (e -> IO ()) -> e -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThreadId -> SomeException -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
E.throwTo ThreadId
tid (SomeException -> IO ()) -> (e -> SomeException) -> e -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeException
forall e. Exception e => e -> SomeException
toAsyncException
impureThrow :: Exception e => e -> a
impureThrow :: e -> a
impureThrow = SomeException -> a
forall a e. Exception e => e -> a
E.throw (SomeException -> a) -> (e -> SomeException) -> e -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeException
forall e. Exception e => e -> SomeException
toSyncException
catch :: (C.MonadCatch m, Exception e) => m a -> (e -> m a) -> m a
catch :: m a -> (e -> m a) -> m a
catch f :: m a
f g :: e -> m a
g = m a
f m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`C.catch` \e :: e
e ->
if e -> Bool
forall e. Exception e => e -> Bool
isSyncException e
e
then e -> m a
g e
e
else e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
C.throwM e
e
catchIO :: C.MonadCatch m => m a -> (E.IOException -> m a) -> m a
catchIO :: m a -> (IOException -> m a) -> m a
catchIO = m a -> (IOException -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
C.catch
catchAny :: C.MonadCatch m => m a -> (SomeException -> m a) -> m a
catchAny :: m a -> (SomeException -> m a) -> m a
catchAny = m a -> (SomeException -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch
catchDeep :: (C.MonadCatch m, MonadIO m, Exception e, NFData a)
=> m a -> (e -> m a) -> m a
catchDeep :: m a -> (e -> m a) -> m a
catchDeep = m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (m a -> (e -> m a) -> m a)
-> (m a -> m a) -> m a -> (e -> m a) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> m a
forall (m :: * -> *) a. (MonadIO m, NFData a) => m a -> m a
evaluateDeep
evaluateDeep :: (MonadIO m, NFData a) => m a -> m a
evaluateDeep :: m a -> m a
evaluateDeep action :: m a
action = do
a
res <- m a
action
IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (a -> IO a
forall a. a -> IO a
E.evaluate (a -> IO a) -> a -> IO a
forall a b. NFData a => (a -> b) -> a -> b
$!! a
res)
catchAnyDeep :: (C.MonadCatch m, MonadIO m, NFData a) => m a -> (SomeException -> m a) -> m a
catchAnyDeep :: m a -> (SomeException -> m a) -> m a
catchAnyDeep = m a -> (SomeException -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, MonadIO m, Exception e, NFData a) =>
m a -> (e -> m a) -> m a
catchDeep
catchAsync :: (C.MonadCatch m, Exception e) => m a -> (e -> m a) -> m a
catchAsync :: m a -> (e -> m a) -> m a
catchAsync = m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
C.catch
catchJust :: (C.MonadCatch m, Exception e) => (e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust :: (e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust f :: e -> Maybe b
f a :: m a
a b :: b -> m a
b = m a
a m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e :: e
e -> m a -> (b -> m a) -> Maybe b -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM e
e) b -> m a
b (Maybe b -> m a) -> Maybe b -> m a
forall a b. (a -> b) -> a -> b
$ e -> Maybe b
f e
e
handle :: (C.MonadCatch m, Exception e) => (e -> m a) -> m a -> m a
handle :: (e -> m a) -> m a -> m a
handle = (m a -> (e -> m a) -> m a) -> (e -> m a) -> m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch
handleIO :: C.MonadCatch m => (E.IOException -> m a) -> m a -> m a
handleIO :: (IOException -> m a) -> m a -> m a
handleIO = (IOException -> m a) -> m a -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
C.handle
handleAny :: C.MonadCatch m => (SomeException -> m a) -> m a -> m a
handleAny :: (SomeException -> m a) -> m a -> m a
handleAny = (m a -> (SomeException -> m a) -> m a)
-> (SomeException -> m a) -> m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip m a -> (SomeException -> m a) -> m a
forall (m :: * -> *) a.
MonadCatch m =>
m a -> (SomeException -> m a) -> m a
catchAny
handleDeep :: (C.MonadCatch m, Exception e, MonadIO m, NFData a) => (e -> m a) -> m a -> m a
handleDeep :: (e -> m a) -> m a -> m a
handleDeep = (m a -> (e -> m a) -> m a) -> (e -> m a) -> m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, MonadIO m, Exception e, NFData a) =>
m a -> (e -> m a) -> m a
catchDeep
handleAnyDeep :: (C.MonadCatch m, MonadIO m, NFData a) => (SomeException -> m a) -> m a -> m a
handleAnyDeep :: (SomeException -> m a) -> m a -> m a
handleAnyDeep = (m a -> (SomeException -> m a) -> m a)
-> (SomeException -> m a) -> m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip m a -> (SomeException -> m a) -> m a
forall (m :: * -> *) a.
(MonadCatch m, MonadIO m, NFData a) =>
m a -> (SomeException -> m a) -> m a
catchAnyDeep
handleAsync :: (C.MonadCatch m, Exception e) => (e -> m a) -> m a -> m a
handleAsync :: (e -> m a) -> m a -> m a
handleAsync = (e -> m a) -> m a -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
C.handle
handleJust :: (C.MonadCatch m, Exception e) => (e -> Maybe b) -> (b -> m a) -> m a -> m a
handleJust :: (e -> Maybe b) -> (b -> m a) -> m a -> m a
handleJust f :: e -> Maybe b
f = (m a -> (b -> m a) -> m a) -> (b -> m a) -> m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((e -> Maybe b) -> m a -> (b -> m a) -> m a
forall (m :: * -> *) e b a.
(MonadCatch m, Exception e) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust e -> Maybe b
f)
try :: (C.MonadCatch m, E.Exception e) => m a -> m (Either e a)
try :: m a -> m (Either e a)
try f :: m a
f = m (Either e a) -> (e -> m (Either e a)) -> m (Either e a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch ((a -> Either e a) -> m a -> m (Either e a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Either e a
forall a b. b -> Either a b
Right m a
f) (Either e a -> m (Either e a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e a -> m (Either e a))
-> (e -> Either e a) -> e -> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e a
forall a b. a -> Either a b
Left)
tryIO :: C.MonadCatch m => m a -> m (Either E.IOException a)
tryIO :: m a -> m (Either IOException a)
tryIO = m a -> m (Either IOException a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try
tryAny :: C.MonadCatch m => m a -> m (Either SomeException a)
tryAny :: m a -> m (Either SomeException a)
tryAny = m a -> m (Either SomeException a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try
tryDeep :: (C.MonadCatch m, MonadIO m, E.Exception e, NFData a) => m a -> m (Either e a)
tryDeep :: m a -> m (Either e a)
tryDeep f :: m a
f = m (Either e a) -> (e -> m (Either e a)) -> m (Either e a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch ((a -> Either e a) -> m a -> m (Either e a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Either e a
forall a b. b -> Either a b
Right (m a -> m a
forall (m :: * -> *) a. (MonadIO m, NFData a) => m a -> m a
evaluateDeep m a
f)) (Either e a -> m (Either e a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e a -> m (Either e a))
-> (e -> Either e a) -> e -> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e a
forall a b. a -> Either a b
Left)
tryAnyDeep :: (C.MonadCatch m, MonadIO m, NFData a) => m a -> m (Either SomeException a)
tryAnyDeep :: m a -> m (Either SomeException a)
tryAnyDeep = m a -> m (Either SomeException a)
forall (m :: * -> *) e a.
(MonadCatch m, MonadIO m, Exception e, NFData a) =>
m a -> m (Either e a)
tryDeep
tryAsync :: (C.MonadCatch m, E.Exception e) => m a -> m (Either e a)
tryAsync :: m a -> m (Either e a)
tryAsync = m a -> m (Either e a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try
tryJust :: (C.MonadCatch m, Exception e) => (e -> Maybe b) -> m a -> m (Either b a)
tryJust :: (e -> Maybe b) -> m a -> m (Either b a)
tryJust f :: e -> Maybe b
f a :: m a
a = m (Either b a) -> (e -> m (Either b a)) -> m (Either b a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (a -> Either b a
forall a b. b -> Either a b
Right (a -> Either b a) -> m a -> m (Either b a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m a
a) (\e :: e
e -> m (Either b a)
-> (b -> m (Either b a)) -> Maybe b -> m (Either b a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> m (Either b a)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM e
e) (Either b a -> m (Either b a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either b a -> m (Either b a))
-> (b -> Either b a) -> b -> m (Either b a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either b a
forall a b. a -> Either a b
Left) (e -> Maybe b
f e
e))
onException :: C.MonadMask m => m a -> m b -> m a
onException :: m a -> m b -> m a
onException thing :: m a
thing after :: m b
after = m a -> (SomeException -> m b) -> m a
forall (m :: * -> *) e a b.
(MonadMask m, Exception e) =>
m a -> (e -> m b) -> m a
withException m a
thing (\(SomeException
_ :: SomeException) -> m b
after)
withException :: (C.MonadMask m, E.Exception e) => m a -> (e -> m b) -> m a
withException :: m a -> (e -> m b) -> m a
withException thing :: m a
thing after :: e -> m b
after = ((forall a. m a -> m a) -> m a) -> m a
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
C.uninterruptibleMask (((forall a. m a -> m a) -> m a) -> m a)
-> ((forall a. m a -> m a) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. m a -> m a
restore -> do
Either e a
res1 <- m a -> m (Either e a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try (m a -> m (Either e a)) -> m a -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ m a -> m a
forall a. m a -> m a
restore m a
thing
case Either e a
res1 of
Left e1 :: e
e1 -> do
Either SomeException b
_ :: Either SomeException b <- m b -> m (Either SomeException b)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try (m b -> m (Either SomeException b))
-> m b -> m (Either SomeException b)
forall a b. (a -> b) -> a -> b
$ e -> m b
after e
e1
e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
C.throwM e
e1
Right x :: a
x -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
bracket :: forall m a b c. C.MonadMask m
=> m a -> (a -> m b) -> (a -> m c) -> m c
bracket :: m a -> (a -> m b) -> (a -> m c) -> m c
bracket before :: m a
before after :: a -> m b
after = m a -> (Maybe SomeException -> a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (Maybe SomeException -> a -> m b) -> (a -> m c) -> m c
bracketWithError m a
before ((a -> m b) -> Maybe SomeException -> a -> m b
forall a b. a -> b -> a
const a -> m b
after)
bracket_ :: C.MonadMask m => m a -> m b -> m c -> m c
bracket_ :: m a -> m b -> m c -> m c
bracket_ before :: m a
before after :: m b
after thing :: m c
thing = m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m a
before (m b -> a -> m b
forall a b. a -> b -> a
const m b
after) (m c -> a -> m c
forall a b. a -> b -> a
const m c
thing)
finally :: C.MonadMask m => m a -> m b -> m a
finally :: m a -> m b -> m a
finally thing :: m a
thing after :: m b
after = ((forall a. m a -> m a) -> m a) -> m a
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
C.uninterruptibleMask (((forall a. m a -> m a) -> m a) -> m a)
-> ((forall a. m a -> m a) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. m a -> m a
restore -> do
Either SomeException a
res1 <- m a -> m (Either SomeException a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try (m a -> m (Either SomeException a))
-> m a -> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ m a -> m a
forall a. m a -> m a
restore m a
thing
case Either SomeException a
res1 of
Left (SomeException
e1 :: SomeException) -> do
Either SomeException b
_ :: Either SomeException b <- m b -> m (Either SomeException b)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try m b
after
SomeException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
C.throwM SomeException
e1
Right x :: a
x -> do
b
_ <- m b
after
a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
bracketOnError :: forall m a b c. C.MonadMask m
=> m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError :: m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError before :: m a
before after :: a -> m b
after thing :: a -> m c
thing = ((forall a. m a -> m a) -> m c) -> m c
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
C.mask (((forall a. m a -> m a) -> m c) -> m c)
-> ((forall a. m a -> m a) -> m c) -> m c
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. m a -> m a
restore -> do
a
x <- m a
before
Either SomeException c
res1 <- m c -> m (Either SomeException c)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try (m c -> m (Either SomeException c))
-> m c -> m (Either SomeException c)
forall a b. (a -> b) -> a -> b
$ m c -> m c
forall a. m a -> m a
restore (a -> m c
thing a
x)
case Either SomeException c
res1 of
Left (SomeException
e1 :: SomeException) -> do
Either SomeException b
_ :: Either SomeException b <-
m b -> m (Either SomeException b)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try (m b -> m (Either SomeException b))
-> m b -> m (Either SomeException b)
forall a b. (a -> b) -> a -> b
$ m b -> m b
forall (m :: * -> *) a. MonadMask m => m a -> m a
C.uninterruptibleMask_ (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$ a -> m b
after a
x
SomeException -> m c
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
C.throwM SomeException
e1
Right y :: c
y -> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return c
y
bracketOnError_ :: C.MonadMask m => m a -> m b -> m c -> m c
bracketOnError_ :: m a -> m b -> m c -> m c
bracketOnError_ before :: m a
before after :: m b
after thing :: m c
thing = m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError m a
before (m b -> a -> m b
forall a b. a -> b -> a
const m b
after) (m c -> a -> m c
forall a b. a -> b -> a
const m c
thing)
bracketWithError :: forall m a b c. C.MonadMask m
=> m a -> (Maybe SomeException -> a -> m b) -> (a -> m c) -> m c
bracketWithError :: m a -> (Maybe SomeException -> a -> m b) -> (a -> m c) -> m c
bracketWithError before :: m a
before after :: Maybe SomeException -> a -> m b
after thing :: a -> m c
thing = ((forall a. m a -> m a) -> m c) -> m c
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
C.mask (((forall a. m a -> m a) -> m c) -> m c)
-> ((forall a. m a -> m a) -> m c) -> m c
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. m a -> m a
restore -> do
a
x <- m a
before
Either SomeException c
res1 <- m c -> m (Either SomeException c)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try (m c -> m (Either SomeException c))
-> m c -> m (Either SomeException c)
forall a b. (a -> b) -> a -> b
$ m c -> m c
forall a. m a -> m a
restore (a -> m c
thing a
x)
case Either SomeException c
res1 of
Left (SomeException
e1 :: SomeException) -> do
Either SomeException b
_ :: Either SomeException b <-
m b -> m (Either SomeException b)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try (m b -> m (Either SomeException b))
-> m b -> m (Either SomeException b)
forall a b. (a -> b) -> a -> b
$ m b -> m b
forall (m :: * -> *) a. MonadMask m => m a -> m a
C.uninterruptibleMask_ (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$ Maybe SomeException -> a -> m b
after (SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e1) a
x
SomeException -> m c
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
C.throwM SomeException
e1
Right y :: c
y -> do
b
_ <- m b -> m b
forall (m :: * -> *) a. MonadMask m => m a -> m a
C.uninterruptibleMask_ (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$ Maybe SomeException -> a -> m b
after Maybe SomeException
forall a. Maybe a
Nothing a
x
c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return c
y
data SyncExceptionWrapper = forall e. Exception e => SyncExceptionWrapper e
deriving Typeable
instance Show SyncExceptionWrapper where
show :: SyncExceptionWrapper -> String
show (SyncExceptionWrapper e :: e
e) = e -> String
forall a. Show a => a -> String
show e
e
instance Exception SyncExceptionWrapper where
#if MIN_VERSION_base(4,8,0)
displayException :: SyncExceptionWrapper -> String
displayException (SyncExceptionWrapper e :: e
e) = e -> String
forall e. Exception e => e -> String
displayException e
e
#endif
toSyncException :: Exception e => e -> SomeException
toSyncException :: e -> SomeException
toSyncException e :: e
e =
case SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se of
Just (SomeAsyncException _) -> SyncExceptionWrapper -> SomeException
forall e. Exception e => e -> SomeException
toException (e -> SyncExceptionWrapper
forall e. Exception e => e -> SyncExceptionWrapper
SyncExceptionWrapper e
e)
Nothing -> SomeException
se
where
se :: SomeException
se = e -> SomeException
forall e. Exception e => e -> SomeException
toException e
e
data AsyncExceptionWrapper = forall e. Exception e => AsyncExceptionWrapper e
deriving Typeable
instance Show AsyncExceptionWrapper where
show :: AsyncExceptionWrapper -> String
show (AsyncExceptionWrapper e :: e
e) = e -> String
forall a. Show a => a -> String
show e
e
instance Exception AsyncExceptionWrapper where
toException :: AsyncExceptionWrapper -> SomeException
toException = SomeAsyncException -> SomeException
forall e. Exception e => e -> SomeException
toException (SomeAsyncException -> SomeException)
-> (AsyncExceptionWrapper -> SomeAsyncException)
-> AsyncExceptionWrapper
-> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsyncExceptionWrapper -> SomeAsyncException
forall e. Exception e => e -> SomeAsyncException
SomeAsyncException
fromException :: SomeException -> Maybe AsyncExceptionWrapper
fromException se :: SomeException
se = do
SomeAsyncException e :: e
e <- SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se
e -> Maybe AsyncExceptionWrapper
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e
#if MIN_VERSION_base(4,8,0)
displayException :: AsyncExceptionWrapper -> String
displayException (AsyncExceptionWrapper e :: e
e) = e -> String
forall e. Exception e => e -> String
displayException e
e
#endif
toAsyncException :: Exception e => e -> SomeException
toAsyncException :: e -> SomeException
toAsyncException e :: e
e =
case SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se of
Just (SomeAsyncException _) -> SomeException
se
Nothing -> AsyncExceptionWrapper -> SomeException
forall e. Exception e => e -> SomeException
toException (e -> AsyncExceptionWrapper
forall e. Exception e => e -> AsyncExceptionWrapper
AsyncExceptionWrapper e
e)
where
se :: SomeException
se = e -> SomeException
forall e. Exception e => e -> SomeException
toException e
e
isSyncException :: Exception e => e -> Bool
isSyncException :: e -> Bool
isSyncException e :: e
e =
case SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
fromException (e -> SomeException
forall e. Exception e => e -> SomeException
toException e
e) of
Just (SomeAsyncException _) -> Bool
False
Nothing -> Bool
True
isAsyncException :: Exception e => e -> Bool
isAsyncException :: e -> Bool
isAsyncException = Bool -> Bool
not (Bool -> Bool) -> (e -> Bool) -> e -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Bool
forall e. Exception e => e -> Bool
isSyncException
{-# INLINE isAsyncException #-}
#if !MIN_VERSION_base(4,8,0)
displayException :: Exception e => e -> String
displayException = show
#endif
catches :: (C.MonadCatch m, C.MonadThrow m) => m a -> [Handler m a] -> m a
catches :: m a -> [Handler m a] -> m a
catches io :: m a
io handlers :: [Handler m a]
handlers = m a
io m a -> (SomeException -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` [Handler m a] -> SomeException -> m a
forall (m :: * -> *) a.
MonadThrow m =>
[Handler m a] -> SomeException -> m a
catchesHandler [Handler m a]
handlers
catchesDeep :: (C.MonadCatch m, C.MonadThrow m, MonadIO m, NFData a) => m a -> [Handler m a] -> m a
catchesDeep :: m a -> [Handler m a] -> m a
catchesDeep io :: m a
io handlers :: [Handler m a]
handlers = m a -> m a
forall (m :: * -> *) a. (MonadIO m, NFData a) => m a -> m a
evaluateDeep m a
io m a -> (SomeException -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` [Handler m a] -> SomeException -> m a
forall (m :: * -> *) a.
MonadThrow m =>
[Handler m a] -> SomeException -> m a
catchesHandler [Handler m a]
handlers
catchesAsync :: (C.MonadCatch m, C.MonadThrow m) => m a -> [Handler m a] -> m a
catchesAsync :: m a -> [Handler m a] -> m a
catchesAsync io :: m a
io handlers :: [Handler m a]
handlers = m a
io m a -> (SomeException -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catchAsync` [Handler m a] -> SomeException -> m a
forall (m :: * -> *) a.
MonadThrow m =>
[Handler m a] -> SomeException -> m a
catchesHandler [Handler m a]
handlers
catchesHandler :: (C.MonadThrow m) => [Handler m a] -> SomeException -> m a
catchesHandler :: [Handler m a] -> SomeException -> m a
catchesHandler handlers :: [Handler m a]
handlers e :: SomeException
e = (Handler m a -> m a -> m a) -> m a -> [Handler m a] -> m a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Handler m a -> m a -> m a
forall (m :: * -> *) a. Handler m a -> m a -> m a
tryHandler (SomeException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
C.throwM SomeException
e) [Handler m a]
handlers
where tryHandler :: Handler m a -> m a -> m a
tryHandler (Handler handler :: e -> m a
handler) res :: m a
res
= case SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just e' :: e
e' -> e -> m a
handler e
e'
Nothing -> m a
res