diff options
Diffstat (limited to 'compiler/GHC/Utils/Exception.hs')
-rw-r--r-- | compiler/GHC/Utils/Exception.hs | 71 |
1 files changed, 8 insertions, 63 deletions
diff --git a/compiler/GHC/Utils/Exception.hs b/compiler/GHC/Utils/Exception.hs index e84221cdbe..49fa19bd47 100644 --- a/compiler/GHC/Utils/Exception.hs +++ b/compiler/GHC/Utils/Exception.hs @@ -1,4 +1,6 @@ {-# OPTIONS_GHC -fno-warn-deprecations #-} +{-# LANGUAGE ConstraintKinds #-} + module GHC.Utils.Exception ( module Control.Exception, @@ -9,75 +11,18 @@ module GHC.Utils.Exception import GHC.Prelude import Control.Exception +import Control.Exception as CE import Control.Monad.IO.Class +import Control.Monad.Catch +-- Monomorphised versions of exception-handling utilities catchIO :: IO a -> (IOException -> IO a) -> IO a -catchIO = Control.Exception.catch +catchIO = CE.catch handleIO :: (IOException -> IO a) -> IO a -> IO a handleIO = flip catchIO tryIO :: IO a -> IO (Either IOException a) -tryIO = try - --- | A monad that can catch exceptions. A minimal definition --- requires a definition of 'gcatch'. --- --- Implementations on top of 'IO' should implement 'gmask' to --- eventually call the primitive 'Control.Exception.mask'. --- These are used for --- implementations that support asynchronous exceptions. The default --- implementations of 'gbracket' and 'gfinally' use 'gmask' --- thus rarely require overriding. --- -class MonadIO m => ExceptionMonad m where - - -- | Generalised version of 'Control.Exception.catch', allowing an arbitrary - -- exception handling monad instead of just 'IO'. - gcatch :: Exception e => m a -> (e -> m a) -> m a - - -- | Generalised version of 'Control.Exception.mask_', allowing an arbitrary - -- exception handling monad instead of just 'IO'. - gmask :: ((m a -> m a) -> m b) -> m b - - -- | Generalised version of 'Control.Exception.bracket', allowing an arbitrary - -- exception handling monad instead of just 'IO'. - gbracket :: m a -> (a -> m b) -> (a -> m c) -> m c - - -- | Generalised version of 'Control.Exception.finally', allowing an arbitrary - -- exception handling monad instead of just 'IO'. - gfinally :: m a -> m b -> m a - - gbracket before after thing = - gmask $ \restore -> do - a <- before - r <- restore (thing a) `gonException` after a - _ <- after a - return r - - a `gfinally` sequel = - gmask $ \restore -> do - r <- restore a `gonException` sequel - _ <- sequel - return r - -instance ExceptionMonad IO where - gcatch = Control.Exception.catch - gmask f = mask (\x -> f x) - -gtry :: (ExceptionMonad m, Exception e) => m a -> m (Either e a) -gtry act = gcatch (act >>= \a -> return (Right a)) - (\e -> return (Left e)) - --- | Generalised version of 'Control.Exception.handle', allowing an arbitrary --- exception handling monad instead of just 'IO'. -ghandle :: (ExceptionMonad m, Exception e) => (e -> m a) -> m a -> m a -ghandle = flip gcatch - --- | Always executes the first argument. If this throws an exception the --- second argument is executed and the exception is raised again. -gonException :: (ExceptionMonad m) => m a -> m b -> m a -gonException ioA cleanup = ioA `gcatch` \e -> - do _ <- cleanup - liftIO $ throwIO (e :: SomeException) +tryIO = CE.try +type ExceptionMonad m = (MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) |