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.4 2001/10/18 11:14:17 rrt 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         handle,    -- :: (Exception -> IO a) -> IO a -> IO a
  33         handleJust,-- :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a
  34
  35         evaluate,  -- :: a -> IO a
  36
  37         -- Exception predicates (for tryJust, catchJust, handleJust)
  38
  39         ioErrors,               -- :: Exception -> Maybe IOError
  40         arithExceptions,        -- :: Exception -> Maybe ArithException
  41         errorCalls,             -- :: Exception -> Maybe String
  42         dynExceptions,          -- :: Exception -> Maybe Dynamic
  43         assertions,             -- :: Exception -> Maybe String
  44         asyncExceptions,        -- :: Exception -> Maybe AsyncException
  45         userErrors,             -- :: Exception -> Maybe String
  46
  47         -- Throwing exceptions
  48
  49         throw,          -- :: Exception -> a
  50         throwTo,        -- :: ThreadId -> Exception -> a
  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 -- GHC.Exception 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 handle     :: (Exception -> IO a) -> IO a -> IO a
 120 handle     =  flip catch
 121
 122 handleJust :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a
 123 handleJust p =  flip (catchJust p)
 124
 125 -----------------------------------------------------------------------------
 126 -- evaluate
 127
 128 evaluate :: a -> IO a
 129 evaluate a = a `seq` return a
 130
 131 -----------------------------------------------------------------------------
 132 -- 'try' and variations.
 133
 134 try :: IO a -> IO (Either Exception a)
 135 try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))
 136
 137 tryJust :: (Exception -> Maybe b) -> IO a -> IO (Either b a)
 138 tryJust p a = do
 139   r <- try a
 140   case r of
 141         Right v -> return (Right v)
 142         Left  e -> case p e of
 143                         Nothing -> throw e
 144                         Just b  -> return (Left b)
 145
 146 -----------------------------------------------------------------------------
 147 -- Dynamic exception types.  Since one of the possible kinds of exception
 148 -- is a dynamically typed value, we can effectively have polymorphic
 149 -- exceptions.
 150
 151 -- throwDyn will raise any value as an exception, provided it is in the
 152 -- Typeable class (see Dynamic.lhs).
 153
 154 -- catchDyn will catch any exception of a given type (determined by the
 155 -- handler function).  Any raised exceptions that don't match are
 156 -- re-raised.
 157
 158 throwDyn :: Typeable exception => exception -> b
 159 throwDyn exception = throw (DynException (toDyn exception))
 160
 161 throwDynTo :: Typeable exception => ThreadId -> exception -> IO ()
 162 throwDynTo t exception = throwTo t (DynException (toDyn exception))
 163
 164 catchDyn :: Typeable exception => IO a -> (exception -> IO a) -> IO a
 165 catchDyn m k = catchException m handle
 166   where handle ex = case ex of
 167                            (DynException dyn) ->
 168                                 case fromDynamic dyn of
 169                                     Just exception  -> k exception
 170                                     Nothing -> throw ex
 171                            _ -> throw ex
 172
 173 -----------------------------------------------------------------------------
 174 -- Exception Predicates
 175
 176 ioErrors                :: Exception -> Maybe IOError
 177 arithExceptions         :: Exception -> Maybe ArithException
 178 errorCalls              :: Exception -> Maybe String
 179 dynExceptions           :: Exception -> Maybe Dynamic
 180 assertions              :: Exception -> Maybe String
 181 asyncExceptions         :: Exception -> Maybe AsyncException
 182 userErrors              :: Exception -> Maybe String
 183
 184 ioErrors e@(IOException _) = Just e
 185 ioErrors _ = Nothing
 186
 187 arithExceptions (ArithException e) = Just e
 188 arithExceptions _ = Nothing
 189
 190 errorCalls (ErrorCall e) = Just e
 191 errorCalls _ = Nothing
 192
 193 assertions (AssertionFailed e) = Just e
 194 assertions _ = Nothing
 195
 196 dynExceptions (DynException e) = Just e
 197 dynExceptions _ = Nothing
 198
 199 asyncExceptions (AsyncException e) = Just e
 200 asyncExceptions _ = Nothing
 201
 202 userErrors (UserError e) = Just e
 203 userErrors _ = Nothing
 204
 205 -----------------------------------------------------------------------------
 206 -- Some Useful Functions
 207
 208 bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
 209 bracket before after thing =
 210   block (do
 211     a <- before
 212     r <- catch
 213            (unblock (thing a))
 214            (\e -> do { after a; throw e })
 215     after a
 216     return r
 217  )
 218
 219 -- finally is an instance of bracket, but it's quite common
 220 -- so we give the specialised version for efficiency.
 221 finally :: IO a -> IO b -> IO a
 222 a `finally` sequel =
 223   block (do
 224     r <- catch
 225              (unblock a)
 226              (\e -> do { sequel; throw e })
 227     sequel
 228     return r
 229   )
 230
 231 bracket_ :: IO a -> IO b -> IO c -> IO c
 232 bracket_ before after thing = bracket before (const after) (const thing)