monadology-0.1: src/Control/Monad/Ology/General/Exception.hs

module Control.Monad.Ology.General.Exception
    ( module Control.Monad.Ology.General.Exception.Class
    , module Control.Monad.Ology.General.Exception
    , CE.SomeException
    , CE.evaluate
    ) where

import qualified Control.Exception as CE
import Control.Monad.Ology.General.Exception.Class
import Control.Monad.Ology.General.Function
import Control.Monad.Ology.General.Trans.Hoist
import Control.Monad.Ology.General.Trans.Tunnel
import Import

-- | Run with asynchronous exceptions masked, passing an unmask function.
mask ::
       forall m b. MonadTunnelIO m
    => ((forall a. m a -> m a) -> m b)
    -> m b
mask call = tunnelIO $ \unlift -> CE.mask $ \restore -> unlift $ call $ hoistIO restore

-- | Bracket an operation with before and after operations.
-- The whole thing is masked, with the main operation unmasked.
bracket ::
       forall m a b. (MonadException m, MonadTunnelIO m)
    => m a
    -> (a -> m ())
    -> (a -> m b)
    -> m b
bracket before after thing =
    mask $ \restore -> do
        a <- before
        b <- onException (restore (thing a)) (after a)
        after a
        return b

-- | Variant of 'bracket'.
finally ::
       forall m a. (MonadException m, MonadTunnelIO m)
    => m a
    -> m ()
    -> m a
finally ma handler = bracket (return ()) (const handler) (const ma)

-- | Variant of 'bracket'.
bracket_ ::
       forall m. (MonadException m, MonadTunnelIO m)
    => m ()
    -> m ()
    -> m --> m
bracket_ before after thing = bracket before (const after) (const thing)