module Control.Exception.Monadic
(
MonadException (..)
, catches
, Handler (..)
, catchJust
, handle
, handleJust
, try
, tryJust
, bracket_
, bracketOnError
, finally
, onException
, evaluate
, unsafeEvaluate
, E.mapException
, throwTo
, mask
, mask_
, uninterruptibleMask
, uninterruptibleMask_
, E.MaskingState (..)
, getMaskingState
, allowInterrupt
, E.SomeException (..)
, E.Exception (..)
, E.IOException
, E.ArithException (..)
, E.ArrayException (..)
, E.AssertionFailed (..)
, E.AsyncException (..)
, E.NonTermination (..)
, E.NestedAtomically (..)
, E.BlockedIndefinitelyOnMVar (..)
, E.BlockedIndefinitelyOnSTM (..)
, E.Deadlock (..)
, E.NoMethodError (..)
, E.PatternMatchFail (..)
, E.RecConError (..)
, E.RecSelError (..)
, E.RecUpdError (..)
, E.ErrorCall (..)
)
where
import Control.Concurrent (ThreadId)
import Control.Exception (Exception (..), SomeException)
import qualified Control.Exception as E
import Control.Monad (liftM)
import Control.Monad.Base (MonadBase (..))
import Control.Monad.Exception.Class
import Control.Monad.Trans.Control
( MonadBaseControl
, liftBaseOp
, liftBaseOp_
)
import Control.Monad.Trans.Exception
import Prelude hiding (catch)
import System.IO.Unsafe (unsafePerformIO)
catches :: MonadException m => m a -> [Handler m a] -> m a
catches m handlers = m `catch` go handlers
where
go [] e = throw e
go (Handler handler:xs) e = maybe (go xs e) handler (fromException e)
data Handler m a = forall e. Exception e => Handler (e -> m a)
catchJust
:: (MonadException m, Exception e)
=> (e -> Maybe b)
-> m a
-> (b -> m a)
-> m a
catchJust p a handler = catch a (\e -> maybe (throw e) handler (p e))
handle :: (MonadException m, Exception e) => (e -> m a) -> m a -> m a
handle = flip catch
handleJust
:: (MonadException m, Exception e)
=> (e -> Maybe b)
-> (b -> m a)
-> m a
-> m a
handleJust p = flip (catchJust p)
try :: (MonadException m, Exception e) => m a -> m (Either e a)
try = handle (return . Left) . liftM Right
tryJust
:: (MonadException m, Exception e)
=> (e -> Maybe b)
-> m a
-> m (Either b a)
tryJust p = handleJust p (return . Left) . liftM Right
bracketOnError :: MonadException m => m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError a b c = bracket
(bracket
a
(const (return ()))
(\a' -> liftM Right (c a') `catch` \e -> return (Left (e, a'))))
(const (return ()))
(\e -> case e of
Right c' -> return c'
Left (e@(E.SomeException _), a') -> bracket
(b a')
(const (return ()))
(const (throw e)))
bracket_ :: MonadException m => m a -> m b -> m c -> m c
bracket_ a b c = bracket a (const b) (const c)
finally :: MonadException m => m a -> m b -> m a
finally a b = bracket_ (return ()) b a
onException :: MonadException m => m a -> m b -> m a
onException a b = a `catch` \e -> b >> throw (e :: SomeException)
evaluate :: MonadBase IO m => a -> m a
evaluate = liftBase . E.evaluate
unsafeEvaluate :: MonadException m => a -> m a
unsafeEvaluate = either throw return . unsafePerformIO . try' . evaluate
where
try' :: IO a -> IO (Either SomeException a)
try' = E.try
throwTo :: (MonadBase IO m, Exception e) => ThreadId -> e -> m ()
throwTo tid e = liftBase $ E.throwTo tid e
mask
:: MonadBaseControl IO m
=> ((forall n b. MonadBaseControl IO n => n b -> n b) -> m a)
-> m a
mask = liftBaseOp E.mask . liftUnmask
where
liftUnmask
:: ((forall m a. MonadBaseControl IO m => m a -> m a) -> b)
-> (forall a. IO a -> IO a)
-> b
liftUnmask f unmask = f $ liftBaseOp_ unmask
mask_ :: MonadBaseControl IO m => m a -> m a
mask_ = mask . const
uninterruptibleMask
:: MonadBaseControl IO m
=> ((forall n b. MonadBaseControl IO n => n b -> n b) -> m a)
-> m a
uninterruptibleMask = liftBaseOp E.uninterruptibleMask . liftUnmask
where
liftUnmask
:: ((forall m a. MonadBaseControl IO m => m a -> m a) -> b)
-> (forall a. IO a -> IO a)
-> b
liftUnmask f unmask = f $ liftBaseOp_ unmask
uninterruptibleMask_ :: MonadBaseControl IO m => m a -> m a
uninterruptibleMask_ = uninterruptibleMask . const
getMaskingState :: MonadBase IO m => m E.MaskingState
getMaskingState = liftBase E.getMaskingState
allowInterrupt :: MonadBase IO m => m ()
allowInterrupt = liftBase E.allowInterrupt