6ee734842e9f42d3b2f10253e88080b9fbdfbc57
[packages/base.git] / Control / Exception / Base.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}
3 #ifdef __GLASGOW_HASKELL__
4 {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
5 #endif
6
7 #include "Typeable.h"
8
9 -----------------------------------------------------------------------------
10 -- |
11 -- Module : Control.Exception.Base
12 -- Copyright : (c) The University of Glasgow 2001
13 -- License : BSD-style (see the file libraries/base/LICENSE)
14 --
15 -- Maintainer : libraries@haskell.org
16 -- Stability : experimental
17 -- Portability : non-portable (extended exceptions)
18 --
19 -- Extensible exceptions, except for multiple handlers.
20 --
21 -----------------------------------------------------------------------------
22
23 module Control.Exception.Base (
24
25 -- * The Exception type
26 #ifdef __HUGS__
27 SomeException,
28 #else
29 SomeException(..),
30 #endif
31 Exception(..),
32 IOException,
33 ArithException(..),
34 ArrayException(..),
35 AssertionFailed(..),
36 SomeAsyncException(..), AsyncException(..),
37 asyncExceptionToException, asyncExceptionFromException,
38
39 #if __GLASGOW_HASKELL__ || __HUGS__
40 NonTermination(..),
41 NestedAtomically(..),
42 #endif
43
44 BlockedIndefinitelyOnMVar(..),
45 BlockedIndefinitelyOnSTM(..),
46 Deadlock(..),
47 NoMethodError(..),
48 PatternMatchFail(..),
49 RecConError(..),
50 RecSelError(..),
51 RecUpdError(..),
52 ErrorCall(..),
53
54 -- * Throwing exceptions
55 throwIO,
56 throw,
57 ioError,
58 #ifdef __GLASGOW_HASKELL__
59 throwTo,
60 #endif
61
62 -- * Catching Exceptions
63
64 -- ** The @catch@ functions
65 catch,
66 catchJust,
67
68 -- ** The @handle@ functions
69 handle,
70 handleJust,
71
72 -- ** The @try@ functions
73 try,
74 tryJust,
75 onException,
76
77 -- ** The @evaluate@ function
78 evaluate,
79
80 -- ** The @mapException@ function
81 mapException,
82
83 -- * Asynchronous Exceptions
84
85 -- ** Asynchronous exception control
86 mask,
87 mask_,
88 uninterruptibleMask,
89 uninterruptibleMask_,
90 MaskingState(..),
91 getMaskingState,
92
93 -- * Assertions
94
95 assert,
96
97 -- * Utilities
98
99 bracket,
100 bracket_,
101 bracketOnError,
102
103 finally,
104
105 #ifdef __GLASGOW_HASKELL__
106 -- * Calls for GHC runtime
107 recSelError, recConError, irrefutPatError, runtimeError,
108 nonExhaustiveGuardsError, patError, noMethodBindingError,
109 absentError,
110 nonTermination, nestedAtomically,
111 #endif
112 ) where
113
114 #ifdef __GLASGOW_HASKELL__
115 import GHC.Base
116 import GHC.IO hiding (bracket,finally,onException)
117 import GHC.IO.Exception
118 import GHC.Exception
119 import GHC.Show
120 -- import GHC.Exception hiding ( Exception )
121 import GHC.Conc.Sync
122 #endif
123
124 #ifdef __HUGS__
125 import Prelude hiding (catch)
126 import Hugs.Prelude (ExitCode(..))
127 import Hugs.IOExts (unsafePerformIO)
128 import Hugs.Exception (SomeException(DynamicException, IOException,
129 ArithException, ArrayException, ExitException),
130 evaluate, IOException, ArithException, ArrayException)
131 import qualified Hugs.Exception
132 #endif
133
134 import Data.Dynamic
135 import Data.Either
136 import Data.Maybe
137
138 #ifdef __HUGS__
139 class (Typeable e, Show e) => Exception e where
140 toException :: e -> SomeException
141 fromException :: SomeException -> Maybe e
142
143 toException e = DynamicException (toDyn e) (flip showsPrec e)
144 fromException (DynamicException dyn _) = fromDynamic dyn
145 fromException _ = Nothing
146
147 INSTANCE_TYPEABLE0(SomeException,someExceptionTc,"SomeException")
148 INSTANCE_TYPEABLE0(IOException,iOExceptionTc,"IOException")
149 INSTANCE_TYPEABLE0(ArithException,arithExceptionTc,"ArithException")
150 INSTANCE_TYPEABLE0(ArrayException,arrayExceptionTc,"ArrayException")
151 INSTANCE_TYPEABLE0(ExitCode,exitCodeTc,"ExitCode")
152 INSTANCE_TYPEABLE0(ErrorCall,errorCallTc,"ErrorCall")
153 INSTANCE_TYPEABLE0(AssertionFailed,assertionFailedTc,"AssertionFailed")
154 INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException")
155 INSTANCE_TYPEABLE0(BlockedIndefinitelyOnMVar,blockedIndefinitelyOnMVarTc,"BlockedIndefinitelyOnMVar")
156 INSTANCE_TYPEABLE0(BlockedIndefinitelyOnSTM,blockedIndefinitelyOnSTM,"BlockedIndefinitelyOnSTM")
157 INSTANCE_TYPEABLE0(Deadlock,deadlockTc,"Deadlock")
158
159 instance Exception SomeException where
160 toException se = se
161 fromException = Just
162
163 instance Exception IOException where
164 toException = IOException
165 fromException (IOException e) = Just e
166 fromException _ = Nothing
167
168 instance Exception ArrayException where
169 toException = ArrayException
170 fromException (ArrayException e) = Just e
171 fromException _ = Nothing
172
173 instance Exception ArithException where
174 toException = ArithException
175 fromException (ArithException e) = Just e
176 fromException _ = Nothing
177
178 instance Exception ExitCode where
179 toException = ExitException
180 fromException (ExitException e) = Just e
181 fromException _ = Nothing
182
183 data ErrorCall = ErrorCall String
184
185 instance Show ErrorCall where
186 showsPrec _ (ErrorCall err) = showString err
187
188 instance Exception ErrorCall where
189 toException (ErrorCall s) = Hugs.Exception.ErrorCall s
190 fromException (Hugs.Exception.ErrorCall s) = Just (ErrorCall s)
191 fromException _ = Nothing
192
193 data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar
194 data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM
195 data Deadlock = Deadlock
196 data AssertionFailed = AssertionFailed String
197 data AsyncException
198 = StackOverflow
199 | HeapOverflow
200 | ThreadKilled
201 | UserInterrupt
202 deriving (Eq, Ord)
203
204 instance Show BlockedIndefinitelyOnMVar where
205 showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely"
206
207 instance Show BlockedIndefinitely where
208 showsPrec _ BlockedIndefinitely = showString "thread blocked indefinitely"
209
210 instance Show Deadlock where
211 showsPrec _ Deadlock = showString "<<deadlock>>"
212
213 instance Show AssertionFailed where
214 showsPrec _ (AssertionFailed err) = showString err
215
216 instance Show AsyncException where
217 showsPrec _ StackOverflow = showString "stack overflow"
218 showsPrec _ HeapOverflow = showString "heap overflow"
219 showsPrec _ ThreadKilled = showString "thread killed"
220 showsPrec _ UserInterrupt = showString "user interrupt"
221
222 instance Exception BlockedOnDeadMVar
223 instance Exception BlockedIndefinitely
224 instance Exception Deadlock
225 instance Exception AssertionFailed
226 instance Exception AsyncException
227
228 throw :: Exception e => e -> a
229 throw e = Hugs.Exception.throw (toException e)
230
231 throwIO :: Exception e => e -> IO a
232 throwIO e = Hugs.Exception.throwIO (toException e)
233 #endif
234
235 -----------------------------------------------------------------------------
236 -- Catching exceptions
237
238 -- |This is the simplest of the exception-catching functions. It
239 -- takes a single argument, runs it, and if an exception is raised
240 -- the \"handler\" is executed, with the value of the exception passed as an
241 -- argument. Otherwise, the result is returned as normal. For example:
242 --
243 -- > catch (readFile f)
244 -- > (\e -> do let err = show (e :: IOException)
245 -- > hPutStr stderr ("Warning: Couldn't open " ++ f ++ ": " ++ err)
246 -- > return "")
247 --
248 -- Note that we have to give a type signature to @e@, or the program
249 -- will not typecheck as the type is ambiguous. While it is possible
250 -- to catch exceptions of any type, see the section \"Catching all
251 -- exceptions\" (in "Control.Exception") for an explanation of the problems with doing so.
252 --
253 -- For catching exceptions in pure (non-'IO') expressions, see the
254 -- function 'evaluate'.
255 --
256 -- Note that due to Haskell\'s unspecified evaluation order, an
257 -- expression may throw one of several possible exceptions: consider
258 -- the expression @(error \"urk\") + (1 \`div\` 0)@. Does
259 -- the expression throw
260 -- @ErrorCall \"urk\"@, or @DivideByZero@?
261 --
262 -- The answer is \"it might throw either\"; the choice is
263 -- non-deterministic. If you are catching any type of exception then you
264 -- might catch either. If you are calling @catch@ with type
265 -- @IO Int -> (ArithException -> IO Int) -> IO Int@ then the handler may
266 -- get run with @DivideByZero@ as an argument, or an @ErrorCall \"urk\"@
267 -- exception may be propogated further up. If you call it again, you
268 -- might get a the opposite behaviour. This is ok, because 'catch' is an
269 -- 'IO' computation.
270 --
271 catch :: Exception e
272 => IO a -- ^ The computation to run
273 -> (e -> IO a) -- ^ Handler to invoke if an exception is raised
274 -> IO a
275 #if __GLASGOW_HASKELL__
276 catch = catchException
277 #elif __HUGS__
278 catch m h = Hugs.Exception.catchException m h'
279 where h' e = case fromException e of
280 Just e' -> h e'
281 Nothing -> throwIO e
282 #endif
283
284 -- | The function 'catchJust' is like 'catch', but it takes an extra
285 -- argument which is an /exception predicate/, a function which
286 -- selects which type of exceptions we\'re interested in.
287 --
288 -- > catchJust (\e -> if isDoesNotExistErrorType (ioeGetErrorType e) then Just () else Nothing)
289 -- > (readFile f)
290 -- > (\_ -> do hPutStrLn stderr ("No such file: " ++ show f)
291 -- > return "")
292 --
293 -- Any other exceptions which are not matched by the predicate
294 -- are re-raised, and may be caught by an enclosing
295 -- 'catch', 'catchJust', etc.
296 catchJust
297 :: Exception e
298 => (e -> Maybe b) -- ^ Predicate to select exceptions
299 -> IO a -- ^ Computation to run
300 -> (b -> IO a) -- ^ Handler
301 -> IO a
302 catchJust p a handler = catch a handler'
303 where handler' e = case p e of
304 Nothing -> throwIO e
305 Just b -> handler b
306
307 -- | A version of 'catch' with the arguments swapped around; useful in
308 -- situations where the code for the handler is shorter. For example:
309 --
310 -- > do handle (\NonTermination -> exitWith (ExitFailure 1)) $
311 -- > ...
312 handle :: Exception e => (e -> IO a) -> IO a -> IO a
313 handle = flip catch
314
315 -- | A version of 'catchJust' with the arguments swapped around (see
316 -- 'handle').
317 handleJust :: Exception e => (e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
318 handleJust p = flip (catchJust p)
319
320 -----------------------------------------------------------------------------
321 -- 'mapException'
322
323 -- | This function maps one exception into another as proposed in the
324 -- paper \"A semantics for imprecise exceptions\".
325
326 -- Notice that the usage of 'unsafePerformIO' is safe here.
327
328 mapException :: (Exception e1, Exception e2) => (e1 -> e2) -> a -> a
329 mapException f v = unsafePerformIO (catch (evaluate v)
330 (\x -> throwIO (f x)))
331
332 -----------------------------------------------------------------------------
333 -- 'try' and variations.
334
335 -- | Similar to 'catch', but returns an 'Either' result which is
336 -- @('Right' a)@ if no exception of type @e@ was raised, or @('Left' ex)@
337 -- if an exception of type @e@ was raised and its value is @ex@.
338 -- If any other type of exception is raised than it will be propogated
339 -- up to the next enclosing exception handler.
340 --
341 -- > try a = catch (Right `liftM` a) (return . Left)
342
343 try :: Exception e => IO a -> IO (Either e a)
344 try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))
345
346 -- | A variant of 'try' that takes an exception predicate to select
347 -- which exceptions are caught (c.f. 'catchJust'). If the exception
348 -- does not match the predicate, it is re-thrown.
349 tryJust :: Exception e => (e -> Maybe b) -> IO a -> IO (Either b a)
350 tryJust p a = do
351 r <- try a
352 case r of
353 Right v -> return (Right v)
354 Left e -> case p e of
355 Nothing -> throwIO e
356 Just b -> return (Left b)
357
358 -- | Like 'finally', but only performs the final action if there was an
359 -- exception raised by the computation.
360 onException :: IO a -> IO b -> IO a
361 onException io what = io `catch` \e -> do _ <- what
362 throwIO (e :: SomeException)
363
364 -----------------------------------------------------------------------------
365 -- Some Useful Functions
366
367 -- | When you want to acquire a resource, do some work with it, and
368 -- then release the resource, it is a good idea to use 'bracket',
369 -- because 'bracket' will install the necessary exception handler to
370 -- release the resource in the event that an exception is raised
371 -- during the computation. If an exception is raised, then 'bracket' will
372 -- re-raise the exception (after performing the release).
373 --
374 -- A common example is opening a file:
375 --
376 -- > bracket
377 -- > (openFile "filename" ReadMode)
378 -- > (hClose)
379 -- > (\fileHandle -> do { ... })
380 --
381 -- The arguments to 'bracket' are in this order so that we can partially apply
382 -- it, e.g.:
383 --
384 -- > withFile name mode = bracket (openFile name mode) hClose
385 --
386 bracket
387 :: IO a -- ^ computation to run first (\"acquire resource\")
388 -> (a -> IO b) -- ^ computation to run last (\"release resource\")
389 -> (a -> IO c) -- ^ computation to run in-between
390 -> IO c -- returns the value from the in-between computation
391 bracket before after thing =
392 mask $ \restore -> do
393 a <- before
394 r <- restore (thing a) `onException` after a
395 _ <- after a
396 return r
397
398 -- | A specialised variant of 'bracket' with just a computation to run
399 -- afterward.
400 --
401 finally :: IO a -- ^ computation to run first
402 -> IO b -- ^ computation to run afterward (even if an exception
403 -- was raised)
404 -> IO a -- returns the value from the first computation
405 a `finally` sequel =
406 mask $ \restore -> do
407 r <- restore a `onException` sequel
408 _ <- sequel
409 return r
410
411 -- | A variant of 'bracket' where the return value from the first computation
412 -- is not required.
413 bracket_ :: IO a -> IO b -> IO c -> IO c
414 bracket_ before after thing = bracket before (const after) (const thing)
415
416 -- | Like 'bracket', but only performs the final action if there was an
417 -- exception raised by the in-between computation.
418 bracketOnError
419 :: IO a -- ^ computation to run first (\"acquire resource\")
420 -> (a -> IO b) -- ^ computation to run last (\"release resource\")
421 -> (a -> IO c) -- ^ computation to run in-between
422 -> IO c -- returns the value from the in-between computation
423 bracketOnError before after thing =
424 mask $ \restore -> do
425 a <- before
426 restore (thing a) `onException` after a
427
428 #if !__GLASGOW_HASKELL__
429 assert :: Bool -> a -> a
430 assert True x = x
431 assert False _ = throw (AssertionFailed "")
432 #endif
433
434 -----
435
436 #if __GLASGOW_HASKELL__ || __HUGS__
437 -- |A pattern match failed. The @String@ gives information about the
438 -- source location of the pattern.
439 data PatternMatchFail = PatternMatchFail String
440 INSTANCE_TYPEABLE0(PatternMatchFail,patternMatchFailTc,"PatternMatchFail")
441
442 instance Show PatternMatchFail where
443 showsPrec _ (PatternMatchFail err) = showString err
444
445 #ifdef __HUGS__
446 instance Exception PatternMatchFail where
447 toException (PatternMatchFail err) = Hugs.Exception.PatternMatchFail err
448 fromException (Hugs.Exception.PatternMatchFail err) = Just (PatternMatchFail err)
449 fromException _ = Nothing
450 #else
451 instance Exception PatternMatchFail
452 #endif
453
454 -----
455
456 -- |A record selector was applied to a constructor without the
457 -- appropriate field. This can only happen with a datatype with
458 -- multiple constructors, where some fields are in one constructor
459 -- but not another. The @String@ gives information about the source
460 -- location of the record selector.
461 data RecSelError = RecSelError String
462 INSTANCE_TYPEABLE0(RecSelError,recSelErrorTc,"RecSelError")
463
464 instance Show RecSelError where
465 showsPrec _ (RecSelError err) = showString err
466
467 #ifdef __HUGS__
468 instance Exception RecSelError where
469 toException (RecSelError err) = Hugs.Exception.RecSelError err
470 fromException (Hugs.Exception.RecSelError err) = Just (RecSelError err)
471 fromException _ = Nothing
472 #else
473 instance Exception RecSelError
474 #endif
475
476 -----
477
478 -- |An uninitialised record field was used. The @String@ gives
479 -- information about the source location where the record was
480 -- constructed.
481 data RecConError = RecConError String
482 INSTANCE_TYPEABLE0(RecConError,recConErrorTc,"RecConError")
483
484 instance Show RecConError where
485 showsPrec _ (RecConError err) = showString err
486
487 #ifdef __HUGS__
488 instance Exception RecConError where
489 toException (RecConError err) = Hugs.Exception.RecConError err
490 fromException (Hugs.Exception.RecConError err) = Just (RecConError err)
491 fromException _ = Nothing
492 #else
493 instance Exception RecConError
494 #endif
495
496 -----
497
498 -- |A record update was performed on a constructor without the
499 -- appropriate field. This can only happen with a datatype with
500 -- multiple constructors, where some fields are in one constructor
501 -- but not another. The @String@ gives information about the source
502 -- location of the record update.
503 data RecUpdError = RecUpdError String
504 INSTANCE_TYPEABLE0(RecUpdError,recUpdErrorTc,"RecUpdError")
505
506 instance Show RecUpdError where
507 showsPrec _ (RecUpdError err) = showString err
508
509 #ifdef __HUGS__
510 instance Exception RecUpdError where
511 toException (RecUpdError err) = Hugs.Exception.RecUpdError err
512 fromException (Hugs.Exception.RecUpdError err) = Just (RecUpdError err)
513 fromException _ = Nothing
514 #else
515 instance Exception RecUpdError
516 #endif
517
518 -----
519
520 -- |A class method without a definition (neither a default definition,
521 -- nor a definition in the appropriate instance) was called. The
522 -- @String@ gives information about which method it was.
523 data NoMethodError = NoMethodError String
524 INSTANCE_TYPEABLE0(NoMethodError,noMethodErrorTc,"NoMethodError")
525
526 instance Show NoMethodError where
527 showsPrec _ (NoMethodError err) = showString err
528
529 #ifdef __HUGS__
530 instance Exception NoMethodError where
531 toException (NoMethodError err) = Hugs.Exception.NoMethodError err
532 fromException (Hugs.Exception.NoMethodError err) = Just (NoMethodError err)
533 fromException _ = Nothing
534 #else
535 instance Exception NoMethodError
536 #endif
537
538 -----
539
540 -- |Thrown when the runtime system detects that the computation is
541 -- guaranteed not to terminate. Note that there is no guarantee that
542 -- the runtime system will notice whether any given computation is
543 -- guaranteed to terminate or not.
544 data NonTermination = NonTermination
545 INSTANCE_TYPEABLE0(NonTermination,nonTerminationTc,"NonTermination")
546
547 instance Show NonTermination where
548 showsPrec _ NonTermination = showString "<<loop>>"
549
550 #ifdef __HUGS__
551 instance Exception NonTermination where
552 toException NonTermination = Hugs.Exception.NonTermination
553 fromException Hugs.Exception.NonTermination = Just NonTermination
554 fromException _ = Nothing
555 #else
556 instance Exception NonTermination
557 #endif
558
559 -----
560
561 -- |Thrown when the program attempts to call @atomically@, from the @stm@
562 -- package, inside another call to @atomically@.
563 data NestedAtomically = NestedAtomically
564 INSTANCE_TYPEABLE0(NestedAtomically,nestedAtomicallyTc,"NestedAtomically")
565
566 instance Show NestedAtomically where
567 showsPrec _ NestedAtomically = showString "Control.Concurrent.STM.atomically was nested"
568
569 instance Exception NestedAtomically
570
571 -----
572
573 #endif /* __GLASGOW_HASKELL__ || __HUGS__ */
574
575 #ifdef __GLASGOW_HASKELL__
576 recSelError, recConError, irrefutPatError, runtimeError,
577 nonExhaustiveGuardsError, patError, noMethodBindingError,
578 absentError
579 :: Addr# -> a -- All take a UTF8-encoded C string
580
581 recSelError s = throw (RecSelError ("No match in record selector "
582 ++ unpackCStringUtf8# s)) -- No location info unfortunately
583 runtimeError s = error (unpackCStringUtf8# s) -- No location info unfortunately
584 absentError s = error ("Oops! Entered absent arg " ++ unpackCStringUtf8# s)
585
586 nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in"))
587 irrefutPatError s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern"))
588 recConError s = throw (RecConError (untangle s "Missing field in record construction"))
589 noMethodBindingError s = throw (NoMethodError (untangle s "No instance nor default method for class operation"))
590 patError s = throw (PatternMatchFail (untangle s "Non-exhaustive patterns in"))
591
592 -- GHC's RTS calls this
593 nonTermination :: SomeException
594 nonTermination = toException NonTermination
595
596 -- GHC's RTS calls this
597 nestedAtomically :: SomeException
598 nestedAtomically = toException NestedAtomically
599 #endif