compiler/utils/Exception.hs

   1 {-# OPTIONS_GHC -fno-warn-deprecations #-}
   2 module Exception
   3     (
   4     module Control.Exception,
   5     module Exception
   6     )
   7     where
   8
   9 import Prelude hiding (catch)
  10
  11 import Control.Exception
  12
  13 #if __GLASGOW_HASKELL__ < 613
  14 mask_ :: ((IO a -> IO a) -> IO b) -> IO b
  15 mask_ f = block (f unblock)
  16 #endif
  17
  18 catchIO :: IO a -> (IOException -> IO a) -> IO a
  19 catchIO = catch
  20
  21 handleIO :: (IOException -> IO a) -> IO a -> IO a
  22 handleIO = flip catchIO
  23
  24 tryIO :: IO a -> IO (Either IOException a)
  25 tryIO = try
  26
  27 -- | A monad that can catch exceptions.  A minimal definition
  28 -- requires a definition of 'gcatch'.
  29 --
  30 -- Implementations on top of 'IO' should implement 'gblock' and 'gunblock' to
  31 -- eventually call the primitives 'Control.Exception.block' and
  32 -- 'Control.Exception.unblock' respectively.  These are used for
  33 -- implementations that support asynchronous exceptions.  The default
  34 -- implementations of 'gbracket' and 'gfinally' use 'gblock' and 'gunblock'
  35 -- thus rarely require overriding.
  36 --
  37 class Monad m => ExceptionMonad m where
  38
  39   -- | Generalised version of 'Control.Exception.catch', allowing an arbitrary
  40   -- exception handling monad instead of just 'IO'.
  41   gcatch :: Exception e => m a -> (e -> m a) -> m a
  42
  43   -- | Generalised version of 'Control.Exception.mask_', allowing an arbitrary
  44   -- exception handling monad instead of just 'IO'.
  45   gmask :: ((m a -> m a) -> m b) -> m b
  46
  47   -- | Generalised version of 'Control.Exception.bracket', allowing an arbitrary
  48   -- exception handling monad instead of just 'IO'.
  49   gbracket :: m a -> (a -> m b) -> (a -> m c) -> m c
  50
  51   -- | Generalised version of 'Control.Exception.finally', allowing an arbitrary
  52   -- exception handling monad instead of just 'IO'.
  53   gfinally :: m a -> m b -> m a
  54
  55   -- | DEPRECATED, here for backwards compatibilty.  Instances can
  56   -- define either 'gmask', or both 'block' and 'unblock'.
  57   gblock   :: m a -> m a
  58   -- | DEPRECATED, here for backwards compatibilty  Instances can
  59   -- define either 'gmask', or both 'block' and 'unblock'.
  60   gunblock :: m a -> m a
  61   -- XXX we're keeping these two methods for the time being because we
  62   -- have to interact with Haskeline's MonadException class which
  63   -- still has block/unblock; see GhciMonad.hs.
  64
  65   gmask    f = gblock (f gunblock)
  66   gblock   f = gmask (\_ -> f)
  67   gunblock f = f -- XXX wrong; better override this if you need it
  68
  69   gbracket before after thing =
  70     gmask $ \restore -> do
  71       a <- before
  72       r <- restore (thing a) `gonException` after a
  73       _ <- after a
  74       return r
  75
  76   a `gfinally` sequel =
  77     gmask $ \restore -> do
  78       r <- restore a `gonException` sequel
  79       _ <- sequel
  80       return r
  81
  82 #if __GLASGOW_HASKELL__ < 613
  83 instance ExceptionMonad IO where
  84   gcatch    = catch
  85   gmask f   = block $ f unblock
  86   gblock    = block
  87   gunblock  = unblock
  88 #else
  89 instance ExceptionMonad IO where
  90   gcatch    = catch
  91   gmask f   = mask (\x -> f x)
  92   gblock    = block
  93   gunblock  = unblock
  94 #endif
  95
  96 gtry :: (ExceptionMonad m, Exception e) => m a -> m (Either e a)
  97 gtry act = gcatch (act >>= \a -> return (Right a))
  98                   (\e -> return (Left e))
  99
 100 -- | Generalised version of 'Control.Exception.handle', allowing an arbitrary
 101 -- exception handling monad instead of just 'IO'.
 102 ghandle :: (ExceptionMonad m, Exception e) => (e -> m a) -> m a -> m a
 103 ghandle = flip gcatch
 104
 105 -- | Always executes the first argument.  If this throws an exception the
 106 -- second argument is executed and the exception is raised again.
 107 gonException :: (ExceptionMonad m) => m a -> m b -> m a
 108 gonException ioA cleanup = ioA `gcatch` \e ->
 109                              do _ <- cleanup
 110                                 throw (e :: SomeException)
 111