{-# LANGUAGE CPP
           , NoImplicitPrelude
           , ExistentialQuantification
           , FlexibleContexts #-}

#if MIN_VERSION_base(4,3,0)
{-# LANGUAGE RankNTypes #-} -- for mask
#endif

#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Safe #-}
#endif

{- |
Module      :  Control.Exception.Lifted
Copyright   :  Bas van Dijk, Anders Kaseorg
License     :  BSD-style

Maintainer  :  Bas van Dijk <v.dijk.bas@gmail.com>
Stability   :  experimental
Portability :  non-portable (extended exceptions)

This is a wrapped version of "Control.Exception" with types generalized
from 'IO' to all monads in either 'MonadBase' or 'MonadBaseControl'.
-}

module Control.Exception.Lifted
    ( module Control.Exception

      -- * Throwing exceptions
    , throwIO, ioError, throwTo

      -- * Catching exceptions
      -- ** The @catch@ functions
    , catch, catches, Handler(..), catchJust

      -- ** The @handle@ functions
    , handle, handleJust

      -- ** The @try@ functions
    , try, tryJust

      -- ** The @evaluate@ function
    , evaluate

      -- * Asynchronous Exceptions
      -- ** Asynchronous exception control
      -- |The following functions allow a thread to control delivery of
      -- asynchronous exceptions during a critical region.
#if MIN_VERSION_base(4,3,0)
    , mask, mask_
    , uninterruptibleMask, uninterruptibleMask_
    , getMaskingState
#if MIN_VERSION_base(4,4,0)
    , allowInterrupt
#endif
#else
    , block, unblock
#endif

#if !MIN_VERSION_base(4,4,0)
    , blocked
#endif
      -- * Brackets
    , bracket, bracket_, bracketOnError

      -- * Utilities
    , finally, onException
    ) where


--------------------------------------------------------------------------------
-- Imports
--------------------------------------------------------------------------------

-- from base:
import Prelude         ( (.) )
import Data.Function   ( ($) )
import Data.Either     ( Either(Left, Right), either )
import Data.Maybe      ( Maybe )
import Control.Monad   ( (>>=), return, liftM )
import System.IO.Error ( IOError )
import System.IO       ( IO )

#if __GLASGOW_HASKELL__ < 700
import Control.Monad   ( fail )
#endif

import Control.Exception hiding
    ( throwIO, ioError, throwTo
    , catch, catches, Handler(..), catchJust
    , handle, handleJust
    , try, tryJust
    , evaluate
#if MIN_VERSION_base(4,3,0)
    , mask, mask_
    , uninterruptibleMask, uninterruptibleMask_
    , getMaskingState
#if MIN_VERSION_base(4,4,0)
    , allowInterrupt
#endif
#else
    , block, unblock
#endif
#if !MIN_VERSION_base(4,4,0)
    , blocked
#endif
    , bracket, bracket_, bracketOnError
    , finally, onException
    )
import qualified Control.Exception  as E
import qualified Control.Concurrent as C
import           Control.Concurrent ( ThreadId )

#if !MIN_VERSION_base(4,4,0)
import Data.Bool ( Bool )
#endif

-- from transformers-base:
import Control.Monad.Base ( MonadBase, liftBase )

-- from monad-control:
import Control.Monad.Trans.Control ( MonadBaseControl, StM
                                   , liftBaseWith, restoreM
                                   , control, liftBaseOp_
                                   )
#if defined (__HADDOCK__)
import Control.Monad.Trans.Control ( liftBaseOp )
#endif

#include "inlinable.h"

--------------------------------------------------------------------------------
-- * Throwing exceptions
--------------------------------------------------------------------------------

-- |Generalized version of 'E.throwIO'.
throwIO :: (MonadBase IO m, Exception e) => e -> m a
throwIO :: forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
throwIO = IO a -> m a
forall α. IO α -> m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO a -> m a) -> (e -> IO a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IO a
forall e a. Exception e => e -> IO a
E.throwIO
{-# INLINABLE throwIO #-}

-- |Generalized version of 'E.ioError'.
ioError :: MonadBase IO m => IOError -> m a
ioError :: forall (m :: * -> *) a. MonadBase IO m => IOError -> m a
ioError = IO a -> m a
forall α. IO α -> m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO a -> m a) -> (IOError -> IO a) -> IOError -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> IO a
forall a. IOError -> IO a
E.ioError
{-# INLINABLE ioError #-}

-- | Generalized version of 'C.throwTo'.
throwTo :: (MonadBase IO m, Exception e) => ThreadId -> e -> m ()
throwTo :: forall (m :: * -> *) e.
(MonadBase IO m, Exception e) =>
ThreadId -> e -> m ()
throwTo ThreadId
tid e
e = IO () -> m ()
forall α. IO α -> m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ThreadId -> e -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
C.throwTo ThreadId
tid e
e
{-# INLINABLE throwTo #-}

--------------------------------------------------------------------------------
-- * Catching exceptions
--------------------------------------------------------------------------------

-- |Generalized version of 'E.catch'.
--
-- Note, when the given computation throws an exception any monadic
-- side effects in @m@ will be discarded.
catch :: (MonadBaseControl IO m, Exception e)
      => m a       -- ^ The computation to run
      -> (e -> m a) -- ^ Handler to invoke if an exception is raised
      -> m a
catch :: forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
catch m a
a e -> m a
handler = (RunInBase m IO -> IO (StM m a)) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b (StM m a)) -> m a
control ((RunInBase m IO -> IO (StM m a)) -> m a)
-> (RunInBase m IO -> IO (StM m a)) -> m a
forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
runInIO ->
                    IO (StM m a) -> (e -> IO (StM m a)) -> IO (StM m a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (m a -> IO (StM m a)
RunInBase m IO
runInIO m a
a)
                            (\e
e -> m a -> IO (StM m a)
RunInBase m IO
runInIO (m a -> IO (StM m a)) -> m a -> IO (StM m a)
forall a b. (a -> b) -> a -> b
$ e -> m a
handler e
e)
{-# INLINABLE catch #-}

-- |Generalized version of 'E.catches'.
--
-- Note, when the given computation throws an exception any monadic
-- side effects in @m@ will be discarded.
catches :: MonadBaseControl IO m => m a -> [Handler m a] -> m a
catches :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> [Handler m a] -> m a
catches m a
a [Handler m a]
handlers = (RunInBase m IO -> IO (StM m a)) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b (StM m a)) -> m a
control ((RunInBase m IO -> IO (StM m a)) -> m a)
-> (RunInBase m IO -> IO (StM m a)) -> m a
forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
runInIO ->
                       IO (StM m a) -> [Handler (StM m a)] -> IO (StM m a)
forall a. IO a -> [Handler a] -> IO a
E.catches (m a -> IO (StM m a)
RunInBase m IO
runInIO m a
a)
                                 [ (e -> IO (StM m a)) -> Handler (StM m a)
forall a e. Exception e => (e -> IO a) -> Handler a
E.Handler ((e -> IO (StM m a)) -> Handler (StM m a))
-> (e -> IO (StM m a)) -> Handler (StM m a)
forall a b. (a -> b) -> a -> b
$ \e
e -> m a -> IO (StM m a)
RunInBase m IO
runInIO (m a -> IO (StM m a)) -> m a -> IO (StM m a)
forall a b. (a -> b) -> a -> b
$ e -> m a
handler e
e
                                 | Handler e -> m a
handler <- [Handler m a]
handlers
                                 ]
{-# INLINABLE catches #-}

-- |Generalized version of 'E.Handler'.
data Handler m a = forall e. Exception e => Handler (e -> m a)

-- |Generalized version of 'E.catchJust'.
--
-- Note, when the given computation throws an exception any monadic
-- side effects in @m@ will be discarded.
catchJust :: (MonadBaseControl IO m, Exception e)
          => (e -> Maybe b) -- ^ Predicate to select exceptions
          -> m a           -- ^ Computation to run
          -> (b -> m a)     -- ^ Handler
          -> m a
catchJust :: forall (m :: * -> *) e b a.
(MonadBaseControl IO m, Exception e) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust e -> Maybe b
p m a
a b -> m a
handler = (RunInBase m IO -> IO (StM m a)) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b (StM m a)) -> m a
control ((RunInBase m IO -> IO (StM m a)) -> m a)
-> (RunInBase m IO -> IO (StM m a)) -> m a
forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
runInIO ->
                          (e -> Maybe b)
-> IO (StM m a) -> (b -> IO (StM m a)) -> IO (StM m a)
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
E.catchJust e -> Maybe b
p
                                      (m a -> IO (StM m a)
RunInBase m IO
runInIO m a
a)
                                      (\b
e -> m a -> IO (StM m a)
RunInBase m IO
runInIO (b -> m a
handler b
e))
{-# INLINABLE catchJust #-}


--------------------------------------------------------------------------------
--  ** The @handle@ functions
--------------------------------------------------------------------------------

-- |Generalized version of 'E.handle'.
--
-- Note, when the given computation throws an exception any monadic
-- side effects in @m@ will be discarded.
handle :: (MonadBaseControl IO m, Exception e) => (e -> m a) -> m a -> m a
handle :: forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
(e -> m a) -> m a -> m a
handle e -> m a
handler m a
a = (RunInBase m IO -> IO (StM m a)) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b (StM m a)) -> m a
control ((RunInBase m IO -> IO (StM m a)) -> m a)
-> (RunInBase m IO -> IO (StM m a)) -> m a
forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
runInIO ->
                     (e -> IO (StM m a)) -> IO (StM m a) -> IO (StM m a)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle (\e
e -> m a -> IO (StM m a)
RunInBase m IO
runInIO (e -> m a
handler e
e))
                              (m a -> IO (StM m a)
RunInBase m IO
runInIO m a
a)
{-# INLINABLE handle #-}

-- |Generalized version of 'E.handleJust'.
--
-- Note, when the given computation throws an exception any monadic
-- side effects in @m@ will be discarded.
handleJust :: (MonadBaseControl IO m, Exception e)
           => (e -> Maybe b) -> (b -> m a) -> m a -> m a
handleJust :: forall (m :: * -> *) e b a.
(MonadBaseControl IO m, Exception e) =>
(e -> Maybe b) -> (b -> m a) -> m a -> m a
handleJust e -> Maybe b
p b -> m a
handler m a
a = (RunInBase m IO -> IO (StM m a)) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b (StM m a)) -> m a
control ((RunInBase m IO -> IO (StM m a)) -> m a)
-> (RunInBase m IO -> IO (StM m a)) -> m a
forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
runInIO ->
                           (e -> Maybe b)
-> (b -> IO (StM m a)) -> IO (StM m a) -> IO (StM m a)
forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
E.handleJust e -> Maybe b
p (\b
e -> m a -> IO (StM m a)
RunInBase m IO
runInIO (b -> m a
handler b
e))
                                          (m a -> IO (StM m a)
RunInBase m IO
runInIO m a
a)
{-# INLINABLE handleJust #-}

--------------------------------------------------------------------------------
-- ** The @try@ functions
--------------------------------------------------------------------------------

sequenceEither :: MonadBaseControl IO m => Either e (StM m a) -> m (Either e a)
sequenceEither :: forall (m :: * -> *) e a.
MonadBaseControl IO m =>
Either e (StM m a) -> m (Either e a)
sequenceEither = (e -> m (Either e a))
-> (StM m a -> m (Either e a))
-> Either e (StM m a)
-> m (Either e a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either e a -> m (Either e a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e a -> m (Either e a))
-> (e -> Either e a) -> e -> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e a
forall a b. a -> Either a b
Left) ((a -> Either e a) -> m a -> m (Either e a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Either e a
forall a b. b -> Either a b
Right (m a -> m (Either e a))
-> (StM m a -> m a) -> StM m a -> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m a -> m a
forall a. StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM)
{-# INLINE sequenceEither #-}

-- |Generalized version of 'E.try'.
--
-- Note, when the given computation throws an exception any monadic
-- side effects in @m@ will be discarded.
try :: (MonadBaseControl IO m, Exception e) => m a -> m (Either e a)
try :: forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> m (Either e a)
try m a
m = (RunInBase m IO -> IO (Either e (StM m a)))
-> m (Either e (StM m a))
forall a. (RunInBase m IO -> IO a) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith (\RunInBase m IO
runInIO -> IO (StM m a) -> IO (Either e (StM m a))
forall e a. Exception e => IO a -> IO (Either e a)
E.try (m a -> IO (StM m a)
RunInBase m IO
runInIO m a
m)) m (Either e (StM m a))
-> (Either e (StM m a) -> m (Either e a)) -> m (Either e a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either e (StM m a) -> m (Either e a)
forall (m :: * -> *) e a.
MonadBaseControl IO m =>
Either e (StM m a) -> m (Either e a)
sequenceEither
{-# INLINABLE try #-}

-- |Generalized version of 'E.tryJust'.
--
-- Note, when the given computation throws an exception any monadic
-- side effects in @m@ will be discarded.
tryJust :: (MonadBaseControl IO m, Exception e) => (e -> Maybe b) -> m a -> m (Either b a)
tryJust :: forall (m :: * -> *) e b a.
(MonadBaseControl IO m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust e -> Maybe b
p m a
m = (RunInBase m IO -> IO (Either b (StM m a)))
-> m (Either b (StM m a))
forall a. (RunInBase m IO -> IO a) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith (\RunInBase m IO
runInIO -> (e -> Maybe b) -> IO (StM m a) -> IO (Either b (StM m a))
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
E.tryJust e -> Maybe b
p (m a -> IO (StM m a)
RunInBase m IO
runInIO m a
m)) m (Either b (StM m a))
-> (Either b (StM m a) -> m (Either b a)) -> m (Either b a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either b (StM m a) -> m (Either b a)
forall (m :: * -> *) e a.
MonadBaseControl IO m =>
Either e (StM m a) -> m (Either e a)
sequenceEither
{-# INLINABLE tryJust #-}


--------------------------------------------------------------------------------
-- ** The @evaluate@ function
--------------------------------------------------------------------------------

-- |Generalized version of 'E.evaluate'.
evaluate :: MonadBase IO m => a -> m a
evaluate :: forall (m :: * -> *) a. MonadBase IO m => a -> m a
evaluate = IO a -> m a
forall α. IO α -> m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO a -> m a) -> (a -> IO a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall a. a -> IO a
E.evaluate
{-# INLINABLE evaluate #-}


--------------------------------------------------------------------------------
-- ** Asynchronous exception control
--------------------------------------------------------------------------------

#if MIN_VERSION_base(4,3,0)
-- |Generalized version of 'E.mask'.
mask :: MonadBaseControl IO m => ((forall a. m a -> m a) -> m b) -> m b
mask :: forall (m :: * -> *) b.
MonadBaseControl IO m =>
((forall a. m a -> m a) -> m b) -> m b
mask (forall a. m a -> m a) -> m b
f = (RunInBase m IO -> IO (StM m b)) -> m b
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b (StM m a)) -> m a
control ((RunInBase m IO -> IO (StM m b)) -> m b)
-> (RunInBase m IO -> IO (StM m b)) -> m b
forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
runInBase ->
           ((forall a. IO a -> IO a) -> IO (StM m b)) -> IO (StM m b)
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.mask (((forall a. IO a -> IO a) -> IO (StM m b)) -> IO (StM m b))
-> ((forall a. IO a -> IO a) -> IO (StM m b)) -> IO (StM m b)
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
g -> m b -> IO (StM m b)
RunInBase m IO
runInBase (m b -> IO (StM m b)) -> m b -> IO (StM m b)
forall a b. (a -> b) -> a -> b
$ (forall a. m a -> m a) -> m b
f ((forall a. m a -> m a) -> m b) -> (forall a. m a -> m a) -> m b
forall a b. (a -> b) -> a -> b
$ (IO (StM m a) -> IO (StM m a)) -> m a -> m a
forall (b :: * -> *) (m :: * -> *) a c.
MonadBaseControl b m =>
(b (StM m a) -> b (StM m c)) -> m a -> m c
liftBaseOp_ IO (StM m a) -> IO (StM m a)
forall a. IO a -> IO a
g
{-# INLINABLE mask #-}

-- |Generalized version of 'E.mask_'.
mask_ :: MonadBaseControl IO m => m a -> m a
mask_ :: forall (m :: * -> *) a. MonadBaseControl IO m => m a -> m a
mask_ = (IO (StM m a) -> IO (StM m a)) -> m a -> m a
forall (b :: * -> *) (m :: * -> *) a c.
MonadBaseControl b m =>
(b (StM m a) -> b (StM m c)) -> m a -> m c
liftBaseOp_ IO (StM m a) -> IO (StM m a)
forall a. IO a -> IO a
E.mask_
{-# INLINABLE mask_ #-}

-- |Generalized version of 'E.uninterruptibleMask'.
uninterruptibleMask
    :: MonadBaseControl IO m => ((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask :: forall (m :: * -> *) b.
MonadBaseControl IO m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (forall a. m a -> m a) -> m b
f =
    (RunInBase m IO -> IO (StM m b)) -> m b
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b (StM m a)) -> m a
control ((RunInBase m IO -> IO (StM m b)) -> m b)
-> (RunInBase m IO -> IO (StM m b)) -> m b
forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
runInBase ->
        ((forall a. IO a -> IO a) -> IO (StM m b)) -> IO (StM m b)
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.uninterruptibleMask (((forall a. IO a -> IO a) -> IO (StM m b)) -> IO (StM m b))
-> ((forall a. IO a -> IO a) -> IO (StM m b)) -> IO (StM m b)
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
g -> m b -> IO (StM m b)
RunInBase m IO
runInBase (m b -> IO (StM m b)) -> m b -> IO (StM m b)
forall a b. (a -> b) -> a -> b
$ (forall a. m a -> m a) -> m b
f ((forall a. m a -> m a) -> m b) -> (forall a. m a -> m a) -> m b
forall a b. (a -> b) -> a -> b
$ (IO (StM m a) -> IO (StM m a)) -> m a -> m a
forall (b :: * -> *) (m :: * -> *) a c.
MonadBaseControl b m =>
(b (StM m a) -> b (StM m c)) -> m a -> m c
liftBaseOp_ IO (StM m a) -> IO (StM m a)
forall a. IO a -> IO a
g

{-# INLINABLE uninterruptibleMask #-}

-- |Generalized version of 'E.uninterruptibleMask_'.
uninterruptibleMask_ :: MonadBaseControl IO m => m a -> m a
uninterruptibleMask_ :: forall (m :: * -> *) a. MonadBaseControl IO m => m a -> m a
uninterruptibleMask_ = (IO (StM m a) -> IO (StM m a)) -> m a -> m a
forall (b :: * -> *) (m :: * -> *) a c.
MonadBaseControl b m =>
(b (StM m a) -> b (StM m c)) -> m a -> m c
liftBaseOp_ IO (StM m a) -> IO (StM m a)
forall a. IO a -> IO a
E.uninterruptibleMask_
{-# INLINABLE uninterruptibleMask_ #-}

-- |Generalized version of 'E.getMaskingState'.
getMaskingState :: MonadBase IO m => m MaskingState
getMaskingState :: forall (m :: * -> *). MonadBase IO m => m MaskingState
getMaskingState = IO MaskingState -> m MaskingState
forall α. IO α -> m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase IO MaskingState
E.getMaskingState
{-# INLINABLE getMaskingState #-}

#if MIN_VERSION_base(4,4,0)
-- |Generalized version of 'E.allowInterrupt'.
allowInterrupt :: MonadBase IO m => m ()
allowInterrupt :: forall (m :: * -> *). MonadBase IO m => m ()
allowInterrupt = IO () -> m ()
forall α. IO α -> m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase IO ()
E.allowInterrupt
{-# INLINABLE allowInterrupt #-}
#endif
#else
-- |Generalized version of 'E.block'.
block :: MonadBaseControl IO m => m a -> m a
block = liftBaseOp_ E.block
{-# INLINABLE block #-}

-- |Generalized version of 'E.unblock'.
unblock :: MonadBaseControl IO m => m a -> m a
unblock = liftBaseOp_ E.unblock
{-# INLINABLE unblock #-}
#endif

#if !MIN_VERSION_base(4,4,0)
-- | Generalized version of 'E.blocked'.
-- returns @True@ if asynchronous exceptions are blocked in the
-- current thread.
blocked :: MonadBase IO m => m Bool
blocked = liftBase E.blocked
{-# INLINABLE blocked #-}
#endif


--------------------------------------------------------------------------------
-- * Brackets
--------------------------------------------------------------------------------

-- |Generalized version of 'E.bracket'.
--
-- Note:
--
-- * When the \"acquire\" or \"release\" computations throw exceptions
--   any monadic side effects in @m@ will be discarded.
--
-- * When the \"in-between\" computation throws an exception any
--   monadic side effects in @m@ produced by that computation will be
--   discarded but the side effects of the \"acquire\" or \"release\"
--   computations will be retained.
--
-- * Also, any monadic side effects in @m@ of the \"release\"
--   computation will be discarded; it is run only for its side
--   effects in @IO@.
--
-- Note that when your @acquire@ and @release@ computations are of type 'IO'
-- it will be more efficient to write:
--
-- @'liftBaseOp' ('E.bracket' acquire release)@
bracket :: MonadBaseControl IO m
        => m a       -- ^ computation to run first (\"acquire resource\")
        -> (a -> m b) -- ^ computation to run last (\"release resource\")
        -> (a -> m c) -- ^ computation to run in-between
        -> m c
bracket :: forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m a
before a -> m b
after a -> m c
thing = (RunInBase m IO -> IO (StM m c)) -> m c
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b (StM m a)) -> m a
control ((RunInBase m IO -> IO (StM m c)) -> m c)
-> (RunInBase m IO -> IO (StM m c)) -> m c
forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
runInIO ->
                               IO (StM m a)
-> (StM m a -> IO (StM m b))
-> (StM m a -> IO (StM m c))
-> IO (StM m c)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (m a -> IO (StM m a)
RunInBase m IO
runInIO m a
before)
                                         (\StM m a
st -> m b -> IO (StM m b)
RunInBase m IO
runInIO (m b -> IO (StM m b)) -> m b -> IO (StM m b)
forall a b. (a -> b) -> a -> b
$ StM m a -> m a
forall a. StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
st m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
after)
                                         (\StM m a
st -> m c -> IO (StM m c)
RunInBase m IO
runInIO (m c -> IO (StM m c)) -> m c -> IO (StM m c)
forall a b. (a -> b) -> a -> b
$ StM m a -> m a
forall a. StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
st m a -> (a -> m c) -> m c
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m c
thing)
{-# INLINABLE bracket #-}

-- |Generalized version of 'E.bracket_'.
--
-- Note any monadic side effects in @m@ of /both/ the \"acquire\" and
-- \"release\" computations will be discarded. To keep the monadic
-- side effects of the \"acquire\" computation, use 'bracket' with
-- constant functions instead.
--
-- Note that when your @acquire@ and @release@ computations are of type 'IO'
-- it will be more efficient to write:
--
-- @'liftBaseOp_' ('E.bracket_' acquire release)@
bracket_ :: MonadBaseControl IO m
         => m a -- ^ computation to run first (\"acquire resource\")
         -> m b -- ^ computation to run last (\"release resource\")
         -> m c -- ^ computation to run in-between
         -> m c
bracket_ :: forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> m b -> m c -> m c
bracket_ m a
before m b
after m c
thing = (RunInBase m IO -> IO (StM m c)) -> m c
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b (StM m a)) -> m a
control ((RunInBase m IO -> IO (StM m c)) -> m c)
-> (RunInBase m IO -> IO (StM m c)) -> m c
forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
runInIO ->
                                IO (StM m a) -> IO (StM m b) -> IO (StM m c) -> IO (StM m c)
forall a b c. IO a -> IO b -> IO c -> IO c
E.bracket_ (m a -> IO (StM m a)
RunInBase m IO
runInIO m a
before)
                                           (m b -> IO (StM m b)
RunInBase m IO
runInIO m b
after)
                                           (m c -> IO (StM m c)
RunInBase m IO
runInIO m c
thing)
{-# INLINABLE bracket_ #-}

-- |Generalized version of 'E.bracketOnError'.
--
-- Note:
--
-- * When the \"acquire\" or \"release\" computations throw exceptions
--   any monadic side effects in @m@ will be discarded.
--
-- * When the \"in-between\" computation throws an exception any
--   monadic side effects in @m@ produced by that computation will be
--   discarded but the side effects of the \"acquire\" computation
--   will be retained.
--
-- * Also, any monadic side effects in @m@ of the \"release\"
--   computation will be discarded; it is run only for its side
--   effects in @IO@.
--
-- Note that when your @acquire@ and @release@ computations are of
-- type 'IO' it will be more efficient to write:
--
-- @'liftBaseOp' ('E.bracketOnError' acquire release)@
bracketOnError :: MonadBaseControl IO m
               => m a       -- ^ computation to run first (\"acquire resource\")
               -> (a -> m b) -- ^ computation to run last (\"release resource\")
               -> (a -> m c) -- ^ computation to run in-between
               -> m c
bracketOnError :: forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError m a
before a -> m b
after a -> m c
thing =
    (RunInBase m IO -> IO (StM m c)) -> m c
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b (StM m a)) -> m a
control ((RunInBase m IO -> IO (StM m c)) -> m c)
-> (RunInBase m IO -> IO (StM m c)) -> m c
forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
runInIO ->
      IO (StM m a)
-> (StM m a -> IO (StM m b))
-> (StM m a -> IO (StM m c))
-> IO (StM m c)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracketOnError (m a -> IO (StM m a)
RunInBase m IO
runInIO m a
before)
                       (\StM m a
st -> m b -> IO (StM m b)
RunInBase m IO
runInIO (m b -> IO (StM m b)) -> m b -> IO (StM m b)
forall a b. (a -> b) -> a -> b
$ StM m a -> m a
forall a. StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
st m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
after)
                       (\StM m a
st -> m c -> IO (StM m c)
RunInBase m IO
runInIO (m c -> IO (StM m c)) -> m c -> IO (StM m c)
forall a b. (a -> b) -> a -> b
$ StM m a -> m a
forall a. StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
st m a -> (a -> m c) -> m c
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m c
thing)
{-# INLINABLE bracketOnError #-}


--------------------------------------------------------------------------------
-- * Utilities
--------------------------------------------------------------------------------

-- |Generalized version of 'E.finally'.
--
-- Note, any monadic side effects in @m@ of the \"afterward\"
-- computation will be discarded.
finally :: MonadBaseControl IO m
        => m a -- ^ computation to run first
        -> m b -- ^ computation to run afterward (even if an exception was raised)
        -> m a
finally :: forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
finally m a
a m b
sequel = (RunInBase m IO -> IO (StM m a)) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b (StM m a)) -> m a
control ((RunInBase m IO -> IO (StM m a)) -> m a)
-> (RunInBase m IO -> IO (StM m a)) -> m a
forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
runInIO ->
                     IO (StM m a) -> IO (StM m b) -> IO (StM m a)
forall a b. IO a -> IO b -> IO a
E.finally (m a -> IO (StM m a)
RunInBase m IO
runInIO m a
a)
                               (m b -> IO (StM m b)
RunInBase m IO
runInIO m b
sequel)
{-# INLINABLE finally #-}

-- |Generalized version of 'E.onException'.
--
-- Note, any monadic side effects in @m@ of the \"afterward\"
-- computation will be discarded.
onException :: MonadBaseControl IO m => m a -> m b -> m a
onException :: forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
onException m a
m m b
what = (RunInBase m IO -> IO (StM m a)) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b (StM m a)) -> m a
control ((RunInBase m IO -> IO (StM m a)) -> m a)
-> (RunInBase m IO -> IO (StM m a)) -> m a
forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
runInIO ->
                       IO (StM m a) -> IO (StM m b) -> IO (StM m a)
forall a b. IO a -> IO b -> IO a
E.onException (m a -> IO (StM m a)
RunInBase m IO
runInIO m a
m)
                                     (m b -> IO (StM m b)
RunInBase m IO
runInIO m b
what)
{-# INLINABLE onException #-}