Exception.hs 3.59 KB
Newer Older
1
{-# OPTIONS_GHC -fno-warn-deprecations #-}
2 3
module Exception
    (
4 5 6 7 8 9 10
    module Control.Exception,
    module Exception
    )
    where

import Prelude hiding (catch)

11
import Control.Exception
12

13 14 15 16 17
#if __GLASGOW_HASKELL__ < 613
mask_ :: ((IO a -> IO a) -> IO b) -> IO b
mask_ f = block (f unblock)
#endif

18 19
catchIO :: IO a -> (IOException -> IO a) -> IO a
catchIO = catch
20

21 22
handleIO :: (IOException -> IO a) -> IO a -> IO a
handleIO = flip catchIO
23

24 25
tryIO :: IO a -> IO (Either IOException a)
tryIO = try
26

27 28 29
-- | A monad that can catch exceptions.  A minimal definition
-- requires a definition of 'gcatch'.
--
30 31 32 33 34 35 36
-- 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.
--
37
class Monad m => ExceptionMonad m where
38

39 40 41 42
  -- | 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

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 48 49 50 51 52 53 54
  -- | 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

55 56 57 58 59 60 61 62 63 64 65 66 67
  -- | 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
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 78
    gmask $ \restore -> do
      r <- restore a `gonException` sequel
79
      _ <- sequel
80
      return r
81

82 83 84 85 86 87 88
#if __GLASGOW_HASKELL__ < 613
instance ExceptionMonad IO where
  gcatch    = catch
  gmask f   = block $ f unblock
  gblock    = block
  gunblock  = unblock
#else
89 90
instance ExceptionMonad IO where
  gcatch    = catch
91
  gmask f   = mask (\x -> f x)
92 93
  gblock    = block
  gunblock  = unblock
94
#endif
95 96 97 98 99 100 101 102 103 104 105 106 107 108

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 ->
109
                             do _ <- cleanup
110
                                throw (e :: SomeException)
111