{-# LANGUAGE CPP #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}

-- | A generalization of "Control.Exception" from the 'IO' monad to
-- 'MonadRecover' 'SomeException'.
module Control.Monad.Exception
  (
  -- * Throwing exceptions
    MonadThrow
  , exception
  , throw
  , throwIO
  , ioError
  , throwTo
  -- * Catching exceptions
  , MonadCatch
  , catch
  , handle
  , catchJust
  , handleJust
  , Handler(..)
  , catches
  , handles
  , try
  , tryJust
  , evaluateIO
  -- * Asynchronous exception control
  , MonadMask(..)
  , liftGetMaskingState
  , liftWithMaskingState
  , mask
  , mask_
  , uninterruptibleMask
  , uninterruptibleMask_
  , interruptible
  , allowInterrupt
  -- * Re-exports
  , module Control.Monad.Abort.Class
  , module Control.Monad.Finally
  , module Control.Exception
  ) where

#if !MIN_VERSION_base(4,6,0)
import Prelude hiding (catch)
#else
import Prelude hiding (ioError)
#endif
import Data.Monoid (Monoid)
import Control.Applicative (Applicative, (<$>))
import Control.Monad (join, liftM)
import Control.Monad.Base
import Control.Monad.Trans.Class
import Control.Monad.Trans.Control (MonadTransControl(..))
import Control.Monad.Trans.Abort hiding (abort, recover)
import Control.Monad.Trans.Finish
import Control.Monad.Trans.Maybe
#if !MIN_VERSION_transformers(0,6,0)
import Control.Monad.Trans.List
import Control.Monad.Trans.Error
#endif
import Control.Monad.Trans.Except
import Control.Monad.Trans.Reader
import qualified Control.Monad.Trans.State.Lazy as L
import qualified Control.Monad.Trans.State.Strict as S
import qualified Control.Monad.Trans.Writer.Lazy as L
import qualified Control.Monad.Trans.Writer.Strict as S
import qualified Control.Monad.Trans.RWS.Lazy as L
import qualified Control.Monad.Trans.RWS.Strict as S
import Control.Monad.Abort.Class
import Control.Monad.Finally
import Control.Concurrent (ThreadId)
import Control.Exception hiding (
  evaluate, throw, throwIO, ioError, throwTo, catch, catchJust, handle,
  handleJust, Handler(..), catches, try, tryJust, finally, onException,
#if !MIN_VERSION_base(4,7,0)
  block, unblock, blocked,
#endif
  getMaskingState, mask, mask_, uninterruptibleMask, uninterruptibleMask_,
#if MIN_VERSION_base(4,9,0)
  interruptible,
#endif
  allowInterrupt, bracket, bracket_, bracketOnError)
import qualified Control.Exception as E
import GHC.Base (maskAsyncExceptions#, maskUninterruptible#,
                 unmaskAsyncExceptions#)
import GHC.IO (IO(..))

-- | An alias for 'MonadAbort' 'SomeException' /μ/.
type MonadThrow μ = MonadAbort SomeException μ

-- | Throw an exception from pure code.
exception ∷ Exception e ⇒ e → α
exception :: forall e α. Exception e => e -> α
exception = forall a e. Exception e => e -> a
E.throw
{-# INLINE exception #-}

-- | Throw an exception from monadic code. An alias for
-- @'abort' . 'toException'@.
throw ∷ (MonadThrow μ, Exception e) ⇒ e → μ α
throw :: forall (μ :: * -> *) e α. (MonadThrow μ, Exception e) => e -> μ α
throw = forall e (μ :: * -> *) α. MonadAbort e μ => e -> μ α
abort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> SomeException
toException
{-# INLINE throw #-}

-- | Thow an exception from the 'IO' monad.
throwIO ∷ (MonadBase IO μ, Exception e) ⇒ e → μ α
throwIO :: forall (μ :: * -> *) e α. (MonadBase IO μ, Exception e) => e -> μ α
throwIO = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
E.throwIO
{-# INLINE throwIO #-}

-- | Raise an 'IOError' in the 'IO' monad.
ioError ∷ MonadBase IO μ ⇒ IOError → μ α
ioError :: forall (μ :: * -> *) α. MonadBase IO μ => IOError -> μ α
ioError = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IOError -> IO a
E.ioError
{-# INLINE ioError #-}

-- | Raise an exception in the target thread. See 'E.throwTo'.
throwTo ∷ (MonadBase IO μ, Exception e) ⇒ ThreadId → e → μ ()
throwTo :: forall (μ :: * -> *) e.
(MonadBase IO μ, Exception e) =>
ThreadId -> e -> μ ()
throwTo = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => ThreadId -> e -> IO ()
E.throwTo
{-# INLINE throwTo #-}

-- | An alias for 'MonadRecover' 'SomeException' /μ/.
type MonadCatch μ = MonadRecover SomeException μ

-- | Recover from the specified type of exceptions.
catch ∷ (MonadCatch μ, Exception e) ⇒ μ α → (e → μ α) → μ α
catch :: forall (μ :: * -> *) e α.
(MonadCatch μ, Exception e) =>
μ α -> (e -> μ α) -> μ α
catch μ α
m e -> μ α
h = forall e (μ :: * -> *) α.
MonadRecover e μ =>
μ α -> (e -> μ α) -> μ α
recover μ α
m forall a b. (a -> b) -> a -> b
$ \SomeException
e → forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (μ :: * -> *) e α. (MonadThrow μ, Exception e) => e -> μ α
throw SomeException
e) e -> μ α
h (forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e)
{-# INLINE catch #-}

-- | An alias for @'flip' 'catch'@.
handle ∷ (MonadCatch μ, Exception e) ⇒ (e → μ α) → μ α → μ α
handle :: forall (μ :: * -> *) e α.
(MonadCatch μ, Exception e) =>
(e -> μ α) -> μ α -> μ α
handle = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (μ :: * -> *) e α.
(MonadCatch μ, Exception e) =>
μ α -> (e -> μ α) -> μ α
catch
{-# INLINE handle #-}

-- | Recover from exceptions that satisfy the provided predicate.
catchJust ∷ (MonadCatch μ, Exception e)
          ⇒ (e → Maybe β) -- ^ Exception predicate
          → μ α           -- ^ Main computation
          → (β → μ α)     -- ^ Exception handler
          → μ α
catchJust :: forall (μ :: * -> *) e β α.
(MonadCatch μ, Exception e) =>
(e -> Maybe β) -> μ α -> (β -> μ α) -> μ α
catchJust e -> Maybe β
f μ α
m β -> μ α
h = forall (μ :: * -> *) e α.
(MonadCatch μ, Exception e) =>
μ α -> (e -> μ α) -> μ α
catch μ α
m forall a b. (a -> b) -> a -> b
$ \e
e → forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (μ :: * -> *) e α. (MonadThrow μ, Exception e) => e -> μ α
throw e
e) β -> μ α
h forall a b. (a -> b) -> a -> b
$ e -> Maybe β
f e
e
{-# INLINE catchJust #-}

-- | An alias for @'flip' . 'catchJust'@.
handleJust ∷ (MonadCatch μ, Exception e)
           ⇒ (e → Maybe β) → (β → μ α) → μ α → μ α
handleJust :: forall (μ :: * -> *) e β α.
(MonadCatch μ, Exception e) =>
(e -> Maybe β) -> (β -> μ α) -> μ α -> μ α
handleJust = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (μ :: * -> *) e β α.
(MonadCatch μ, Exception e) =>
(e -> Maybe β) -> μ α -> (β -> μ α) -> μ α
catchJust
{-# INLINE handleJust #-}

-- | Exception handler.
data Handler μ α = ∀ e . Exception e ⇒ Handler (e → μ α)

instance Functor μ ⇒ Functor (Handler μ) where
  fmap :: forall a b. (a -> b) -> Handler μ a -> Handler μ b
fmap a -> b
f (Handler e -> μ a
h) = forall {k} (μ :: k -> *) (α :: k) e.
Exception e =>
(e -> μ α) -> Handler μ α
Handler (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> μ a
h)
  {-# INLINE fmap #-}

-- | Recover from exceptions by sequentually trying to apply the provided
-- handlers.
catches ∷ MonadCatch μ ⇒ μ α → [Handler μ α] → μ α
catches :: forall (μ :: * -> *) α. MonadCatch μ => μ α -> [Handler μ α] -> μ α
catches μ α
m = forall e (μ :: * -> *) α.
MonadRecover e μ =>
μ α -> (e -> μ α) -> μ α
recover μ α
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {μ :: * -> *} {α}.
MonadAbort SomeException μ =>
[Handler μ α] -> SomeException -> μ α
hl
  where hl :: [Handler μ α] -> SomeException -> μ α
hl [] SomeException
e = forall e (μ :: * -> *) α. MonadAbort e μ => e -> μ α
abort SomeException
e
        hl (Handler e -> μ α
h : [Handler μ α]
hs) SomeException
e = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Handler μ α] -> SomeException -> μ α
hl [Handler μ α]
hs SomeException
e) e -> μ α
h forall a b. (a -> b) -> a -> b
$ forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e

-- | An alias for @'flip' 'catches'@.
handles ∷ MonadCatch μ ⇒ [Handler μ α] → μ α → μ α
handles :: forall (μ :: * -> *) α. MonadCatch μ => [Handler μ α] -> μ α -> μ α
handles = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (μ :: * -> *) α. MonadCatch μ => μ α -> [Handler μ α] -> μ α
catches
{-# INLINE handles #-}

-- | Recover from exceptions of the spesified type, wrapping them into
-- 'Left'.
try ∷ (MonadCatch μ, Exception e) ⇒ μ α → μ (Either e α)
try :: forall (μ :: * -> *) e α.
(MonadCatch μ, Exception e) =>
μ α -> μ (Either e α)
try μ α
m = forall (μ :: * -> *) e α.
(MonadCatch μ, Exception e) =>
μ α -> (e -> μ α) -> μ α
catch (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> μ α
m) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)
{-# INLINE try #-}

-- | Recover from exceptions that satisfy the provided predicate, wrapping
-- them into 'Left'.
tryJust ∷ (MonadCatch μ, Exception e)
        ⇒ (e → Maybe β) -- ^ Exception predicate
        → μ α           -- ^ Main compuration
        → μ (Either β α)
tryJust :: forall (μ :: * -> *) e β α.
(MonadCatch μ, Exception e) =>
(e -> Maybe β) -> μ α -> μ (Either β α)
tryJust e -> Maybe β
h μ α
m = forall (μ :: * -> *) e α.
(MonadCatch μ, Exception e) =>
μ α -> (e -> μ α) -> μ α
catch (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> μ α
m) forall a b. (a -> b) -> a -> b
$ \e
e →
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (μ :: * -> *) e α. (MonadThrow μ, Exception e) => e -> μ α
throw e
e) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (e -> Maybe β
h e
e)
{-# INLINE tryJust #-}

-- | Evalute the argument to weak head normal form.
evaluateIO ∷ MonadBase IO μ ⇒ α → μ α
evaluateIO :: forall (μ :: * -> *) α. MonadBase IO μ => α -> μ α
evaluateIO = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> IO a
E.evaluate
{-# INLINE evaluateIO #-}

-- | A class of monads that support masking of asynchronous exceptions.
class (Applicative μ, Monad μ) ⇒ MonadMask μ where
  -- | Get the current masking state.
  getMaskingState ∷ μ MaskingState
  default getMaskingState ∷ (MonadMask η, MonadTrans t, μ ~ t η)
                          ⇒ μ MaskingState
  getMaskingState = forall (μ :: * -> *) (t :: (* -> *) -> * -> *).
(MonadMask μ, MonadTrans t) =>
t μ MaskingState
liftGetMaskingState
  {-# INLINE getMaskingState #-}
  -- | Run the provided computation with the specified 'MaskingState'.
  withMaskingState ∷ MaskingState → μ α → μ α
  default withMaskingState ∷ (MonadMask η, MonadTransControl t, μ ~ t η)
                           ⇒ MaskingState → μ α → μ α
  withMaskingState = forall (t :: (* -> *) -> * -> *) (μ :: * -> *) α.
(MonadTransControl t, MonadMask μ, Monad (t μ)) =>
MaskingState -> t μ α -> t μ α
liftWithMaskingState
  {-# INLINE withMaskingState #-}

-- | Lift 'getMaskingState' through a monad transformer.
liftGetMaskingState ∷ (MonadMask μ, MonadTrans t) ⇒ t μ MaskingState
liftGetMaskingState :: forall (μ :: * -> *) (t :: (* -> *) -> * -> *).
(MonadMask μ, MonadTrans t) =>
t μ MaskingState
liftGetMaskingState = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (μ :: * -> *). MonadMask μ => μ MaskingState
getMaskingState
{-# INLINE liftGetMaskingState #-}

-- | Lift 'withMaskingState' through a monad transformer.
liftWithMaskingState ∷ (MonadTransControl t, MonadMask μ, Monad (t μ))
                     ⇒ MaskingState → t μ α → t μ α
liftWithMaskingState :: forall (t :: (* -> *) -> * -> *) (μ :: * -> *) α.
(MonadTransControl t, MonadMask μ, Monad (t μ)) =>
MaskingState -> t μ α -> t μ α
liftWithMaskingState MaskingState
ms t μ α
m =
  forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return) forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith forall a b. (a -> b) -> a -> b
$ \Run t
run →
    forall (μ :: * -> *) α. MonadMask μ => MaskingState -> μ α -> μ α
withMaskingState MaskingState
ms (Run t
run t μ α
m)
{-# INLINE liftWithMaskingState #-}

instance MonadMask IO where
  getMaskingState :: IO MaskingState
getMaskingState = IO MaskingState
E.getMaskingState
  withMaskingState :: forall α. MaskingState -> IO α -> IO α
withMaskingState MaskingState
Unmasked (IO State# RealWorld -> (# State# RealWorld, α #)
io) = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ forall a.
(State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
unmaskAsyncExceptions# State# RealWorld -> (# State# RealWorld, α #)
io
  withMaskingState MaskingState
MaskedInterruptible (IO State# RealWorld -> (# State# RealWorld, α #)
io) = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ forall a.
(State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
maskAsyncExceptions# State# RealWorld -> (# State# RealWorld, α #)
io
  withMaskingState MaskingState
MaskedUninterruptible (IO State# RealWorld -> (# State# RealWorld, α #)
io) = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ forall a.
(State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
maskUninterruptible# State# RealWorld -> (# State# RealWorld, α #)
io

instance MonadMask μ ⇒ MonadMask (MaybeT μ)
#if !MIN_VERSION_transformers(0,6,0)
instance MonadMask μ ⇒ MonadMask (ListT μ)
#endif
instance MonadMask μ ⇒ MonadMask (AbortT e μ)
instance MonadMask μ ⇒ MonadMask (FinishT β μ)
#if !MIN_VERSION_transformers(0,6,0)
instance (MonadMask μ, Error e) ⇒ MonadMask (ErrorT e μ)
#endif
instance MonadMask μ ⇒ MonadMask (ExceptT e μ)
instance MonadMask μ ⇒ MonadMask (ReaderT r μ)
instance MonadMask μ ⇒ MonadMask (L.StateT s μ)
instance MonadMask μ ⇒ MonadMask (S.StateT s μ)
instance (MonadMask μ, Monoid w) ⇒ MonadMask (L.WriterT w μ)
instance (MonadMask μ, Monoid w) ⇒ MonadMask (S.WriterT w μ)
instance (MonadMask μ, Monoid w) ⇒ MonadMask (L.RWST r w s μ)
instance (MonadMask μ, Monoid w) ⇒ MonadMask (S.RWST r w s μ)

-- | Prevents asynchronous exceptions from being raised within the provided
-- computation. Blocking operations can still be interrupted. Supplies the
-- computation with @'withMaskingState' s@, where @s@ is the current masking
-- state.
mask ∷ ∀ μ α . MonadMask μ
     ⇒ ((∀ η β . MonadMask η ⇒ η β → η β) → μ α) → μ α
mask :: forall (μ :: * -> *) α.
MonadMask μ =>
((forall (η :: * -> *) β. MonadMask η => η β -> η β) -> μ α) -> μ α
mask (forall (η :: * -> *) β. MonadMask η => η β -> η β) -> μ α
f = forall (μ :: * -> *). MonadMask μ => μ MaskingState
getMaskingState forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  MaskingState
Unmasked →
    forall (μ :: * -> *) α. MonadMask μ => MaskingState -> μ α -> μ α
withMaskingState MaskingState
MaskedInterruptible forall a b. (a -> b) -> a -> b
$ (forall (η :: * -> *) β. MonadMask η => η β -> η β) -> μ α
f (forall (μ :: * -> *) α. MonadMask μ => MaskingState -> μ α -> μ α
withMaskingState MaskingState
Unmasked)
  MaskingState
MaskedInterruptible →
    (forall (η :: * -> *) β. MonadMask η => η β -> η β) -> μ α
f (forall (μ :: * -> *) α. MonadMask μ => MaskingState -> μ α -> μ α
withMaskingState MaskingState
MaskedInterruptible)
  MaskingState
MaskedUninterruptible →
    (forall (η :: * -> *) β. MonadMask η => η β -> η β) -> μ α
f (forall (μ :: * -> *) α. MonadMask μ => MaskingState -> μ α -> μ α
withMaskingState MaskingState
MaskedUninterruptible)
 
-- | An alias for @'mask' . 'const'@.
mask_ ∷ ∀ μ α . MonadMask μ ⇒ μ α → μ α
mask_ :: forall (η :: * -> *) β. MonadMask η => η β -> η β
mask_ = forall (μ :: * -> *) α.
MonadMask μ =>
((forall (η :: * -> *) β. MonadMask η => η β -> η β) -> μ α) -> μ α
mask forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
{-# INLINE mask_ #-}

-- | Prevents asynchronous exceptions from being raised within the provided
-- computation. Also prevents blocking operations from being interrupted.
-- Supplies the computation with @'withMaskingState' s@, where @s@ is the
-- current masking state.
uninterruptibleMask ∷ MonadMask μ
                    ⇒ ((∀ η β . MonadMask η ⇒ η β → η β) → μ α) → μ α
uninterruptibleMask :: forall (μ :: * -> *) α.
MonadMask μ =>
((forall (η :: * -> *) β. MonadMask η => η β -> η β) -> μ α) -> μ α
uninterruptibleMask (forall (η :: * -> *) β. MonadMask η => η β -> η β) -> μ α
f = forall (μ :: * -> *). MonadMask μ => μ MaskingState
getMaskingState forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  MaskingState
Unmasked →
    forall (μ :: * -> *) α. MonadMask μ => MaskingState -> μ α -> μ α
withMaskingState MaskingState
MaskedUninterruptible forall a b. (a -> b) -> a -> b
$ (forall (η :: * -> *) β. MonadMask η => η β -> η β) -> μ α
f (forall (μ :: * -> *) α. MonadMask μ => MaskingState -> μ α -> μ α
withMaskingState MaskingState
Unmasked)
  MaskingState
MaskedInterruptible →
    forall (μ :: * -> *) α. MonadMask μ => MaskingState -> μ α -> μ α
withMaskingState MaskingState
MaskedUninterruptible forall a b. (a -> b) -> a -> b
$
      (forall (η :: * -> *) β. MonadMask η => η β -> η β) -> μ α
f (forall (μ :: * -> *) α. MonadMask μ => MaskingState -> μ α -> μ α
withMaskingState MaskingState
MaskedInterruptible)
  MaskingState
MaskedUninterruptible →
    (forall (η :: * -> *) β. MonadMask η => η β -> η β) -> μ α
f (forall (μ :: * -> *) α. MonadMask μ => MaskingState -> μ α -> μ α
withMaskingState MaskingState
MaskedUninterruptible)

-- | An alias for @'uninterruptibleMask' . 'const'@.
uninterruptibleMask_ ∷ MonadMask μ ⇒ μ α → μ α
uninterruptibleMask_ :: forall (η :: * -> *) β. MonadMask η => η β -> η β
uninterruptibleMask_ = forall (μ :: * -> *) α.
MonadMask μ =>
((forall (η :: * -> *) β. MonadMask η => η β -> η β) -> μ α) -> μ α
uninterruptibleMask forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
{-# INLINE uninterruptibleMask_ #-}

-- | Allow asynchronous exceptions to be raised within the provided
-- computation, even if the current masking state is 'MaskedInterruptible'
-- (but not in 'MaskedUninterruptible' state).
interruptible ∷ MonadMask μ ⇒ μ α → μ α
interruptible :: forall (η :: * -> *) β. MonadMask η => η β -> η β
interruptible μ α
m = forall (μ :: * -> *). MonadMask μ => μ MaskingState
getMaskingState forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  MaskingState
Unmasked → μ α
m
  MaskingState
MaskedInterruptible → forall (μ :: * -> *) α. MonadMask μ => MaskingState -> μ α -> μ α
withMaskingState MaskingState
Unmasked μ α
m
  MaskingState
MaskedUninterruptible → μ α
m

-- | An alias for @'interruptible' ('return' ())@.
allowInterrupt ∷ MonadMask μ ⇒ μ ()
allowInterrupt :: forall (μ :: * -> *). MonadMask μ => μ ()
allowInterrupt = forall (η :: * -> *) β. MonadMask η => η β -> η β
interruptible forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE allowInterrupt #-}