0248ff2e37f8c41c451f266e33b43ed3a9f0595b
[packages/base.git] / 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.6 2002/02/05 17:32:25 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 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 System.IO.Error
80 import GHC.Base ( assert )
81 import GHC.Exception hiding (try, catch, bracket, bracket_)
82 import GHC.Conc ( throwTo, ThreadId )
83 import GHC.IOBase ( IO(..) )
84 #endif
85
86 #ifdef __HUGS__
87 import Prelude hiding ( catch )
88 import PrelPrim ( catchException
89 , Exception(..)
90 , throw
91 , ArithException(..)
92 , AsyncException(..)
93 , assert
94 )
95 #endif
96
97 import Data.Dynamic
98
99 #include "Dynamic.h"
100 INSTANCE_TYPEABLE0(Exception,exceptionTc,"Exception")
101 INSTANCE_TYPEABLE0(IOException,ioExceptionTc,"IOException")
102 INSTANCE_TYPEABLE0(ArithException,arithExceptionTc,"ArithException")
103 INSTANCE_TYPEABLE0(ArrayException,arrayExceptionTc,"ArrayException")
104 INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException")
105
106 -----------------------------------------------------------------------------
107 -- Catching exceptions
108
109 -- GHC.Exception defines 'catchException' for us.
110
111 catch :: IO a -> (Exception -> IO a) -> IO a
112 catch = catchException
113
114 catchJust :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a
115 catchJust p a handler = catch a handler'
116 where handler' e = case p e of
117 Nothing -> throw e
118 Just b -> handler b
119
120 handle :: (Exception -> IO a) -> IO a -> IO a
121 handle = flip catch
122
123 handleJust :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a
124 handleJust p = flip (catchJust p)
125
126 -----------------------------------------------------------------------------
127 -- evaluate
128
129 evaluate :: a -> IO a
130 evaluate a = a `seq` return a
131
132 -----------------------------------------------------------------------------
133 -- 'try' and variations.
134
135 try :: IO a -> IO (Either Exception a)
136 try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))
137
138 tryJust :: (Exception -> Maybe b) -> IO a -> IO (Either b a)
139 tryJust p a = do
140 r <- try a
141 case r of
142 Right v -> return (Right v)
143 Left e -> case p e of
144 Nothing -> throw e
145 Just b -> return (Left b)
146
147 -----------------------------------------------------------------------------
148 -- Dynamic exception types. Since one of the possible kinds of exception
149 -- is a dynamically typed value, we can effectively have polymorphic
150 -- exceptions.
151
152 -- throwDyn will raise any value as an exception, provided it is in the
153 -- Typeable class (see Dynamic.lhs).
154
155 -- catchDyn will catch any exception of a given type (determined by the
156 -- handler function). Any raised exceptions that don't match are
157 -- re-raised.
158
159 throwDyn :: Typeable exception => exception -> b
160 throwDyn exception = throw (DynException (toDyn exception))
161
162 throwDynTo :: Typeable exception => ThreadId -> exception -> IO ()
163 throwDynTo t exception = throwTo t (DynException (toDyn exception))
164
165 catchDyn :: Typeable exception => IO a -> (exception -> IO a) -> IO a
166 catchDyn m k = catchException m handle
167 where handle ex = case ex of
168 (DynException dyn) ->
169 case fromDynamic dyn of
170 Just exception -> k exception
171 Nothing -> throw ex
172 _ -> throw ex
173
174 -----------------------------------------------------------------------------
175 -- Exception Predicates
176
177 ioErrors :: Exception -> Maybe IOError
178 arithExceptions :: Exception -> Maybe ArithException
179 errorCalls :: Exception -> Maybe String
180 dynExceptions :: Exception -> Maybe Dynamic
181 assertions :: Exception -> Maybe String
182 asyncExceptions :: Exception -> Maybe AsyncException
183 userErrors :: Exception -> Maybe String
184
185 ioErrors e@(IOException _) = Just e
186 ioErrors _ = Nothing
187
188 arithExceptions (ArithException e) = Just e
189 arithExceptions _ = Nothing
190
191 errorCalls (ErrorCall e) = Just e
192 errorCalls _ = Nothing
193
194 assertions (AssertionFailed e) = Just e
195 assertions _ = Nothing
196
197 dynExceptions (DynException e) = Just e
198 dynExceptions _ = Nothing
199
200 asyncExceptions (AsyncException e) = Just e
201 asyncExceptions _ = Nothing
202
203 userErrors e | isUserError e = Just (ioeGetErrorString e)
204 userErrors _ = Nothing
205
206 -----------------------------------------------------------------------------
207 -- Some Useful Functions
208
209 bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
210 bracket before after thing =
211 block (do
212 a <- before
213 r <- catch
214 (unblock (thing a))
215 (\e -> do { after a; throw e })
216 after a
217 return r
218 )
219
220 -- finally is an instance of bracket, but it's quite common
221 -- so we give the specialised version for efficiency.
222 finally :: IO a -> IO b -> IO a
223 a `finally` sequel =
224 block (do
225 r <- catch
226 (unblock a)
227 (\e -> do { sequel; throw e })
228 sequel
229 return r
230 )
231
232 bracket_ :: IO a -> IO b -> IO c -> IO c
233 bracket_ before after thing = bracket before (const after) (const thing)