-
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
module Exception
(
module Control.Exception,
import Prelude hiding (catch)
-#if __GLASGOW_HASKELL__ < 609
-import Control.Exception.Extensible as Control.Exception
-#else
import Control.Exception
-#endif
catchIO :: IO a -> (IOException -> IO a) -> IO a
catchIO = catch
-- | A monad that can catch exceptions. A minimal definition
-- requires a definition of 'gcatch'.
--
--- Although, 'gbracket' and 'gfinally' could be modelled on top of 'gcatch',
--- they are included in the type class since GHC needs special implementations
--- of these in order to properly handle asynchronous exceptions.
+-- Implementations on top of 'IO' should implement 'gblock' and 'gunblock' to
+-- eventually call the primitives 'Control.Exception.block' and
+-- 'Control.Exception.unblock' respectively. These are used for
+-- implementations that support asynchronous exceptions. The default
+-- implementations of 'gbracket' and 'gfinally' use 'gblock' and 'gunblock'
+-- thus rarely require overriding.
+--
class Monad 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
-- exception handling monad instead of just 'IO'.
gfinally :: m a -> m b -> m a
- gbracket acquire release in_between = do
- a <- acquire
- r <- in_between a `gonException` release a
- release a
+ -- | DEPRECATED, here for backwards compatibilty. Instances can
+ -- define either 'gmask', or both 'block' and 'unblock'.
+ gblock :: m a -> m a
+ -- | DEPRECATED, here for backwards compatibilty Instances can
+ -- define either 'gmask', or both 'block' and 'unblock'.
+ gunblock :: m a -> m a
+ -- XXX we're keeping these two methods for the time being because we
+ -- have to interact with Haskeline's MonadException class which
+ -- still has block/unblock; see GhciMonad.hs.
+
+ gmask f = gblock (f gunblock)
+ gblock f = gmask (\_ -> f)
+ gunblock f = f -- XXX wrong; better override this if you need it
+
+ gbracket before after thing =
+ gmask $ \restore -> do
+ a <- before
+ r <- restore (thing a) `gonException` after a
+ _ <- after a
return r
- gfinally thing cleanup = do
- r <- thing `gonException` cleanup
- cleanup
+ a `gfinally` sequel =
+ gmask $ \restore -> do
+ r <- restore a `gonException` sequel
+ _ <- sequel
return r
+#if __GLASGOW_HASKELL__ < 613
instance ExceptionMonad IO where
gcatch = catch
- gbracket = bracket
- gfinally = finally
-
+ gmask f = block $ f unblock
+ gblock = block
+ gunblock = unblock
+#else
+instance ExceptionMonad IO where
+ gcatch = catch
+ gmask f = mask (\x -> f x)
+ gblock = block
+ gunblock = unblock
+#endif
gtry :: (ExceptionMonad m, Exception e) => m a -> m (Either e a)
gtry act = gcatch (act >>= \a -> return (Right a))
-- 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
+ do _ <- cleanup
throw (e :: SomeException)