compiler/utils/Exception.hs

   1
   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 catchIO :: IO a -> (IOException -> IO a) -> IO a
  14 catchIO = catch
  15
  16 handleIO :: (IOException -> IO a) -> IO a -> IO a
  17 handleIO = flip catchIO
  18
  19 tryIO :: IO a -> IO (Either IOException a)
  20 tryIO = try
  21
  22 -- | A monad that can catch exceptions.  A minimal definition
  23 -- requires a definition of 'gcatch'.
  24 --
  25 -- Implementations on top of 'IO' should implement 'gblock' and 'gunblock' to
  26 -- eventually call the primitives 'Control.Exception.block' and
  27 -- 'Control.Exception.unblock' respectively.  These are used for
  28 -- implementations that support asynchronous exceptions.  The default
  29 -- implementations of 'gbracket' and 'gfinally' use 'gblock' and 'gunblock'
  30 -- thus rarely require overriding.
  31 --
  32 class Monad m => ExceptionMonad m where
  33
  34   -- | Generalised version of 'Control.Exception.catch', allowing an arbitrary
  35   -- exception handling monad instead of just 'IO'.
  36   gcatch :: Exception e => m a -> (e -> m a) -> m a
  37
  38   -- | Generalised version of 'Control.Exception.block', allowing an arbitrary
  39   -- exception handling monad instead of just 'IO'.
  40   gblock :: m a -> m a
  41
  42   -- | Generalised version of 'Control.Exception.unblock', allowing an
  43   -- arbitrary exception handling monad instead of just 'IO'.
  44   gunblock :: m a -> m a
  45
  46   -- | Generalised version of 'Control.Exception.bracket', allowing an arbitrary
  47   -- exception handling monad instead of just 'IO'.
  48   gbracket :: m a -> (a -> m b) -> (a -> m c) -> m c
  49
  50   -- | Generalised version of 'Control.Exception.finally', allowing an arbitrary
  51   -- exception handling monad instead of just 'IO'.
  52   gfinally :: m a -> m b -> m a
  53
  54   gblock = id
  55   gunblock = id
  56
  57   gbracket before after thing =
  58     gblock (do
  59       a <- before
  60       r <- gunblock (thing a) `gonException` after a
  61       _ <- after a
  62       return r)
  63
  64   a `gfinally` sequel =
  65     gblock (do
  66       r <- gunblock a `gonException` sequel
  67       _ <- sequel
  68       return r)
  69
  70 instance ExceptionMonad IO where
  71   gcatch    = catch
  72   gblock    = block
  73   gunblock  = unblock
  74
  75 gtry :: (ExceptionMonad m, Exception e) => m a -> m (Either e a)
  76 gtry act = gcatch (act >>= \a -> return (Right a))
  77                   (\e -> return (Left e))
  78
  79 -- | Generalised version of 'Control.Exception.handle', allowing an arbitrary
  80 -- exception handling monad instead of just 'IO'.
  81 ghandle :: (ExceptionMonad m, Exception e) => (e -> m a) -> m a -> m a
  82 ghandle = flip gcatch
  83
  84 -- | Always executes the first argument.  If this throws an exception the
  85 -- second argument is executed and the exception is raised again.
  86 gonException :: (ExceptionMonad m) => m a -> m b -> m a
  87 gonException ioA cleanup = ioA `gcatch` \e ->
  88                              do _ <- cleanup
  89                                 throw (e :: SomeException)
  90