ghc/lib/exts/Exception.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: Exception.lhs,v 1.6 1999/03/16 13:20:11 simonm Exp $
   3 %
   4 % (c) The GRAP/AQUA Project, Glasgow University, 1998
   5 %
   6
   7 The External API for exceptions.  The functions provided in this
   8 module allow catching of exceptions in the IO monad.
   9
  10 \begin{code}
  11 module Exception (
  12
  13         Exception(..),          -- instance Show
  14         ArithException(..),     -- instance Show
  15         AsyncException(..),     -- instance Show
  16
  17         tryAll,    -- :: a    -> IO (Either Exception a)
  18         tryAllIO,  -- :: IO a -> IO (Either Exception a)
  19         try,       -- :: (Exception -> Maybe b) -> a    -> IO (Either b a)
  20         tryIO,     -- :: (Exception -> Maybe b) -> IO a -> IO (Either b a)
  21
  22         catchAll,  -- :: a    -> (Exception -> IO a) -> IO a
  23         catchAllIO,-- :: IO a -> (Exception -> IO a) -> IO a
  24         catch,     -- :: (Exception -> Maybe b) -> a    -> (b -> IO a) -> IO a
  25         catchIO,   -- :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a
  26
  27         -- Exception predicates
  28
  29         justIoErrors,           -- :: Exception -> Maybe IOError
  30         justArithExceptions,    -- :: Exception -> Maybe ArithException
  31         justErrors,             -- :: Exception -> Maybe String
  32         justDynExceptions,      -- :: Exception -> Maybe Dynamic
  33         justAssertions,         -- :: Exception -> Maybe String
  34         justAsyncExceptions,    -- :: Exception -> Maybe AsyncException
  35
  36         -- Throwing exceptions
  37
  38         throw,          -- :: Exception -> a
  39         raiseInThread,  -- :: ThreadId -> Exception -> a
  40
  41         -- Dynamic exceptions
  42
  43         throwDyn,       -- :: Typeable ex => ex -> b
  44         catchDyn,       -- :: Typeable ex => IO a -> (ex -> IO a) -> IO a
  45
  46         -- Utilities
  47
  48         finally,        -- :: IO a -> IO b -> IO b
  49
  50         bracket,        -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO ()
  51         bracket_,       -- :: IO a -> IO b -> IO c -> IO ()
  52
  53   ) where
  54
  55 #ifdef __HUGS__
  56 import PreludeBuiltin hiding (catch)
  57 import Prelude        hiding (catch)
  58 #else
  59 import Prelude hiding (catch)
  60 import PrelGHC (catch#)
  61 import PrelException hiding (catch)
  62 import PrelConc ( raiseInThread )
  63 #endif
  64
  65 import Dynamic
  66 \end{code}
  67
  68 -----------------------------------------------------------------------------
  69 Catching exceptions
  70
  71 PrelException defines 'catchException' for us.
  72
  73 \begin{code}
  74 catchAll  :: a    -> (Exception -> IO a) -> IO a
  75 #ifdef __HUGS__
  76 catchAll a handler = primCatch' (case primForce a of () -> return a) handler
  77 #else
  78 catchAll a handler = catch# (a `seq` return a) handler
  79 #endif
  80
  81 catchAllIO :: IO a -> (Exception -> IO a) -> IO a
  82 catchAllIO =  catchException
  83
  84 catch :: (Exception -> Maybe b) -> a -> (b -> IO a) -> IO a
  85 catch p a handler = catchAll a handler'
  86   where handler' e = case p e of
  87                         Nothing -> throw e
  88                         Just b  -> handler b
  89
  90 catchIO :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a
  91 catchIO p a handler = catchAllIO a handler'
  92   where handler' e = case p e of
  93                         Nothing -> throw e
  94                         Just b  -> handler b
  95 \end{code}
  96
  97 -----------------------------------------------------------------------------
  98 'try' and variations.
  99
 100 \begin{code}
 101 tryAll :: a    -> IO (Either Exception a)
 102 #ifdef __HUGS__
 103 tryAll a = primCatch' (case primForce a of { () -> return Nothing})
 104                             (\e -> return (Just e))
 105 #else
 106 tryAll a = catch# (a `seq` return (Right a)) (\e -> return (Left e))
 107 #endif
 108
 109 tryAllIO :: IO a -> IO (Either Exception a)
 110 tryAllIO a = catchAllIO (a >>= \ v -> return (Right v))
 111                         (\e -> return (Left e))
 112
 113 try :: (Exception -> Maybe b) -> a -> IO (Either b a)
 114 try p a = do
 115   r <- tryAll a
 116   case r of
 117         Right v -> return (Right v)
 118         Left  e -> case p e of
 119                         Nothing -> throw e
 120                         Just b  -> return (Left b)
 121
 122 tryIO :: (Exception -> Maybe b) -> IO a -> IO (Either b a)
 123 tryIO p a = do
 124   r <- tryAllIO a
 125   case r of
 126         Right v -> return (Right v)
 127         Left  e -> case p e of
 128                         Nothing -> throw e
 129                         Just b  -> return (Left b)
 130 \end{code}
 131
 132 -----------------------------------------------------------------------------
 133 Dynamic exception types.  Since one of the possible kinds of exception
 134 is a dynamically typed value, we can effectively have polymorphic
 135 exceptions.
 136
 137 throwDyn will raise any value as an exception, provided it is in the
 138 Typeable class (see Dynamic.lhs).
 139
 140 catchDyn will catch any exception of a given type (determined by the
 141 handler function).  Any raised exceptions that don't match are
 142 re-raised.
 143
 144 \begin{code}
 145 throwDyn :: Typeable exception => exception -> b
 146 throwDyn exception = throw (DynException (toDyn exception))
 147
 148 catchDyn :: Typeable exception => IO a -> (exception -> IO a) -> IO a
 149 catchDyn m k = catchException m handle
 150   where handle ex = case ex of
 151                            (DynException dyn) ->
 152                                 case fromDynamic dyn of
 153                                     Just exception  -> k exception
 154                                     Nothing -> throw ex
 155                            _ -> throw ex
 156 \end{code}
 157
 158 -----------------------------------------------------------------------------
 159 Exception Predicates
 160
 161 \begin{code}
 162 justIoErrors            :: Exception -> Maybe IOError
 163 justArithExceptions     :: Exception -> Maybe ArithException
 164 justErrors              :: Exception -> Maybe String
 165 justDynExceptions       :: Exception -> Maybe Dynamic
 166 justAssertions          :: Exception -> Maybe String
 167 justAsyncExceptions     :: Exception -> Maybe AsyncException
 168
 169 justIoErrors (IOException e) = Just e
 170 justIoErrors _ = Nothing
 171
 172 justArithExceptions (ArithException e) = Just e
 173 justArithExceptions _ = Nothing
 174
 175 justErrors (ErrorCall e) = Just e
 176 justErrors _ = Nothing
 177
 178 justAssertions (AssertionFailed e) = Just e
 179 justAssertions _ = Nothing
 180
 181 justDynExceptions (DynException e) = Just e
 182 justDynExceptions _ = Nothing
 183
 184 justAsyncExceptions (AsyncException e) = Just e
 185 justAsyncExceptions _ = Nothing
 186 \end{code}
 187
 188 -----------------------------------------------------------------------------
 189 Some Useful Functions
 190
 191 \begin{code}
 192 finally :: IO a -> IO b -> IO b
 193 a `finally` sequel = do
 194    tryAllIO a
 195    sequel
 196
 197 bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
 198 bracket before after thing = do
 199   a <- before
 200   c <- tryAllIO (thing a)
 201   after a
 202   case c of
 203     Right r -> return r
 204     Left  e -> throw e
 205
 206 bracket_ :: IO a -> IO b -> IO c -> IO c
 207 bracket_ before after thing = do
 208   before
 209   c <- tryAllIO thing
 210   after
 211   case c of
 212     Right r -> return r
 213     Left  e -> throw e
 214 \end{code}