    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE ConstraintKinds #-}
    module Foundation.Monad.Exception
        ( MonadThrow(..)
        , MonadCatch(..)
        , MonadBracket(..)
        ) where

    import           Basement.Compat.Base
    import qualified Control.Exception as E

    -- | Monad that can throw exception
    class Monad m => MonadThrow m where
        -- | Throw immediatity an exception.
        -- Only a 'MonadCatch' monad will be able to catch the exception using 'catch'
        throw :: Exception e => e -> m a

    -- | Monad that can catch exception
    class MonadThrow m => MonadCatch m where
        catch :: Exception e => m a -> (e -> m a) -> m a

    -- | Monad that can ensure cleanup actions are performed even in the
    -- case of exceptions, both synchronous and asynchronous. This usually
    -- excludes continuation-based monads.
    class MonadCatch m => MonadBracket m where
        -- | A generalized version of the standard bracket function which
        -- allows distinguishing different exit cases.
        generalBracket
            :: m a
            -- ^ acquire some resource
            -> (a -> b -> m ignored1)
            -- ^ cleanup, no exception thrown
            -> (a -> E.SomeException -> m ignored2)
            -- ^ cleanup, some exception thrown. The exception will be rethrown
            -> (a -> m b)
            -- ^ inner action to perform with the resource
            -> m b

    instance MonadThrow IO where
        throw :: e -> IO a
    throw = e -> IO a
    forall e a. Exception e => e -> IO a
    E.throwIO
    instance MonadCatch IO where
        catch :: IO a -> (e -> IO a) -> IO a
    catch = IO a -> (e -> IO a) -> IO a
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    E.catch
    instance MonadBracket IO where
        generalBracket :: IO a
    -> (a -> b -> IO ignored1)
    -> (a -> SomeException -> IO ignored2)
    -> (a -> IO b)
    -> IO b
    generalBracket acquire :: IO a
    acquire onSuccess :: a -> b -> IO ignored1
    onSuccess onException :: a -> SomeException -> IO ignored2
    onException inner :: a -> IO b
    inner = ((forall a. IO a -> IO a) -> IO b) -> IO b
    forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
    E.mask (((forall a. IO a -> IO a) -> IO b) -> IO b)
    -> ((forall a. IO a -> IO a) -> IO b) -> IO b
    forall a b. (a -> b) -> a -> b
    $ \restore :: forall a. IO a -> IO a
    restore -> do
            a
    x <- IO a
    acquire
            Either SomeException b
    res1 <- IO b -> IO (Either SomeException b)
    forall e a. Exception e => IO a -> IO (Either e a)
    E.try (IO b -> IO (Either SomeException b))
    -> IO b -> IO (Either SomeException b)
    forall a b. (a -> b) -> a -> b
    $ IO b -> IO b
    forall a. IO a -> IO a
    restore (IO b -> IO b) -> IO b -> IO b
    forall a b. (a -> b) -> a -> b
    $ a -> IO b
    inner a
    x
            case Either SomeException b
    res1 of
                Left (SomeException
    e1 :: E.SomeException) -> do
                    -- explicitly ignore exceptions from the cleanup
                    -- action so we keep the original exception
                    IO () -> IO ()
    forall a. IO a -> IO a
    E.uninterruptibleMask_ (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (ignored2 -> ()) -> IO ignored2 -> IO ()
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (() -> ignored2 -> ()
    forall a b. a -> b -> a
    const ()) (a -> SomeException -> IO ignored2
    onException a
    x SomeException
    e1) IO () -> (SomeException -> IO ()) -> IO ()
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch`
                        (\(SomeException
    _ :: E.SomeException) -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
                    SomeException -> IO b
    forall e a. Exception e => e -> IO a
    E.throwIO SomeException
    e1
                Right y :: b
    y -> do
                    -- Allow exceptions from the onSuccess function to propagate
                    ignored1
    _ <- a -> b -> IO ignored1
    onSuccess a
    x b
    y
                    b -> IO b
    forall (m :: * -> *) a. Monad m => a -> m a
    return b
    y