[project @ 2001-06-28 14:15:04 by simonmar]
[packages/old-time.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.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)