Control/Exception.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Module      :  Control.Exception
   4 -- Copyright   :  (c) The University of Glasgow 2001
   5 -- License     :  BSD-style (see the file libraries/core/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  experimental
   9 -- Portability :  non-portable
  10 --
  11 -- $Id: Exception.hs,v 1.1 2001/06/28 14:15:01 simonmar Exp $
  12 --
  13 -- The External API for exceptions.  The functions provided in this
  14 -- module allow catching of exceptions in the IO monad.
  15 --
  16 -----------------------------------------------------------------------------
  17
  18 module Control.Exception (
  19
  20         Exception(..),          -- instance Eq, Ord, Show, Typeable
  21         IOException,            -- instance Eq, Ord, Show, Typeable
  22         ArithException(..),     -- instance Eq, Ord, Show, Typeable
  23         ArrayException(..),     -- instance Eq, Ord, Show, Typeable
  24         AsyncException(..),     -- instance Eq, Ord, Show, Typeable
  25
  26         try,       -- :: IO a -> IO (Either Exception a)
  27         tryJust,   -- :: (Exception -> Maybe b) -> a    -> IO (Either b a)
  28
  29         catch,     -- :: IO a -> (Exception -> IO a) -> IO a
  30         catchJust, -- :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a
  31
  32         evaluate,  -- :: a -> IO a
  33
  34         -- Exception predicates (for catchJust, tryJust)
  35
  36         ioErrors,               -- :: Exception -> Maybe IOError
  37         arithExceptions,        -- :: Exception -> Maybe ArithException
  38         errorCalls,             -- :: Exception -> Maybe String
  39         dynExceptions,          -- :: Exception -> Maybe Dynamic
  40         assertions,             -- :: Exception -> Maybe String
  41         asyncExceptions,        -- :: Exception -> Maybe AsyncException
  42         userErrors,             -- :: Exception -> Maybe String
  43
  44         -- Throwing exceptions
  45
  46         throw,          -- :: Exception -> a
  47 #ifndef __STGHUGS__
  48         -- for now
  49         throwTo,        -- :: ThreadId -> Exception -> a
  50 #endif
  51
  52         -- Dynamic exceptions
  53
  54         throwDyn,       -- :: Typeable ex => ex -> b
  55         throwDynTo,     -- :: Typeable ex => ThreadId -> ex -> b
  56         catchDyn,       -- :: Typeable ex => IO a -> (ex -> IO a) -> IO a
  57
  58         -- Async exception control
  59
  60         block,          -- :: IO a -> IO a
  61         unblock,        -- :: IO a -> IO a
  62
  63         -- Assertions
  64
  65         -- for now
  66         assert,         -- :: Bool -> a -> a
  67
  68         -- Utilities
  69
  70         finally,        -- :: IO a -> IO b -> IO b
  71
  72         bracket,        -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO ()
  73         bracket_,       -- :: IO a -> IO b -> IO c -> IO ()
  74
  75   ) where
  76
  77 #ifdef __GLASGOW_HASKELL__
  78 import Prelude          hiding (catch)
  79 import GHC.Prim         ( assert )
  80 import GHC.Exception    hiding (try, catch, bracket, bracket_)
  81 import GHC.Conc         ( throwTo, ThreadId )
  82 import GHC.IOBase       ( IO(..) )
  83 #endif
  84
  85 #ifdef __HUGS__
  86 import Prelude hiding ( catch )
  87 import PrelPrim ( catchException
  88                 , Exception(..)
  89                 , throw
  90                 , ArithException(..)
  91                 , AsyncException(..)
  92                 , assert
  93                 )
  94 #endif
  95
  96 import Data.Dynamic
  97
  98 #include "Dynamic.h"
  99 INSTANCE_TYPEABLE0(Exception,exceptionTc,"Exception")
 100 INSTANCE_TYPEABLE0(IOException,ioExceptionTc,"IOException")
 101 INSTANCE_TYPEABLE0(ArithException,arithExceptionTc,"ArithException")
 102 INSTANCE_TYPEABLE0(ArrayException,arrayExceptionTc,"ArrayException")
 103 INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException")
 104
 105 -----------------------------------------------------------------------------
 106 -- Catching exceptions
 107
 108 -- PrelException defines 'catchException' for us.
 109
 110 catch :: IO a -> (Exception -> IO a) -> IO a
 111 catch =  catchException
 112
 113 catchJust :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a
 114 catchJust p a handler = catch a handler'
 115   where handler' e = case p e of
 116                         Nothing -> throw e
 117                         Just b  -> handler b
 118
 119 -----------------------------------------------------------------------------
 120 -- evaluate
 121
 122 evaluate :: a -> IO a
 123 evaluate a = a `seq` return a
 124
 125 -----------------------------------------------------------------------------
 126 -- 'try' and variations.
 127
 128 try :: IO a -> IO (Either Exception a)
 129 try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))
 130
 131 tryJust :: (Exception -> Maybe b) -> IO a -> IO (Either b a)
 132 tryJust p a = do
 133   r <- try a
 134   case r of
 135         Right v -> return (Right v)
 136         Left  e -> case p e of
 137                         Nothing -> throw e
 138                         Just b  -> return (Left b)
 139
 140 -----------------------------------------------------------------------------
 141 -- Dynamic exception types.  Since one of the possible kinds of exception
 142 -- is a dynamically typed value, we can effectively have polymorphic
 143 -- exceptions.
 144
 145 -- throwDyn will raise any value as an exception, provided it is in the
 146 -- Typeable class (see Dynamic.lhs).
 147
 148 -- catchDyn will catch any exception of a given type (determined by the
 149 -- handler function).  Any raised exceptions that don't match are
 150 -- re-raised.
 151
 152 throwDyn :: Typeable exception => exception -> b
 153 throwDyn exception = throw (DynException (toDyn exception))
 154
 155 throwDynTo :: Typeable exception => ThreadId -> exception -> IO ()
 156 throwDynTo t exception = throwTo t (DynException (toDyn exception))
 157
 158 catchDyn :: Typeable exception => IO a -> (exception -> IO a) -> IO a
 159 catchDyn m k = catchException m handle
 160   where handle ex = case ex of
 161                            (DynException dyn) ->
 162                                 case fromDynamic dyn of
 163                                     Just exception  -> k exception
 164                                     Nothing -> throw ex
 165                            _ -> throw ex
 166
 167 -----------------------------------------------------------------------------
 168 -- Exception Predicates
 169
 170 ioErrors                :: Exception -> Maybe IOError
 171 arithExceptions         :: Exception -> Maybe ArithException
 172 errorCalls              :: Exception -> Maybe String
 173 dynExceptions           :: Exception -> Maybe Dynamic
 174 assertions              :: Exception -> Maybe String
 175 asyncExceptions         :: Exception -> Maybe AsyncException
 176 userErrors              :: Exception -> Maybe String
 177
 178 ioErrors e@(IOException _) = Just e
 179 ioErrors _ = Nothing
 180
 181 arithExceptions (ArithException e) = Just e
 182 arithExceptions _ = Nothing
 183
 184 errorCalls (ErrorCall e) = Just e
 185 errorCalls _ = Nothing
 186
 187 assertions (AssertionFailed e) = Just e
 188 assertions _ = Nothing
 189
 190 dynExceptions (DynException e) = Just e
 191 dynExceptions _ = Nothing
 192
 193 asyncExceptions (AsyncException e) = Just e
 194 asyncExceptions _ = Nothing
 195
 196 userErrors (UserError e) = Just e
 197 userErrors _ = Nothing
 198
 199 -----------------------------------------------------------------------------
 200 -- Some Useful Functions
 201
 202 bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
 203 bracket before after thing =
 204   block (do
 205     a <- before
 206     r <- catch
 207            (unblock (thing a))
 208            (\e -> do { after a; throw e })
 209     after a
 210     return r
 211  )
 212
 213 -- finally is an instance of bracket, but it's quite common
 214 -- so we give the specialised version for efficiency.
 215 finally :: IO a -> IO b -> IO a
 216 a `finally` sequel =
 217   block (do
 218     r <- catch
 219              (unblock a)
 220              (\e -> do { sequel; throw e })
 221     sequel
 222     return r
 223   )
 224
 225 bracket_ :: IO a -> IO b -> IO c -> IO c
 226 bracket_ before after thing = bracket before (const after) (const thing)