{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ImplicitParams #-}
module UnliftIO.Exception
(
throwIO
, throwString
, StringException (..)
, stringException
, throwTo
, impureThrow
, fromEither
, fromEitherIO
, fromEitherM
, mapExceptionM
, catch
, catchIO
, catchAny
, catchDeep
, catchAnyDeep
, catchJust
, handle
, handleIO
, handleAny
, handleDeep
, handleAnyDeep
, handleJust
, try
, tryIO
, tryAny
, tryDeep
, tryAnyDeep
, tryJust
, pureTry
, pureTryDeep
, ESafe.Handler (..)
, catches
, catchesDeep
, catchSyncOrAsync
, handleSyncOrAsync
, trySyncOrAsync
, onException
, bracket
, bracket_
, finally
, withException
, bracketOnError
, bracketOnError_
, ESafe.SyncExceptionWrapper(..)
, toSyncException
, ESafe.AsyncExceptionWrapper(..)
, toAsyncException
, fromExceptionUnwrap
, isSyncException
, isAsyncException
, mask
, uninterruptibleMask
, mask_
, uninterruptibleMask_
, evaluate
, evaluateDeep
, Exception (..)
, Typeable
, SomeException (..)
, SomeAsyncException (..)
, IOException
, EUnsafe.assert
, EUnsafe.asyncExceptionToException
, EUnsafe.asyncExceptionFromException
#if !MIN_VERSION_base(4,8,0)
, displayException
#endif
) where
import Control.Concurrent (ThreadId)
import Control.Monad (liftM)
import Control.Monad.IO.Unlift
import Control.Exception (Exception (..), SomeException (..), IOException, SomeAsyncException (..))
import qualified Control.Exception as EUnsafe
import Control.DeepSeq (NFData (..), ($!!))
import Data.Typeable (Typeable, cast)
import System.IO.Unsafe (unsafePerformIO)
import qualified Control.Exception.Safe as ESafe
import Control.Exception.Safe (Handler(..))
#if MIN_VERSION_base(4,9,0)
import GHC.Stack (prettySrcLoc)
import GHC.Stack.Types (HasCallStack, CallStack, getCallStack)
#endif
catch
:: (MonadUnliftIO m, Exception e)
=> m a
-> (e -> m a)
-> m a
catch :: m a -> (e -> m a) -> m a
catch m a
f e -> m a
g = ((forall a. m a -> IO a) -> IO a) -> m a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> m a -> IO a
forall a. m a -> IO a
run m a
f IO a -> (e -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`EUnsafe.catch` \e
e ->
if e -> Bool
forall e. Exception e => e -> Bool
isSyncException e
e
then m a -> IO a
forall a. m a -> IO a
run (e -> m a
g e
e)
else e -> IO a
forall e a. Exception e => e -> IO a
EUnsafe.throwIO e
e
catchIO :: MonadUnliftIO m => m a -> (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.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
catchAny :: MonadUnliftIO 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.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
catchDeep :: (MonadUnliftIO m, Exception e, NFData a)
=> m a -> (e -> m a) -> m a
catchDeep :: m a -> (e -> m a) -> m a
catchDeep m a
m = m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch (m a
m m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m a
forall (m :: * -> *) a. (MonadIO m, NFData a) => a -> m a
evaluateDeep)
catchAnyDeep :: (NFData a, MonadUnliftIO m) => 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.
(MonadUnliftIO m, Exception e, NFData a) =>
m a -> (e -> m a) -> m a
catchDeep
catchJust :: (MonadUnliftIO 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 e -> Maybe b
f m a
a b -> m a
b = m a
a m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> m a -> (b -> m a) -> Maybe b -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (e -> IO a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO 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
catchSyncOrAsync :: (MonadUnliftIO m, Exception e) => m a -> (e -> m a) -> m a
catchSyncOrAsync :: m a -> (e -> m a) -> m a
catchSyncOrAsync m a
f e -> m a
g = ((forall a. m a -> IO a) -> IO a) -> m a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> m a -> IO a
forall a. m a -> IO a
run m a
f IO a -> (e -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`EUnsafe.catch` \e
e -> m a -> IO a
forall a. m a -> IO a
run (e -> m a
g e
e)
handle :: (MonadUnliftIO 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.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
handleIO :: MonadUnliftIO m => (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.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
handle
handleAny :: MonadUnliftIO m => (SomeException -> m a) -> m a -> m a
handleAny :: (SomeException -> m a) -> m a -> m a
handleAny = (SomeException -> m a) -> m a -> m a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
handle
handleDeep :: (MonadUnliftIO m, Exception e, 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.
(MonadUnliftIO m, Exception e, NFData a) =>
m a -> (e -> m a) -> m a
catchDeep
handleAnyDeep :: (MonadUnliftIO 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 a (m :: * -> *).
(NFData a, MonadUnliftIO m) =>
m a -> (SomeException -> m a) -> m a
catchAnyDeep
handleJust :: (MonadUnliftIO 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 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.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust e -> Maybe b
f)
handleSyncOrAsync :: (MonadUnliftIO m, Exception e) => (e -> m a) -> m a -> m a
handleSyncOrAsync :: (e -> m a) -> m a -> m a
handleSyncOrAsync = (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.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catchSyncOrAsync
try :: (MonadUnliftIO m, Exception e) => m a -> m (Either e a)
try :: m a -> m (Either e a)
try m a
f = m (Either e a) -> (e -> m (Either e a)) -> m (Either e a)
forall (m :: * -> *) e a.
(MonadUnliftIO 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 :: MonadUnliftIO m => m a -> m (Either IOException a)
tryIO :: m a -> m (Either IOException a)
tryIO = m a -> m (Either IOException a)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try
tryAny :: MonadUnliftIO 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.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try
tryDeep :: (MonadUnliftIO m, Exception e, NFData a) => m a -> m (Either e a)
tryDeep :: m a -> m (Either e a)
tryDeep m a
f = m (Either e a) -> (e -> m (Either e a)) -> m (Either e a)
forall (m :: * -> *) e a.
(MonadUnliftIO 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 m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m a
forall (m :: * -> *) a. (MonadIO m, NFData a) => a -> m a
evaluateDeep)) (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 :: (MonadUnliftIO 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.
(MonadUnliftIO m, Exception e, NFData a) =>
m a -> m (Either e a)
tryDeep
tryJust :: (MonadUnliftIO m, Exception e) => (e -> Maybe b) -> m a -> m (Either b a)
tryJust :: (e -> Maybe b) -> m a -> m (Either b a)
tryJust e -> Maybe b
f m a
a = m (Either b a) -> (e -> m (Either b a)) -> m (Either b a)
forall (m :: * -> *) e a.
(MonadUnliftIO 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 -> 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. (MonadIO m, Exception e) => e -> m a
throwIO 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))
trySyncOrAsync :: (MonadUnliftIO m, Exception e) => m a -> m (Either e a)
trySyncOrAsync :: m a -> m (Either e a)
trySyncOrAsync m a
f = m (Either e a) -> (e -> m (Either e a)) -> m (Either e a)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catchSyncOrAsync ((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)
pureTry :: a -> Either SomeException a
pureTry :: a -> Either SomeException a
pureTry a
a = IO (Either SomeException a) -> Either SomeException a
forall a. IO a -> a
unsafePerformIO (IO (Either SomeException a) -> Either SomeException a)
-> IO (Either SomeException a) -> Either SomeException a
forall a b. (a -> b) -> a -> b
$ (Either SomeException a -> IO (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException a -> IO (Either SomeException a))
-> Either SomeException a -> IO (Either SomeException a)
forall a b. (a -> b) -> a -> b
$! a -> Either SomeException a
forall a b. b -> Either a b
Right (a -> Either SomeException a) -> a -> Either SomeException a
forall a b. (a -> b) -> a -> b
$! a
a) IO (Either SomeException a)
-> (SomeException -> IO (Either SomeException a))
-> IO (Either SomeException a)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`catchAny` (Either SomeException a -> IO (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException a -> IO (Either SomeException a))
-> (SomeException -> Either SomeException a)
-> SomeException
-> IO (Either SomeException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Either SomeException a
forall a b. a -> Either a b
Left)
pureTryDeep :: NFData a => a -> Either SomeException a
pureTryDeep :: a -> Either SomeException a
pureTryDeep = IO (Either SomeException a) -> Either SomeException a
forall a. IO a -> a
unsafePerformIO (IO (Either SomeException a) -> Either SomeException a)
-> (a -> IO (Either SomeException a))
-> a
-> Either SomeException a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO (Either SomeException a)
forall (m :: * -> *) a.
(MonadUnliftIO m, NFData a) =>
m a -> m (Either SomeException a)
tryAnyDeep (IO a -> IO (Either SomeException a))
-> (a -> IO a) -> a -> IO (Either SomeException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
catchesHandler :: MonadIO m => [Handler m a] -> SomeException -> m a
catchesHandler :: [Handler m a] -> SomeException -> m a
catchesHandler [Handler m a]
handlers 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 (IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SomeException -> IO a
forall e a. Exception e => e -> IO a
EUnsafe.throwIO SomeException
e)) [Handler m a]
handlers
where tryHandler :: Handler m a -> m a -> m a
tryHandler (ESafe.Handler e -> m a
handler) m a
res
= case SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just e
e' -> e -> m a
handler e
e'
Maybe e
Nothing -> m a
res
catches :: MonadUnliftIO m => m a -> [Handler m a] -> m a
catches :: m a -> [Handler m a] -> m a
catches m a
io [Handler m a]
handlers = m a
io m a -> (SomeException -> m a) -> m a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` [Handler m a] -> SomeException -> m a
forall (m :: * -> *) a.
MonadIO m =>
[Handler m a] -> SomeException -> m a
catchesHandler [Handler m a]
handlers
catchesDeep :: (MonadUnliftIO m, NFData a) => m a -> [Handler m a] -> m a
catchesDeep :: m a -> [Handler m a] -> m a
catchesDeep m a
io [Handler m a]
handlers = (m a
io m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m a
forall (m :: * -> *) a. (MonadIO m, NFData a) => a -> m a
evaluateDeep) m a -> (SomeException -> m a) -> m a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` [Handler m a] -> SomeException -> m a
forall (m :: * -> *) a.
MonadIO m =>
[Handler m a] -> SomeException -> m a
catchesHandler [Handler m a]
handlers
evaluate :: MonadIO m => a -> m a
evaluate :: a -> m a
evaluate = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (a -> IO a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall a. a -> IO a
EUnsafe.evaluate
evaluateDeep :: (MonadIO m, NFData a) => a -> m a
evaluateDeep :: a -> m a
evaluateDeep = (a -> m a
forall (m :: * -> *) a. MonadIO m => a -> m a
evaluate (a -> m a) -> a -> m a
forall a b. NFData a => (a -> b) -> a -> b
$!!)
bracket :: MonadUnliftIO m => m a -> (a -> m b) -> (a -> m c) -> m c
bracket :: m a -> (a -> m b) -> (a -> m c) -> m c
bracket m a
before a -> m b
after a -> m c
thing = ((forall a. m a -> IO a) -> IO c) -> m c
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO c) -> m c)
-> ((forall a. m a -> IO a) -> IO c) -> m c
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> ((forall a. IO a -> IO a) -> IO c) -> IO c
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
EUnsafe.mask (((forall a. IO a -> IO a) -> IO c) -> IO c)
-> ((forall a. IO a -> IO a) -> IO c) -> IO c
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
a
x <- m a -> IO a
forall a. m a -> IO a
run m a
before
Either SomeException c
res1 <- IO c -> IO (Either SomeException c)
forall e a. Exception e => IO a -> IO (Either e a)
EUnsafe.try (IO c -> IO (Either SomeException c))
-> IO c -> IO (Either SomeException c)
forall a b. (a -> b) -> a -> b
$ IO c -> IO c
forall a. IO a -> IO a
restore (IO c -> IO c) -> IO c -> IO c
forall a b. (a -> b) -> a -> b
$ m c -> IO c
forall a. m a -> IO a
run (m c -> IO c) -> m c -> IO c
forall a b. (a -> b) -> a -> b
$ a -> m c
thing a
x
case Either SomeException c
res1 of
Left (SomeException
e1 :: SomeException) -> do
Either SomeException b
_ :: Either SomeException b <-
IO b -> IO (Either SomeException b)
forall e a. Exception e => IO a -> IO (Either e a)
EUnsafe.try (IO b -> IO (Either SomeException b))
-> IO b -> IO (Either SomeException b)
forall a b. (a -> b) -> a -> b
$ IO b -> IO b
forall a. IO a -> IO a
EUnsafe.uninterruptibleMask_ (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ m b -> IO b
forall a. m a -> IO a
run (m b -> IO b) -> m b -> IO b
forall a b. (a -> b) -> a -> b
$ a -> m b
after a
x
SomeException -> IO c
forall e a. Exception e => e -> IO a
EUnsafe.throwIO SomeException
e1
Right c
y -> do
b
_ <- IO b -> IO b
forall a. IO a -> IO a
EUnsafe.uninterruptibleMask_ (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ m b -> IO b
forall a. m a -> IO a
run (m b -> IO b) -> m b -> IO b
forall a b. (a -> b) -> a -> b
$ a -> m b
after a
x
c -> IO c
forall (m :: * -> *) a. Monad m => a -> m a
return c
y
bracket_ :: MonadUnliftIO m => m a -> m b -> m c -> m c
bracket_ :: m a -> m b -> m c -> m c
bracket_ m a
before m b
after m c
thing = m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadUnliftIO 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)
bracketOnError :: MonadUnliftIO m => m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError :: m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError m a
before a -> m b
after a -> m c
thing = ((forall a. m a -> IO a) -> IO c) -> m c
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO c) -> m c)
-> ((forall a. m a -> IO a) -> IO c) -> m c
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> ((forall a. IO a -> IO a) -> IO c) -> IO c
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
EUnsafe.mask (((forall a. IO a -> IO a) -> IO c) -> IO c)
-> ((forall a. IO a -> IO a) -> IO c) -> IO c
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
a
x <- m a -> IO a
forall a. m a -> IO a
run m a
before
Either SomeException c
res1 <- IO c -> IO (Either SomeException c)
forall e a. Exception e => IO a -> IO (Either e a)
EUnsafe.try (IO c -> IO (Either SomeException c))
-> IO c -> IO (Either SomeException c)
forall a b. (a -> b) -> a -> b
$ IO c -> IO c
forall a. IO a -> IO a
restore (IO c -> IO c) -> IO c -> IO c
forall a b. (a -> b) -> a -> b
$ m c -> IO c
forall a. m a -> IO a
run (m c -> IO c) -> m c -> IO c
forall a b. (a -> b) -> a -> b
$ a -> m c
thing a
x
case Either SomeException c
res1 of
Left (SomeException
e1 :: SomeException) -> do
Either SomeException b
_ :: Either SomeException b <-
IO b -> IO (Either SomeException b)
forall e a. Exception e => IO a -> IO (Either e a)
EUnsafe.try (IO b -> IO (Either SomeException b))
-> IO b -> IO (Either SomeException b)
forall a b. (a -> b) -> a -> b
$ IO b -> IO b
forall a. IO a -> IO a
EUnsafe.uninterruptibleMask_ (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ m b -> IO b
forall a. m a -> IO a
run (m b -> IO b) -> m b -> IO b
forall a b. (a -> b) -> a -> b
$ a -> m b
after a
x
SomeException -> IO c
forall e a. Exception e => e -> IO a
EUnsafe.throwIO SomeException
e1
Right c
y -> c -> IO c
forall (m :: * -> *) a. Monad m => a -> m a
return c
y
bracketOnError_ :: MonadUnliftIO m => m a -> m b -> m c -> m c
bracketOnError_ :: m a -> m b -> m c -> m c
bracketOnError_ m a
before m b
after m c
thing = m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadUnliftIO 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)
finally
:: MonadUnliftIO m
=> m a
-> m b
-> m a
finally :: m a -> m b -> m a
finally m a
thing m b
after = ((forall a. m a -> IO a) -> IO a) -> m a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
EUnsafe.uninterruptibleMask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
Either SomeException a
res1 <- IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
EUnsafe.try (IO a -> IO (Either SomeException a))
-> IO a -> IO (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ IO a -> IO a
forall a. IO a -> IO a
restore (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ m a -> IO a
forall a. m a -> IO a
run m a
thing
case Either SomeException a
res1 of
Left (SomeException
e1 :: SomeException) -> do
Either SomeException b
_ :: Either SomeException b <- IO b -> IO (Either SomeException b)
forall e a. Exception e => IO a -> IO (Either e a)
EUnsafe.try (IO b -> IO (Either SomeException b))
-> IO b -> IO (Either SomeException b)
forall a b. (a -> b) -> a -> b
$ m b -> IO b
forall a. m a -> IO a
run m b
after
SomeException -> IO a
forall e a. Exception e => e -> IO a
EUnsafe.throwIO SomeException
e1
Right a
x -> do
b
_ <- m b -> IO b
forall a. m a -> IO a
run m b
after
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
withException :: (MonadUnliftIO m, Exception e)
=> m a -> (e -> m b) -> m a
withException :: m a -> (e -> m b) -> m a
withException m a
thing e -> m b
after = ((forall a. m a -> IO a) -> IO a) -> m a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
EUnsafe.uninterruptibleMask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
Either e a
res1 <- IO a -> IO (Either e a)
forall e a. Exception e => IO a -> IO (Either e a)
EUnsafe.try (IO a -> IO (Either e a)) -> IO a -> IO (Either e a)
forall a b. (a -> b) -> a -> b
$ IO a -> IO a
forall a. IO a -> IO a
restore (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ m a -> IO a
forall a. m a -> IO a
run m a
thing
case Either e a
res1 of
Left e
e1 -> do
Either SomeException b
_ :: Either SomeException b <- IO b -> IO (Either SomeException b)
forall e a. Exception e => IO a -> IO (Either e a)
EUnsafe.try (IO b -> IO (Either SomeException b))
-> IO b -> IO (Either SomeException b)
forall a b. (a -> b) -> a -> b
$ m b -> IO b
forall a. m a -> IO a
run (m b -> IO b) -> m b -> IO b
forall a b. (a -> b) -> a -> b
$ e -> m b
after e
e1
e -> IO a
forall e a. Exception e => e -> IO a
EUnsafe.throwIO e
e1
Right a
x -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
onException :: MonadUnliftIO m => m a -> m b -> m a
onException :: m a -> m b -> m a
onException m a
thing m b
after = m a -> (SomeException -> m b) -> m a
forall (m :: * -> *) e a b.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m b) -> m a
withException m a
thing (\(SomeException
_ :: SomeException) -> m b
after)
throwIO :: (MonadIO m, Exception e) => e -> m a
throwIO :: e -> m a
throwIO = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (e -> IO a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> IO a
forall e a. Exception e => e -> IO a
EUnsafe.throwIO (SomeException -> IO a) -> (e -> SomeException) -> e -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeException
forall e. Exception e => e -> SomeException
toSyncException
toSyncException :: Exception e => e -> SomeException
toSyncException :: e -> SomeException
toSyncException =
e -> SomeException
forall e. Exception e => e -> SomeException
ESafe.toSyncException
toAsyncException :: Exception e => e -> SomeException
toAsyncException :: e -> SomeException
toAsyncException =
e -> SomeException
forall e. Exception e => e -> SomeException
ESafe.toAsyncException
fromExceptionUnwrap :: Exception e => SomeException -> Maybe e
fromExceptionUnwrap :: SomeException -> Maybe e
fromExceptionUnwrap SomeException
se
| Just (ESafe.AsyncExceptionWrapper e
e) <- SomeException -> Maybe AsyncExceptionWrapper
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se = e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e
| Just (ESafe.SyncExceptionWrapper e
e) <- SomeException -> Maybe SyncExceptionWrapper
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se = e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e
| Bool
otherwise = SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se
isSyncException :: Exception e => e -> Bool
isSyncException :: e -> Bool
isSyncException =
e -> Bool
forall e. Exception e => e -> Bool
ESafe.isSyncException
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
mask :: MonadUnliftIO m => ((forall a. m a -> m a) -> m b) -> m b
mask :: ((forall a. m a -> m a) -> m b) -> m b
mask (forall a. m a -> m a) -> m b
f = ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO b) -> m b)
-> ((forall a. m a -> IO a) -> IO b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
EUnsafe.mask (((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
unmask ->
m b -> IO b
forall a. m a -> IO a
run (m b -> IO b) -> m b -> IO b
forall a b. (a -> b) -> a -> b
$ (forall a. m a -> m a) -> m b
f ((forall a. m a -> m a) -> m b) -> (forall a. m a -> m a) -> m b
forall a b. (a -> b) -> a -> b
$ IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (m a -> IO a) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO a
forall a. IO a -> IO a
unmask (IO a -> IO a) -> (m a -> IO a) -> m a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> IO a
forall a. m a -> IO a
run
uninterruptibleMask :: MonadUnliftIO m => ((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask :: ((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (forall a. m a -> m a) -> m b
f = ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO b) -> m b)
-> ((forall a. m a -> IO a) -> IO b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
EUnsafe.uninterruptibleMask (((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
unmask ->
m b -> IO b
forall a. m a -> IO a
run (m b -> IO b) -> m b -> IO b
forall a b. (a -> b) -> a -> b
$ (forall a. m a -> m a) -> m b
f ((forall a. m a -> m a) -> m b) -> (forall a. m a -> m a) -> m b
forall a b. (a -> b) -> a -> b
$ IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (m a -> IO a) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO a
forall a. IO a -> IO a
unmask (IO a -> IO a) -> (m a -> IO a) -> m a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> IO a
forall a. m a -> IO a
run
mask_ :: MonadUnliftIO m => m a -> m a
mask_ :: m a -> m a
mask_ m a
f = ((forall a. m a -> IO a) -> IO a) -> m a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> IO a -> IO a
forall a. IO a -> IO a
EUnsafe.mask_ (m a -> IO a
forall a. m a -> IO a
run m a
f)
uninterruptibleMask_ :: MonadUnliftIO m => m a -> m a
uninterruptibleMask_ :: m a -> m a
uninterruptibleMask_ m a
f = ((forall a. m a -> IO a) -> IO a) -> m a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> IO a -> IO a
forall a. IO a -> IO a
EUnsafe.uninterruptibleMask_ (m a -> IO a
forall a. m a -> IO a
run m a
f)
#if MIN_VERSION_base(4,9,0)
throwString :: (MonadIO m, HasCallStack) => String -> m a
throwString :: String -> m a
throwString String
s = StringException -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (String -> CallStack -> StringException
StringException String
s ?callStack::CallStack
CallStack
?callStack)
#else
throwString :: MonadIO m => String -> m a
throwString s = throwIO (StringException s ())
#endif
#if MIN_VERSION_base(4,9,0)
stringException :: HasCallStack => String -> StringException
stringException :: String -> StringException
stringException String
s = String -> CallStack -> StringException
StringException String
s ?callStack::CallStack
CallStack
?callStack
#else
stringException :: String -> StringException
stringException s = 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 String
s CallStack
cs) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
"UnliftIO.Exception.throwString called with:\n\n"
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
s
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"\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 (String
x, SrcLoc
y) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
" "
, String
x
, String
" ("
, SrcLoc -> String
prettySrcLoc SrcLoc
y
, String
")\n"
]
#else
data StringException = StringException String ()
deriving Typeable
instance Show StringException where
show (StringException s _) = "UnliftIO.Exception.throwString called with:\n\n" ++ s
#endif
instance Eq StringException where
StringException String
msg1 CallStack
_ == :: StringException -> StringException -> Bool
== StringException String
msg2 CallStack
_ = String
msg1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
msg2
instance Exception StringException
throwTo :: (Exception e, MonadIO m) => ThreadId -> e -> m ()
throwTo :: ThreadId -> e -> m ()
throwTo 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 ()
EUnsafe.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
EUnsafe.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
fromEither :: (Exception e, MonadIO m) => Either e a -> m a
fromEither :: Either e a -> m a
fromEither = (e -> m a) -> (a -> m a) -> Either e a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
fromEitherIO :: (Exception e, MonadIO m) => IO (Either e a) -> m a
fromEitherIO :: IO (Either e a) -> m a
fromEitherIO = m (Either e a) -> m a
forall e (m :: * -> *) a.
(Exception e, MonadIO m) =>
m (Either e a) -> m a
fromEitherM (m (Either e a) -> m a)
-> (IO (Either e a) -> m (Either e a)) -> IO (Either e a) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either e a) -> m (Either e a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
fromEitherM :: (Exception e, MonadIO m) => m (Either e a) -> m a
fromEitherM :: m (Either e a) -> m a
fromEitherM = (m (Either e a) -> (Either e a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either e a -> m a
forall e (m :: * -> *) a.
(Exception e, MonadIO m) =>
Either e a -> m a
fromEither)
mapExceptionM :: (Exception e1, Exception e2, MonadUnliftIO m) => (e1 -> e2) -> m a -> m a
mapExceptionM :: (e1 -> e2) -> m a -> m a
mapExceptionM e1 -> e2
f = (e1 -> m a) -> m a -> m a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
handle (e2 -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (e2 -> m a) -> (e1 -> e2) -> e1 -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e1 -> e2
f)