{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples #-}
#if !MIN_VERSION_base(4,9,0)
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ImplicitParams #-}
#endif
module Control.Prim.Exception
(
module Control.Prim.Monad.Throw
, throw
, throwTo
, impureThrow
, catch
, catchAny
, catchAnySync
, catchAll
, catchAllSync
, try
, tryAny
, tryAnySync
, onException
, withException
, withAnyException
, finally
, bracket
, bracket_
, bracketOnError
, ufinally
, ubracket
, ubracket_
, ubracketOnError
, mask
, mask_
, maskPrimBase_
, uninterruptibleMask
, uninterruptibleMask_
, uninterruptibleMaskPrimBase_
, maskAsyncExceptions
, unmaskAsyncExceptions
, maskUninterruptible
, GHC.MaskingState(..)
, getMaskingState
, GHC.Exception(..)
, GHC.SomeException
, GHC.AsyncException(..)
, GHC.SomeAsyncException(..)
, isSyncException
, isAsyncException
, GHC.asyncExceptionToException
, GHC.asyncExceptionFromException
, GHC.ErrorCall(..)
, GHC.ArithException(..)
, GHC.ArrayException(..)
, GHC.AssertionFailed(..)
, GHC.IOException
, GHC.NonTermination(..)
, GHC.NestedAtomically(..)
, GHC.BlockedIndefinitelyOnMVar(..)
, GHC.BlockedIndefinitelyOnSTM(..)
, GHC.AllocationLimitExceeded(..)
, GHC.Deadlock(..)
, CallStack
, HasCallStack
, callStack
, getCallStack
, prettyCallStack
, SrcLoc(..)
, prettySrcLoc
, module Control.Prim.Monad
) where
import qualified Control.Exception as GHC
import Control.Prim.Monad
import Control.Prim.Monad.Throw
import Control.Prim.Monad.Unsafe
import qualified GHC.Conc as GHC
import GHC.Exts
import GHC.Stack
#if !MIN_VERSION_base(4,9,0)
import Data.List (intercalate)
import GHC.SrcLoc
#endif
isSyncException :: GHC.Exception e => e -> Bool
isSyncException :: e -> Bool
isSyncException = 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
isAsyncException
{-# INLINE isSyncException #-}
isAsyncException :: GHC.Exception e => e -> Bool
isAsyncException :: e -> Bool
isAsyncException e
exc =
case SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
GHC.fromException (e -> SomeException
forall e. Exception e => e -> SomeException
GHC.toException e
exc) of
Just (GHC.SomeAsyncException e
_) -> Bool
True
Maybe SomeAsyncException
Nothing -> Bool
False
{-# INLINE isAsyncException #-}
throw :: (GHC.Exception e, MonadPrim s m) => e -> m a
throw :: e -> m a
throw e
e = (State# RealWorld -> (# State# RealWorld, a #)) -> m a
forall s (m :: * -> *) s' a.
MonadPrim s m =>
(State# s' -> (# State# s', a #)) -> m a
unsafePrim (SomeException -> State# RealWorld -> (# State# RealWorld, a #)
forall a b. a -> State# RealWorld -> (# State# RealWorld, b #)
raiseIO# (e -> SomeException
forall e. Exception e => e -> SomeException
GHC.toException e
e))
impureThrow :: GHC.Exception e => e -> a
impureThrow :: e -> a
impureThrow e
e = SomeException -> a
forall b a. b -> a
raise# (e -> SomeException
forall e. Exception e => e -> SomeException
GHC.toException e
e)
throwTo :: (MonadPrim s m, GHC.Exception e) => GHC.ThreadId -> e -> m ()
throwTo :: ThreadId -> e -> m ()
throwTo ThreadId
tid e
e =
IO () -> m ()
forall s (m :: * -> *) a. MonadPrim s m => IO a -> m a
unsafeIOToPrim (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
ThreadId -> SomeException -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
GHC.throwTo ThreadId
tid (SomeException -> IO ()) -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$
if e -> Bool
forall e. Exception e => e -> Bool
isAsyncException e
e
then e -> SomeException
forall e. Exception e => e -> SomeException
GHC.toException e
e
else SomeAsyncException -> SomeException
forall e. Exception e => e -> SomeException
GHC.toException (SomeAsyncException -> SomeException)
-> SomeAsyncException -> SomeException
forall a b. (a -> b) -> a -> b
$ e -> SomeAsyncException
forall e. Exception e => e -> SomeAsyncException
GHC.SomeAsyncException e
e
catch ::
forall e a m. (GHC.Exception e, MonadUnliftPrim RW m)
=> m a
-> (e -> m a)
-> m a
catch :: m a -> (e -> m a) -> m a
catch m a
action e -> m a
handler =
(() -> m a)
-> (e -> m a)
-> ((() -> State# RealWorld -> (# State# RealWorld, a #))
-> (e -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #))
-> m a
forall s (m :: * -> *) a b c d e.
MonadUnliftPrim s m =>
(a -> m b)
-> (c -> m d)
-> ((a -> State# s -> (# State# s, b #))
-> (c -> State# s -> (# State# s, d #))
-> State# s
-> (# State# s, e #))
-> m e
runInPrimBase2 (m a -> () -> m a
forall a b. a -> b -> a
const m a
action) e -> m a
handler (((() -> State# RealWorld -> (# State# RealWorld, a #))
-> (e -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #))
-> m a)
-> ((() -> State# RealWorld -> (# State# RealWorld, a #))
-> (e -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #))
-> m a
forall a b. (a -> b) -> a -> b
$ \() -> State# RealWorld -> (# State# RealWorld, a #)
action# e -> State# RealWorld -> (# State# RealWorld, a #)
handler# ->
let handler'# :: GHC.SomeException -> (State# RW -> (# State# RW, a #))
handler'# :: SomeException -> State# RealWorld -> (# State# RealWorld, a #)
handler'# SomeException
someExc =
case SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
GHC.fromException SomeException
someExc of
Just e
exc -> e -> State# RealWorld -> (# State# RealWorld, a #)
handler# e
exc
Maybe e
Nothing -> SomeException -> State# RealWorld -> (# State# RealWorld, a #)
forall a b. a -> State# RealWorld -> (# State# RealWorld, b #)
raiseIO# SomeException
someExc
in (State# RealWorld -> (# State# RealWorld, a #))
-> (SomeException -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #)
forall a b.
(State# RealWorld -> (# State# RealWorld, a #))
-> (b -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #)
catch# (() -> State# RealWorld -> (# State# RealWorld, a #)
action# ()) SomeException -> State# RealWorld -> (# State# RealWorld, a #)
handler'#
catchAny ::
forall a m. MonadUnliftPrim RW m
=> m a
-> (GHC.SomeException -> m a)
-> m a
catchAny :: m a -> (SomeException -> m a) -> m a
catchAny m a
action SomeException -> m a
handler =
(() -> m a)
-> (SomeException -> m a)
-> ((() -> State# RealWorld -> (# State# RealWorld, a #))
-> (SomeException -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #))
-> m a
forall s (m :: * -> *) a b c d e.
MonadUnliftPrim s m =>
(a -> m b)
-> (c -> m d)
-> ((a -> State# s -> (# State# s, b #))
-> (c -> State# s -> (# State# s, d #))
-> State# s
-> (# State# s, e #))
-> m e
runInPrimBase2 (m a -> () -> m a
forall a b. a -> b -> a
const m a
action) SomeException -> m a
handler (((() -> State# RealWorld -> (# State# RealWorld, a #))
-> (SomeException -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #))
-> m a)
-> ((() -> State# RealWorld -> (# State# RealWorld, a #))
-> (SomeException -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #))
-> m a
forall a b. (a -> b) -> a -> b
$ \() -> State# RealWorld -> (# State# RealWorld, a #)
action# SomeException -> State# RealWorld -> (# State# RealWorld, a #)
handler# ->
(State# RealWorld -> (# State# RealWorld, a #))
-> (SomeException -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #)
forall a b.
(State# RealWorld -> (# State# RealWorld, a #))
-> (b -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #)
catch# (() -> State# RealWorld -> (# State# RealWorld, a #)
action# ()) SomeException -> State# RealWorld -> (# State# RealWorld, a #)
handler#
catchAnySync ::
forall a m. MonadUnliftPrim RW m
=> m a
-> (GHC.SomeException -> m a)
-> m a
catchAnySync :: m a -> (SomeException -> m a) -> m a
catchAnySync m a
action SomeException -> m a
handler =
m a -> (SomeException -> m a) -> m a
forall a (m :: * -> *).
MonadUnliftPrim RealWorld m =>
m a -> (SomeException -> m a) -> m a
catchAny m a
action ((SomeException -> m a) -> m a) -> (SomeException -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \SomeException
exc ->
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SomeException -> Bool
forall e. Exception e => e -> Bool
isAsyncException SomeException
exc) (SomeException -> m ()
forall e s (m :: * -> *) a.
(Exception e, MonadPrim s m) =>
e -> m a
throw SomeException
exc) m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> m a
handler SomeException
exc
catchAll ::
forall a m. MonadUnliftPrim RW m
=> m a
-> (forall e . GHC.Exception e => e -> m a)
-> m a
catchAll :: m a -> (forall e. Exception e => e -> m a) -> m a
catchAll m a
action forall e. Exception e => e -> m a
handler =
(() -> m a)
-> (SomeException -> m a)
-> ((() -> State# RealWorld -> (# State# RealWorld, a #))
-> (SomeException -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #))
-> m a
forall s (m :: * -> *) a b c d e.
MonadUnliftPrim s m =>
(a -> m b)
-> (c -> m d)
-> ((a -> State# s -> (# State# s, b #))
-> (c -> State# s -> (# State# s, d #))
-> State# s
-> (# State# s, e #))
-> m e
runInPrimBase2
(m a -> () -> m a
forall a b. a -> b -> a
const m a
action)
(\(GHC.SomeException e
e) -> e -> m a
forall e. Exception e => e -> m a
handler e
e)
(\() -> State# RealWorld -> (# State# RealWorld, a #)
action# SomeException -> State# RealWorld -> (# State# RealWorld, a #)
handler# -> (State# RealWorld -> (# State# RealWorld, a #))
-> (SomeException -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #)
forall a b.
(State# RealWorld -> (# State# RealWorld, a #))
-> (b -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #)
catch# (() -> State# RealWorld -> (# State# RealWorld, a #)
action# ()) SomeException -> State# RealWorld -> (# State# RealWorld, a #)
handler#)
catchAllSync ::
forall a m. MonadUnliftPrim RW m
=> m a
-> (forall e . GHC.Exception e => e -> m a)
-> m a
catchAllSync :: m a -> (forall e. Exception e => e -> m a) -> m a
catchAllSync m a
action forall e. Exception e => e -> m a
handler =
m a -> (forall e. Exception e => e -> m a) -> m a
forall a (m :: * -> *).
MonadUnliftPrim RealWorld m =>
m a -> (forall e. Exception e => e -> m a) -> m a
catchAll m a
action ((forall e. Exception e => e -> m a) -> m a)
-> (forall e. Exception e => e -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \e
exc ->
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (e -> Bool
forall e. Exception e => e -> Bool
isAsyncException e
exc) (e -> m ()
forall e s (m :: * -> *) a.
(Exception e, MonadPrim s m) =>
e -> m a
throw e
exc) m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> e -> m a
forall e. Exception e => e -> m a
handler e
exc
try :: (GHC.Exception e, MonadUnliftPrim RW m) => 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 e a (m :: * -> *).
(Exception e, MonadUnliftPrim RealWorld m) =>
m a -> (e -> m a) -> m a
catch ((a -> Either e a) -> m a -> m (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either e a
forall a b. b -> Either a b
Right m a
f) (Either e a -> m (Either e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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)
tryAny :: MonadUnliftPrim RW m => m a -> m (Either GHC.SomeException a)
tryAny :: m a -> m (Either SomeException a)
tryAny m a
f = m (Either SomeException a)
-> (SomeException -> m (Either SomeException a))
-> m (Either SomeException a)
forall a (m :: * -> *).
MonadUnliftPrim RealWorld m =>
m a -> (SomeException -> m a) -> m a
catchAny (a -> Either SomeException a
forall a b. b -> Either a b
Right (a -> Either SomeException a) -> m a -> m (Either SomeException a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
f) (Either SomeException a -> m (Either SomeException a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException a -> m (Either SomeException a))
-> (SomeException -> Either SomeException a)
-> SomeException
-> m (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)
tryAnySync :: MonadUnliftPrim RW m => m a -> m (Either GHC.SomeException a)
tryAnySync :: m a -> m (Either SomeException a)
tryAnySync m a
f = m (Either SomeException a)
-> (SomeException -> m (Either SomeException a))
-> m (Either SomeException a)
forall a (m :: * -> *).
MonadUnliftPrim RealWorld m =>
m a -> (SomeException -> m a) -> m a
catchAnySync (a -> Either SomeException a
forall a b. b -> Either a b
Right (a -> Either SomeException a) -> m a -> m (Either SomeException a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
f) (Either SomeException a -> m (Either SomeException a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException a -> m (Either SomeException a))
-> (SomeException -> Either SomeException a)
-> SomeException
-> m (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)
withException ::
(MonadUnliftPrim RW m, GHC.Exception e) => m a -> (e -> m b) -> m a
withException :: m a -> (e -> m b) -> m a
withException m a
action e -> m b
handler =
((forall b. m b -> m b) -> m a) -> m a
forall a (m :: * -> *) s.
MonadUnliftPrim s m =>
((forall b. m b -> m b) -> m a) -> m a
mask (((forall b. m b -> m b) -> m a) -> m a)
-> ((forall b. m b -> m b) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall b. m b -> m b
restore -> do
m a -> (e -> m a) -> m a
forall e a (m :: * -> *).
(Exception e, MonadUnliftPrim RealWorld m) =>
m a -> (e -> m a) -> m a
catch
(m a -> m a
forall b. m b -> m b
restore m a
action)
(\e
exc -> m () -> (SomeException -> m ()) -> m ()
forall a (m :: * -> *).
MonadUnliftPrim RealWorld m =>
m a -> (SomeException -> m a) -> m a
catchAnySync (m b -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m b -> m ()) -> m b -> m ()
forall a b. (a -> b) -> a -> b
$ e -> m b
handler e
exc) (\SomeException
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> e -> m a
forall e s (m :: * -> *) a.
(Exception e, MonadPrim s m) =>
e -> m a
throw e
exc)
withAnyException :: MonadUnliftPrim RW m => m a -> (GHC.SomeException -> m b) -> m a
withAnyException :: m a -> (SomeException -> m b) -> m a
withAnyException m a
thing SomeException -> m b
after =
((forall b. m b -> m b) -> m a) -> m a
forall a (m :: * -> *) s.
MonadUnliftPrim s m =>
((forall b. m b -> m b) -> m a) -> m a
mask (((forall b. m b -> m b) -> m a) -> m a)
-> ((forall b. m b -> m b) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall b. m b -> m b
restore -> do
m a -> (SomeException -> m a) -> m a
forall a (m :: * -> *).
MonadUnliftPrim RealWorld m =>
m a -> (SomeException -> m a) -> m a
catchAny
(m a -> m a
forall b. m b -> m b
restore m a
thing)
(\SomeException
exc -> m () -> (SomeException -> m ()) -> m ()
forall a (m :: * -> *).
MonadUnliftPrim RealWorld m =>
m a -> (SomeException -> m a) -> m a
catchAnySync (m b -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m b -> m ()) -> m b -> m ()
forall a b. (a -> b) -> a -> b
$ SomeException -> m b
after SomeException
exc) (\SomeException
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> m a
forall e s (m :: * -> *) a.
(Exception e, MonadPrim s m) =>
e -> m a
throw SomeException
exc)
onException :: MonadUnliftPrim RW 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 :: * -> *) a b.
MonadUnliftPrim RealWorld m =>
m a -> (SomeException -> m b) -> m a
withAnyException m a
thing (m b -> SomeException -> m b
forall a b. a -> b -> a
const m b
after)
bracket :: MonadUnliftPrim RW 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
acquire a -> m b
cleanup a -> m c
action =
((forall b. m b -> m b) -> m c) -> m c
forall a (m :: * -> *) s.
MonadUnliftPrim s m =>
((forall b. m b -> m b) -> m a) -> m a
mask (((forall b. m b -> m b) -> m c) -> m c)
-> ((forall b. m b -> m b) -> m c) -> m c
forall a b. (a -> b) -> a -> b
$ \forall b. m b -> m b
restore -> do
a
resource <- m a
acquire
c
result <-
m c -> (SomeException -> m c) -> m c
forall a (m :: * -> *).
MonadUnliftPrim RealWorld m =>
m a -> (SomeException -> m a) -> m a
catchAny (m c -> m c
forall b. m b -> m b
restore (a -> m c
action a
resource)) ((SomeException -> m c) -> m c) -> (SomeException -> m c) -> m c
forall a b. (a -> b) -> a -> b
$ \SomeException
exc -> do
m () -> (SomeException -> m ()) -> m ()
forall a (m :: * -> *).
MonadUnliftPrim RealWorld m =>
m a -> (SomeException -> m a) -> m a
catchAnySync (m b -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m b -> m ()) -> m b -> m ()
forall a b. (a -> b) -> a -> b
$ a -> m b
cleanup a
resource) ((SomeException -> m ()) -> m ())
-> (SomeException -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SomeException
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
SomeException -> m c
forall e s (m :: * -> *) a.
(Exception e, MonadPrim s m) =>
e -> m a
throw SomeException
exc
c
result c -> m b -> m c
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ a -> m b
cleanup a
resource
{-# INLINEABLE bracket #-}
bracketOnError :: MonadUnliftPrim RW 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
acquire a -> m b
cleanup a -> m c
action =
((forall b. m b -> m b) -> m c) -> m c
forall a (m :: * -> *) s.
MonadUnliftPrim s m =>
((forall b. m b -> m b) -> m a) -> m a
mask (((forall b. m b -> m b) -> m c) -> m c)
-> ((forall b. m b -> m b) -> m c) -> m c
forall a b. (a -> b) -> a -> b
$ \forall b. m b -> m b
restore -> do
a
resource <- m a
acquire
m c -> (SomeException -> m c) -> m c
forall a (m :: * -> *).
MonadUnliftPrim RealWorld m =>
m a -> (SomeException -> m a) -> m a
catchAny (m c -> m c
forall b. m b -> m b
restore (a -> m c
action a
resource)) ((SomeException -> m c) -> m c) -> (SomeException -> m c) -> m c
forall a b. (a -> b) -> a -> b
$ \SomeException
exc -> do
m () -> (SomeException -> m ()) -> m ()
forall a (m :: * -> *).
MonadUnliftPrim RealWorld m =>
m a -> (SomeException -> m a) -> m a
catchAnySync (m b -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m b -> m ()) -> m b -> m ()
forall a b. (a -> b) -> a -> b
$ a -> m b
cleanup a
resource) ((SomeException -> m ()) -> m ())
-> (SomeException -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SomeException
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
SomeException -> m c
forall e s (m :: * -> *) a.
(Exception e, MonadPrim s m) =>
e -> m a
throw SomeException
exc
finally :: MonadUnliftPrim RW m => m a -> m b -> m a
finally :: m a -> m b -> m a
finally m a
action m b
cleanup =
((forall b. m b -> m b) -> m a) -> m a
forall a (m :: * -> *) s.
MonadUnliftPrim s m =>
((forall b. m b -> m b) -> m a) -> m a
mask (((forall b. m b -> m b) -> m a) -> m a)
-> ((forall b. m b -> m b) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall b. m b -> m b
restore -> do
a
result <-
m a -> (SomeException -> m a) -> m a
forall a (m :: * -> *).
MonadUnliftPrim RealWorld m =>
m a -> (SomeException -> m a) -> m a
catchAny (m a -> m a
forall b. m b -> m b
restore m a
action) ((SomeException -> m a) -> m a) -> (SomeException -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \SomeException
exc -> do
m () -> (SomeException -> m ()) -> m ()
forall a (m :: * -> *).
MonadUnliftPrim RealWorld m =>
m a -> (SomeException -> m a) -> m a
catchAnySync (m b -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m b
cleanup) ((SomeException -> m ()) -> m ())
-> (SomeException -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SomeException
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
SomeException -> m a
forall e s (m :: * -> *) a.
(Exception e, MonadPrim s m) =>
e -> m a
throw SomeException
exc
a
result a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m b
cleanup
bracket_ :: MonadUnliftPrim RW m => m a -> m b -> m c -> m c
bracket_ :: m a -> m b -> m c -> m c
bracket_ m a
acquire m b
cleanup m c
action = m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadUnliftPrim RealWorld m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m a
acquire (m b -> a -> m b
forall a b. a -> b -> a
const m b
cleanup) (m c -> a -> m c
forall a b. a -> b -> a
const m c
action)
ubracket :: MonadUnliftPrim RW m => m a -> (a -> m b) -> (a -> m c) -> m c
ubracket :: m a -> (a -> m b) -> (a -> m c) -> m c
ubracket m a
acquire a -> m b
cleanup a -> m c
action =
((forall b. m b -> m b) -> m c) -> m c
forall a (m :: * -> *) s.
MonadUnliftPrim s m =>
((forall b. m b -> m b) -> m a) -> m a
uninterruptibleMask (((forall b. m b -> m b) -> m c) -> m c)
-> ((forall b. m b -> m b) -> m c) -> m c
forall a b. (a -> b) -> a -> b
$ \forall b. m b -> m b
restore ->
m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadUnliftPrim RealWorld m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (m a -> m a
forall b. m b -> m b
restore m a
acquire) a -> m b
cleanup (m c -> m c
forall b. m b -> m b
restore (m c -> m c) -> (a -> m c) -> a -> m c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m c
action)
ubracket_ :: MonadUnliftPrim RW m => m a -> m b -> m c -> m c
ubracket_ :: m a -> m b -> m c -> m c
ubracket_ m a
acquire m b
cleanup m c
action = m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadUnliftPrim RealWorld m =>
m a -> (a -> m b) -> (a -> m c) -> m c
ubracket m a
acquire (m b -> a -> m b
forall a b. a -> b -> a
const m b
cleanup) (m c -> a -> m c
forall a b. a -> b -> a
const m c
action)
ubracketOnError :: MonadUnliftPrim RW m => m a -> (a -> m b) -> (a -> m c) -> m c
ubracketOnError :: m a -> (a -> m b) -> (a -> m c) -> m c
ubracketOnError m a
acquire a -> m b
cleanup a -> m c
action =
((forall b. m b -> m b) -> m c) -> m c
forall a (m :: * -> *) s.
MonadUnliftPrim s m =>
((forall b. m b -> m b) -> m a) -> m a
uninterruptibleMask (((forall b. m b -> m b) -> m c) -> m c)
-> ((forall b. m b -> m b) -> m c) -> m c
forall a b. (a -> b) -> a -> b
$ \forall b. m b -> m b
restore ->
m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadUnliftPrim RealWorld m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError (m a -> m a
forall b. m b -> m b
restore m a
acquire) a -> m b
cleanup (m c -> m c
forall b. m b -> m b
restore (m c -> m c) -> (a -> m c) -> a -> m c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m c
action)
ufinally :: MonadUnliftPrim RW m => m a -> m b -> m a
ufinally :: m a -> m b -> m a
ufinally m a
action m b
cleanup =
((forall b. m b -> m b) -> m a) -> m a
forall a (m :: * -> *) s.
MonadUnliftPrim s m =>
((forall b. m b -> m b) -> m a) -> m a
uninterruptibleMask (((forall b. m b -> m b) -> m a) -> m a)
-> ((forall b. m b -> m b) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall b. m b -> m b
restore -> m a -> m b -> m a
forall (m :: * -> *) a b.
MonadUnliftPrim RealWorld m =>
m a -> m b -> m a
finally (m a -> m a
forall b. m b -> m b
restore m a
action) m b
cleanup
mask_ :: forall a m s. MonadUnliftPrim s m => m a -> m a
mask_ :: m a -> m a
mask_ m a
action =
IO MaskingState -> m MaskingState
forall s (m :: * -> *) a. MonadPrim s m => IO a -> m a
unsafeIOToPrim IO MaskingState
forall (m :: * -> *). MonadPrim RealWorld m => m MaskingState
getMaskingState m MaskingState -> (MaskingState -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
MaskingState
GHC.Unmasked -> m a
-> ((State# s -> (# State# s, a #))
-> State# s -> (# State# s, a #))
-> m a
forall s (m :: * -> *) a b.
MonadUnliftPrim s m =>
m a
-> ((State# s -> (# State# s, a #))
-> State# s -> (# State# s, b #))
-> m b
runInPrimBase m a
action (State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
forall s a.
(State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
maskAsyncExceptionsInternal#
MaskingState
_ -> m a
action
{-# INLINEABLE mask_ #-}
maskPrimBase_ :: forall a n m s. (MonadPrim s m, MonadPrimBase s n) => n a -> m a
maskPrimBase_ :: n a -> m a
maskPrimBase_ n a
action =
IO MaskingState -> m MaskingState
forall s (m :: * -> *) a. MonadPrim s m => IO a -> m a
unsafeIOToPrim IO MaskingState
forall (m :: * -> *). MonadPrim RealWorld m => m MaskingState
getMaskingState m MaskingState -> (MaskingState -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
MaskingState
GHC.Unmasked -> (State# s -> (# State# s, a #)) -> m a
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
forall s a.
(State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
maskAsyncExceptionsInternal# (n a -> State# s -> (# State# s, a #)
forall s (m :: * -> *) a.
MonadPrimBase s m =>
m a -> State# s -> (# State# s, a #)
primBase n a
action))
MaskingState
_ -> n a -> m a
forall s (n :: * -> *) (m :: * -> *) a.
(MonadPrimBase s n, MonadPrim s m) =>
n a -> m a
liftPrimBase n a
action
{-# INLINEABLE maskPrimBase_ #-}
mask ::
forall a m s. MonadUnliftPrim s m
=> ((forall b. m b -> m b) -> m a)
-> m a
mask :: ((forall b. m b -> m b) -> m a) -> m a
mask (forall b. m b -> m b) -> m a
action = do
IO MaskingState -> m MaskingState
forall s (m :: * -> *) a. MonadPrim s m => IO a -> m a
unsafeIOToPrim IO MaskingState
forall (m :: * -> *). MonadPrim RealWorld m => m MaskingState
getMaskingState m MaskingState -> (MaskingState -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
MaskingState
GHC.Unmasked ->
m a
-> ((State# s -> (# State# s, a #))
-> State# s -> (# State# s, a #))
-> m a
forall s (m :: * -> *) a b.
MonadUnliftPrim s m =>
m a
-> ((State# s -> (# State# s, a #))
-> State# s -> (# State# s, b #))
-> m b
runInPrimBase
((forall b. m b -> m b) -> m a
action (m b
-> ((State# s -> (# State# s, b #))
-> State# s -> (# State# s, b #))
-> m b
forall s (m :: * -> *) a b.
MonadUnliftPrim s m =>
m a
-> ((State# s -> (# State# s, a #))
-> State# s -> (# State# s, b #))
-> m b
`runInPrimBase` (State# s -> (# State# s, b #)) -> State# s -> (# State# s, b #)
forall s a.
(State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
unmaskAsyncExceptionsInternal#))
(State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
forall s a.
(State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
maskAsyncExceptionsInternal#
MaskingState
GHC.MaskedInterruptible ->
(forall b. m b -> m b) -> m a
action (m b
-> ((State# s -> (# State# s, b #))
-> State# s -> (# State# s, b #))
-> m b
forall s (m :: * -> *) a b.
MonadUnliftPrim s m =>
m a
-> ((State# s -> (# State# s, a #))
-> State# s -> (# State# s, b #))
-> m b
`runInPrimBase` (State# s -> (# State# s, b #)) -> State# s -> (# State# s, b #)
forall s a.
(State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
maskAsyncExceptionsInternal#)
MaskingState
GHC.MaskedUninterruptible -> (forall b. m b -> m b) -> m a
action forall b. m b -> m b
forall a (m :: * -> *) s. MonadUnliftPrim s m => m a -> m a
uninterruptibleMask_
{-# INLINEABLE mask #-}
uninterruptibleMask ::
forall a m s. MonadUnliftPrim s m
=> ((forall b. m b -> m b) -> m a)
-> m a
uninterruptibleMask :: ((forall b. m b -> m b) -> m a) -> m a
uninterruptibleMask (forall b. m b -> m b) -> m a
action = do
IO MaskingState -> m MaskingState
forall s (m :: * -> *) a. MonadPrim s m => IO a -> m a
unsafeIOToPrim IO MaskingState
forall (m :: * -> *). MonadPrim RealWorld m => m MaskingState
getMaskingState m MaskingState -> (MaskingState -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
MaskingState
GHC.Unmasked ->
m a
-> ((State# s -> (# State# s, a #))
-> State# s -> (# State# s, a #))
-> m a
forall s (m :: * -> *) a b.
MonadUnliftPrim s m =>
m a
-> ((State# s -> (# State# s, a #))
-> State# s -> (# State# s, b #))
-> m b
runInPrimBase
((forall b. m b -> m b) -> m a
action (m b
-> ((State# s -> (# State# s, b #))
-> State# s -> (# State# s, b #))
-> m b
forall s (m :: * -> *) a b.
MonadUnliftPrim s m =>
m a
-> ((State# s -> (# State# s, a #))
-> State# s -> (# State# s, b #))
-> m b
`runInPrimBase` (State# s -> (# State# s, b #)) -> State# s -> (# State# s, b #)
forall s a.
(State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
unmaskAsyncExceptionsInternal#))
(State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
forall s a.
(State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
maskAsyncExceptionsInternal#
MaskingState
GHC.MaskedInterruptible ->
(forall b. m b -> m b) -> m a
action (m b
-> ((State# s -> (# State# s, b #))
-> State# s -> (# State# s, b #))
-> m b
forall s (m :: * -> *) a b.
MonadUnliftPrim s m =>
m a
-> ((State# s -> (# State# s, a #))
-> State# s -> (# State# s, b #))
-> m b
`runInPrimBase` (State# s -> (# State# s, b #)) -> State# s -> (# State# s, b #)
forall s a.
(State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
maskAsyncExceptionsInternal#)
MaskingState
GHC.MaskedUninterruptible -> (forall b. m b -> m b) -> m a
action forall b. m b -> m b
forall a (m :: * -> *) s. MonadUnliftPrim s m => m a -> m a
uninterruptibleMask_
{-# INLINEABLE uninterruptibleMask #-}
uninterruptibleMask_ :: forall a m s. MonadUnliftPrim s m => m a -> m a
uninterruptibleMask_ :: m a -> m a
uninterruptibleMask_ m a
action = m a
-> ((State# s -> (# State# s, a #))
-> State# s -> (# State# s, a #))
-> m a
forall s (m :: * -> *) a b.
MonadUnliftPrim s m =>
m a
-> ((State# s -> (# State# s, a #))
-> State# s -> (# State# s, b #))
-> m b
runInPrimBase m a
action (State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
forall s a.
(State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
maskUninterruptibleInternal#
{-# INLINEABLE uninterruptibleMask_ #-}
uninterruptibleMaskPrimBase_ :: forall a n m s. (MonadPrimBase s n, MonadPrim s m) => n a -> m a
uninterruptibleMaskPrimBase_ :: n a -> m a
uninterruptibleMaskPrimBase_ n a
action = (State# s -> (# State# s, a #)) -> m a
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
forall s a.
(State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
maskUninterruptibleInternal# (n a -> State# s -> (# State# s, a #)
forall s (m :: * -> *) a.
MonadPrimBase s m =>
m a -> State# s -> (# State# s, a #)
primBase n a
action))
{-# INLINEABLE uninterruptibleMaskPrimBase_ #-}
maskAsyncExceptions :: forall a m. MonadUnliftPrim RW m => m a -> m a
maskAsyncExceptions :: m a -> m a
maskAsyncExceptions m a
action = m a
-> ((State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #))
-> m a
forall s (m :: * -> *) a b.
MonadUnliftPrim s m =>
m a
-> ((State# s -> (# State# s, a #))
-> State# s -> (# State# s, b #))
-> m b
runInPrimBase m a
action (State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
forall a.
(State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
maskAsyncExceptions#
{-# INLINEABLE maskAsyncExceptions #-}
unmaskAsyncExceptions :: forall a m. MonadUnliftPrim RW m => m a -> m a
unmaskAsyncExceptions :: m a -> m a
unmaskAsyncExceptions m a
action = m a
-> ((State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #))
-> m a
forall s (m :: * -> *) a b.
MonadUnliftPrim s m =>
m a
-> ((State# s -> (# State# s, a #))
-> State# s -> (# State# s, b #))
-> m b
runInPrimBase m a
action (State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
forall a.
(State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
unmaskAsyncExceptions#
{-# INLINEABLE unmaskAsyncExceptions #-}
maskUninterruptible :: forall a m. MonadUnliftPrim RW m => m a -> m a
maskUninterruptible :: m a -> m a
maskUninterruptible m a
action = m a
-> ((State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #))
-> m a
forall s (m :: * -> *) a b.
MonadUnliftPrim s m =>
m a
-> ((State# s -> (# State# s, a #))
-> State# s -> (# State# s, b #))
-> m b
runInPrimBase m a
action (State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
forall a.
(State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
maskUninterruptible#
{-# INLINEABLE maskUninterruptible #-}
maskAsyncExceptionsInternal# :: (State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
maskAsyncExceptionsInternal# :: (State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
maskAsyncExceptionsInternal# = ((State# RealWorld -> (# State# RealWorld, Any #))
-> State# RealWorld -> (# State# RealWorld, Any #))
-> (State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
unsafeCoerce# (State# RealWorld -> (# State# RealWorld, Any #))
-> State# RealWorld -> (# State# RealWorld, Any #)
forall a.
(State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
maskAsyncExceptions#
{-# INLINEABLE maskAsyncExceptionsInternal# #-}
maskUninterruptibleInternal# :: (State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
maskUninterruptibleInternal# :: (State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
maskUninterruptibleInternal# = ((State# RealWorld -> (# State# RealWorld, Any #))
-> State# RealWorld -> (# State# RealWorld, Any #))
-> (State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
unsafeCoerce# (State# RealWorld -> (# State# RealWorld, Any #))
-> State# RealWorld -> (# State# RealWorld, Any #)
forall a.
(State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
maskUninterruptible#
{-# INLINEABLE maskUninterruptibleInternal# #-}
unmaskAsyncExceptionsInternal# :: (State# s -> (# State# s, b #)) -> State# s -> (# State# s, b #)
unmaskAsyncExceptionsInternal# :: (State# s -> (# State# s, b #)) -> State# s -> (# State# s, b #)
unmaskAsyncExceptionsInternal# = ((State# RealWorld -> (# State# RealWorld, Any #))
-> State# RealWorld -> (# State# RealWorld, Any #))
-> (State# s -> (# State# s, b #)) -> State# s -> (# State# s, b #)
unsafeCoerce# (State# RealWorld -> (# State# RealWorld, Any #))
-> State# RealWorld -> (# State# RealWorld, Any #)
forall a.
(State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
unmaskAsyncExceptions#
{-# INLINEABLE unmaskAsyncExceptionsInternal# #-}
getMaskingState :: MonadPrim RW m => m GHC.MaskingState
getMaskingState :: m MaskingState
getMaskingState = IO MaskingState -> m MaskingState
forall (m :: * -> *) a. MonadPrim RealWorld m => IO a -> m a
liftIO IO MaskingState
GHC.getMaskingState
{-# INLINEABLE getMaskingState #-}
#if !MIN_VERSION_base(4,9,0)
type HasCallStack = (?callStack :: CallStack)
callStack :: HasCallStack => CallStack
callStack = ?callStack
prettySrcLoc :: SrcLoc -> String
prettySrcLoc = showSrcLoc
prettyCallStack :: CallStack -> String
prettyCallStack = intercalate "\n" . prettyCallStackLines
prettyCallStackLines :: CallStack -> [String]
prettyCallStackLines cs = case getCallStack cs of
[] -> []
stk -> "CallStack (from HasCallStack):"
: map ((" " ++) . prettyCallSite) stk
where
prettyCallSite (f, loc) = f ++ ", called at " ++ prettySrcLoc loc
#endif