{-# 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

-- Copyright   : (c) Alexey Kuleshevich 2020

-- License     : BSD3

-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>

-- Stability   : experimental

-- Portability : non-portable

--

module Control.Prim.Exception
  (
  -- * Throwing

    module Control.Prim.Monad.Throw
  , throw
  , throwTo
  , impureThrow
  -- * Catching

  , catch
  , catchAny
  , catchAnySync
  , catchAll
  , catchAllSync
  , try
  , tryAny
  , tryAnySync
  , onException
  -- TODO: Implement:

  -- , onAsyncException

  , withException
  , withAnyException
  -- TODO: Implement:

  -- , withAsyncException

  , finally
  , bracket
  , bracket_
  , bracketOnError
  , ufinally
  , ubracket
  , ubracket_
  , ubracketOnError
  , mask
  , mask_
  , maskPrimBase_
  , uninterruptibleMask
  , uninterruptibleMask_
  , uninterruptibleMaskPrimBase_
  , maskAsyncExceptions
  , unmaskAsyncExceptions
  , maskUninterruptible
  , GHC.MaskingState(..)
  , getMaskingState
  -- * Exceptions

  , GHC.Exception(..)
  , GHC.SomeException
  -- ** Async exceptions

  , GHC.AsyncException(..)
  , GHC.SomeAsyncException(..)
  , isSyncException
  , isAsyncException
  , GHC.asyncExceptionToException
  , GHC.asyncExceptionFromException
  -- ** Standard exceptions

  , GHC.ErrorCall(..)
  , GHC.ArithException(..)
  , GHC.ArrayException(..)
  , GHC.AssertionFailed(..)
  , GHC.IOException
  , GHC.NonTermination(..)
  , GHC.NestedAtomically(..)
  , GHC.BlockedIndefinitelyOnMVar(..)
  , GHC.BlockedIndefinitelyOnSTM(..)
  , GHC.AllocationLimitExceeded(..)
  , GHC.Deadlock(..)
  -- * CallStack

  , 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
--import GHC.IO (IO(..))



----- Exceptions


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 #-}

-- | This is the same as `throwIO`, but works with any `MonadPrim` without restriction on

-- `RealWorld`.

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))
-- {-# INLINEABLE throw #-}



-- | Raise an impure exception from pure code. Returns a thunk, which will result in a

-- supplied exceptionn being thrown when evaluated.

--

-- @since 0.3.0

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)


-- | Similar to `throwTo`, except that it wraps any known non-async exception with

-- `SomeAsyncException`. This is necessary, because receiving thread will get the exception in

-- an asynchronous manner and without proper wrapping it will not be able to distinguish it

-- from a regular synchronous exception

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
-- {-# INLINEABLE throwTo #-}


-- | Behaves exactly as `catch`, except that it works in any `MonadUnliftPrim`.

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'#
-- {-# INLINEABLE catch #-}

--{-# SPECIALIZE catch :: GHC.Exception e => IO a -> (e -> IO a) -> IO a #-}


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#
-- {-# INLINEABLE catchAny #-}

--{-# SPECIALIZE catchAny :: IO a -> (GHC.SomeException -> IO a) -> IO a #-}



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
-- {-# INLINEABLE catchAnySync #-}


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#)
-- {-# INLINEABLE catchAll #-}


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
-- {-# INLINEABLE catchAllSync #-}



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)
-- {-# INLINEABLE try #-}

--{-# SPECIALIZE try :: GHC.Exception e => IO a -> IO (Either e a) #-}


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)
-- {-# INLINEABLE tryAny #-}


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)


-- | Run an action, while invoking an exception handler if that action fails for some

-- reason. Exception handling function has async exceptions masked, but it is still

-- interruptible, which can be undesired in some scenarios. If you are sure that the

-- cleanup action does not deadlock and you do need hard guarantees that it gets executed

-- you can run it as uninterruptible:

--

-- > uninterruptibleMask $ \restore -> withException (restore action) handler

--

-- @since 0.3.0

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)


-- | Same as `withException`, but will invoke exception handling function on all

-- exceptions.

--

-- @since 0.3.0

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)

-- | Async safe version of 'EUnsafe.onException'.

--

-- @since 0.1.0.0

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)


--

-- @since 0.3.0

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



--

-- @since 0.3.0

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)


--

-- @since 0.3.0

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 all asychronous exceptions, but keep it interruptible, unless the inherited state

-- was uninterruptible already, in which case this action has no affect. Same as

-- `Control.Exception.mask_`, except that it is polymorphic in state token. Inside a state

-- thread it cannot affect the result of computation, therefore it is safe to use it within

-- `ST` monad.

--

-- @since 0.3.0

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 all asychronous exceptions, but keep it interruptible, unless the inherited state

-- was uninterruptible already, in which case this action has no affect. Same as

-- `Control.Exception.mask`, except that it is polymorphic in state token. Inside a state

-- thread it cannot affect the result of computation, therefore it is safe to use it within

-- `ST` monad.

--

-- @since 0.3.0

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 #-}
--{-# SPECIALIZE mask :: ((forall a. IO a -> IO a) -> IO b) -> IO b #-}


-- | Mask all asychronous exceptions and mark it uninterruptible. Same as

-- `Control.Exception.uninterruptibleMask`, except that it is polymorphic in state

-- token. Inside a state thread it cannot affect the result of computation, therefore it

-- is safe to use it within `ST` monad.

--

-- @since 0.3.0

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 #-}


-- | Mask all async exceptions and make sure evaluation cannot be interrupted. It is

-- polymorphic in the state token because it is perfectly safe to use with `ST` actions that

-- don't perform any allocations. It doesn't have to be restricted to `RealWorld` because it

-- has no impact on other threads and can't affect the result of computation, moreover pure

-- functions that implement tight loops are already non-interruptible. In fact using this

-- function is more dangerous in `IO` than it is in `ST`, because misuse can lead to deadlocks

-- in a concurrent setting.

--

-- @since 0.3.0

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_ #-}


-- | A direct wrapper around `maskAsyncExceptions#` primop. This is different and more

-- dangerous than `mask_` because it can turn uninterrubtable state into interruptable.

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  #-}


-- | A direct wrapper around `unmaskAsyncExceptions#` primop.

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  #-}


-- | A direct wrapper around `maskUninterruptible#` primop.

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# #-}

-- | Same as `GHC.getMaskingState`, but generalized to `MonadPrim`

--

-- @since 0.3.0

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)

-- | (Implemented for compatibility with GHC-7.10.2)

type HasCallStack = (?callStack :: CallStack)

callStack :: HasCallStack => CallStack
callStack = ?callStack

-- | Pretty print a 'SrcLoc'. (Implemented for compatibility with GHC-7.10.2)

--

-- @since 3.0.0

prettySrcLoc :: SrcLoc -> String
prettySrcLoc = showSrcLoc

-- | Pretty print a 'CallStack'. (Implemented for compatibility with GHC-7.10.2)

--

-- @since 3.0.0

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