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

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

    #if __GLASGOW_HASKELL__ >= 702
    {-# LANGUAGE Trustworthy #-}
    #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 = liftBase . E.throwIO
    {-# INLINABLE throwIO #-}

    -- |Generalized version of 'E.ioError'.
    ioError :: MonadBase IO m => IOError -> m a
    ioError = liftBase . E.ioError
    {-# INLINABLE ioError #-}

    -- | Generalized version of 'C.throwTo'.
    throwTo :: (MonadBase IO m, Exception e) => ThreadId -> e -> m ()
    throwTo tid e = liftBase $ C.throwTo tid 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 a handler = control $ \runInIO ->
                        E.catch (runInIO a)
                                (\e -> runInIO $ handler 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 a handlers = control $ \runInIO ->
                           E.catches (runInIO a)
                                     [ E.Handler $ \e -> runInIO $ handler e
                                     | Handler handler <- 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 p a handler = control $ \runInIO ->
                              E.catchJust p
                                          (runInIO a)
                                          (\e -> runInIO (handler 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 handler a = control $ \runInIO ->
                         E.handle (\e -> runInIO (handler e))
                                  (runInIO 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 p handler a = control $ \runInIO ->
                               E.handleJust p (\e -> runInIO (handler e))
                                              (runInIO a)
    {-# INLINABLE handleJust #-}

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

    sequenceEither :: MonadBaseControl IO m => Either e (StM m a) -> m (Either e a)
    sequenceEither = either (return . Left) (liftM Right . 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 m = liftBaseWith (\runInIO -> E.try (runInIO m)) >>= 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 p m = liftBaseWith (\runInIO -> E.tryJust p (runInIO m)) >>= sequenceEither
    {-# INLINABLE tryJust #-}

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

    -- |Generalized version of 'E.evaluate'.
    evaluate :: MonadBase IO m => a -> m a
    evaluate = liftBase . 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 f = control $ \runInBase ->
               E.mask $ \g -> runInBase $ f $ liftBaseOp_ g
    {-# INLINABLE mask #-}

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

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

    {-# INLINABLE uninterruptibleMask #-}

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

    -- |Generalized version of 'E.getMaskingState'.
    getMaskingState :: MonadBase IO m => m MaskingState
    getMaskingState = liftBase E.getMaskingState
    {-# INLINABLE getMaskingState #-}

    #if MIN_VERSION_base(4,4,0)
    -- |Generalized version of 'E.allowInterrupt'.
    allowInterrupt :: MonadBase IO m => m ()
    allowInterrupt = liftBase 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 before after thing = control $ \runInIO ->
                                   E.bracket (runInIO before)
                                             (\st -> runInIO $ restoreM st >>= after)
                                             (\st -> runInIO $ restoreM st >>= 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_ before after thing = control $ \runInIO ->
                                    E.bracket_ (runInIO before)
                                               (runInIO after)
                                               (runInIO 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 before after thing =
        control $ \runInIO ->
          E.bracketOnError (runInIO before)
                           (\st -> runInIO $ restoreM st >>= after)
                           (\st -> runInIO $ restoreM st >>= 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 a sequel = control $ \runInIO ->
                         E.finally (runInIO a)
                                   (runInIO 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 m what = control $ \runInIO ->
                           E.onException (runInIO m)
                                         (runInIO what)
    {-# INLINABLE onException #-}