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