1{-# OPTIONS_GHC -fno-warn-deprecations #-}
2module Exception
3    (
4    module Control.Exception,
5    module Exception
6    )
7    where
8
9import GhcPrelude
10
11import Control.Exception
12import Control.Monad.IO.Class
13
14catchIO :: IO a -> (IOException -> IO a) -> IO a
15catchIO = Control.Exception.catch
16
17handleIO :: (IOException -> IO a) -> IO a -> IO a
18handleIO = flip catchIO
19
20tryIO :: IO a -> IO (Either IOException a)
21tryIO = try
22
23-- | A monad that can catch exceptions.  A minimal definition
24-- requires a definition of 'gcatch'.
25--
26-- Implementations on top of 'IO' should implement 'gmask' to
27-- eventually call the primitive 'Control.Exception.mask'.
28-- These are used for
29-- implementations that support asynchronous exceptions.  The default
30-- implementations of 'gbracket' and 'gfinally' use 'gmask'
31-- thus rarely require overriding.
32--
33class MonadIO m => ExceptionMonad m where
34
35  -- | Generalised version of 'Control.Exception.catch', allowing an arbitrary
36  -- exception handling monad instead of just 'IO'.
37  gcatch :: Exception e => m a -> (e -> m a) -> m a
38
39  -- | Generalised version of 'Control.Exception.mask_', allowing an arbitrary
40  -- exception handling monad instead of just 'IO'.
41  gmask :: ((m a -> m a) -> m b) -> m b
42
43  -- | Generalised version of 'Control.Exception.bracket', allowing an arbitrary
44  -- exception handling monad instead of just 'IO'.
45  gbracket :: m a -> (a -> m b) -> (a -> m c) -> m c
46
47  -- | Generalised version of 'Control.Exception.finally', allowing an arbitrary
48  -- exception handling monad instead of just 'IO'.
49  gfinally :: m a -> m b -> m a
50
51  gbracket before after thing =
52    gmask $ \restore -> do
53      a <- before
54      r <- restore (thing a) `gonException` after a
55      _ <- after a
56      return r
57
58  a `gfinally` sequel =
59    gmask $ \restore -> do
60      r <- restore a `gonException` sequel
61      _ <- sequel
62      return r
63
64instance ExceptionMonad IO where
65  gcatch    = Control.Exception.catch
66  gmask f   = mask (\x -> f x)
67
68gtry :: (ExceptionMonad m, Exception e) => m a -> m (Either e a)
69gtry act = gcatch (act >>= \a -> return (Right a))
70                  (\e -> return (Left e))
71
72-- | Generalised version of 'Control.Exception.handle', allowing an arbitrary
73-- exception handling monad instead of just 'IO'.
74ghandle :: (ExceptionMonad m, Exception e) => (e -> m a) -> m a -> m a
75ghandle = flip gcatch
76
77-- | Always executes the first argument.  If this throws an exception the
78-- second argument is executed and the exception is raised again.
79gonException :: (ExceptionMonad m) => m a -> m b -> m a
80gonException ioA cleanup = ioA `gcatch` \e ->
81                             do _ <- cleanup
82                                liftIO $ throwIO (e :: SomeException)
83
84