1 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
2 {-# OPTIONS_GHC -fno-warn-orphans #-}
6 -----------------------------------------------------------------------------
8 -- Module : Control.Exception.Base
9 -- Copyright : (c) The University of Glasgow 2001
10 -- License : BSD-style (see the file libraries/base/LICENSE)
12 -- Maintainer : libraries@haskell.org
13 -- Stability : experimental
14 -- Portability : non-portable (extended exceptions)
16 -- Extensible exceptions, except for multiple handlers.
18 -----------------------------------------------------------------------------
20 module Control.Exception.Base (
22 -- * The Exception type
35 #if __GLASGOW_HASKELL__ || __HUGS__
40 BlockedOnDeadMVar(..),
41 BlockedIndefinitely(..),
50 -- * Throwing exceptions
54 #ifdef __GLASGOW_HASKELL__
58 -- * Catching Exceptions
60 -- ** The @catch@ functions
64 -- ** The @handle@ functions
68 -- ** The @try@ functions
73 -- ** The @evaluate@ function
76 -- ** The @mapException@ function
79 -- * Asynchronous Exceptions
81 -- ** Asynchronous exception control
99 #ifdef __GLASGOW_HASKELL__
100 -- * Calls for GHC runtime
101 recSelError, recConError, irrefutPatError, runtimeError,
102 nonExhaustiveGuardsError, patError, noMethodBindingError,
103 nonTermination, nestedAtomically,
107 #ifdef __GLASGOW_HASKELL__
112 import GHC.Exception hiding ( Exception )
117 import Prelude hiding (catch)
118 import Hugs.Prelude (ExitCode(..))
119 import Hugs.IOExts (unsafePerformIO)
120 import Hugs.Exception (SomeException(DynamicException, IOException,
121 ArithException, ArrayException, ExitException),
122 evaluate, IOException, ArithException, ArrayException)
123 import qualified Hugs.Exception
131 import qualified IO as H'98 (catch)
132 import IO (bracket,ioError)
133 import DIOError -- defn of IOError type
134 import System (ExitCode())
135 import System.IO.Unsafe (unsafePerformIO)
136 import Unsafe.Coerce (unsafeCoerce)
138 -- minimum needed for nhc98 to pretend it has Exceptions
141 data Exception = IOException IOException
142 | ArithException ArithException
143 | ArrayException ArrayException
144 | AsyncException AsyncException
145 | ExitException ExitCode
148 class ({-Typeable e,-} Show e) => Exception e where
149 toException :: e -> SomeException
150 fromException :: SomeException -> Maybe e
152 data SomeException = forall e . Exception e => SomeException e
154 INSTANCE_TYPEABLE0(SomeException,someExceptionTc,"SomeException")
156 instance Show SomeException where
157 showsPrec p (SomeException e) = showsPrec p e
158 instance Exception SomeException where
162 type IOException = IOError
163 instance Exception IOError where
164 toException = SomeException
165 fromException (SomeException e) = Just (unsafeCoerce e)
167 instance Exception ExitCode where
168 toException = SomeException
169 fromException (SomeException e) = Just (unsafeCoerce e)
175 data PatternMatchFail
178 data BlockedOnDeadMVar
179 data BlockedIndefinitely
184 instance Show ArithException
185 instance Show ArrayException
186 instance Show AsyncException
187 instance Show AssertionFailed
188 instance Show PatternMatchFail
189 instance Show NoMethodError
190 instance Show Deadlock
191 instance Show BlockedOnDeadMVar
192 instance Show BlockedIndefinitely
193 instance Show ErrorCall
194 instance Show RecConError
195 instance Show RecSelError
196 instance Show RecUpdError
199 => IO a -- ^ The computation to run
200 -> (e -> IO a) -- ^ Handler to invoke if an exception is raised
202 catch io h = H'98.catch io (h . fromJust . fromException . toException)
204 throwIO :: Exception e => e -> IO a
205 throwIO = ioError . fromJust . fromException . toException
207 throw :: Exception e => e -> a
208 throw = unsafePerformIO . throwIO
210 evaluate :: a -> IO a
211 evaluate x = x `seq` return x
213 assert :: Bool -> a -> a
215 assert False _ = throw (toException (UserError "" "Assertion failed"))
220 class (Typeable e, Show e) => Exception e where
221 toException :: e -> SomeException
222 fromException :: SomeException -> Maybe e
224 toException e = DynamicException (toDyn e) (flip showsPrec e)
225 fromException (DynamicException dyn _) = fromDynamic dyn
226 fromException _ = Nothing
228 INSTANCE_TYPEABLE0(SomeException,someExceptionTc,"SomeException")
229 INSTANCE_TYPEABLE0(IOException,iOExceptionTc,"IOException")
230 INSTANCE_TYPEABLE0(ArithException,arithExceptionTc,"ArithException")
231 INSTANCE_TYPEABLE0(ArrayException,arrayExceptionTc,"ArrayException")
232 INSTANCE_TYPEABLE0(ExitCode,exitCodeTc,"ExitCode")
233 INSTANCE_TYPEABLE0(ErrorCall,errorCallTc,"ErrorCall")
234 INSTANCE_TYPEABLE0(AssertionFailed,assertionFailedTc,"AssertionFailed")
235 INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException")
236 INSTANCE_TYPEABLE0(BlockedOnDeadMVar,blockedOnDeadMVarTc,"BlockedOnDeadMVar")
237 INSTANCE_TYPEABLE0(BlockedIndefinitely,blockedIndefinitelyTc,"BlockedIndefinitely")
238 INSTANCE_TYPEABLE0(Deadlock,deadlockTc,"Deadlock")
240 instance Exception SomeException where
244 instance Exception IOException where
245 toException = IOException
246 fromException (IOException e) = Just e
247 fromException _ = Nothing
249 instance Exception ArrayException where
250 toException = ArrayException
251 fromException (ArrayException e) = Just e
252 fromException _ = Nothing
254 instance Exception ArithException where
255 toException = ArithException
256 fromException (ArithException e) = Just e
257 fromException _ = Nothing
259 instance Exception ExitCode where
260 toException = ExitException
261 fromException (ExitException e) = Just e
262 fromException _ = Nothing
264 data ErrorCall = ErrorCall String
266 instance Show ErrorCall where
267 showsPrec _ (ErrorCall err) = showString err
269 instance Exception ErrorCall where
270 toException (ErrorCall s) = Hugs.Exception.ErrorCall s
271 fromException (Hugs.Exception.ErrorCall s) = Just (ErrorCall s)
272 fromException _ = Nothing
274 data BlockedOnDeadMVar = BlockedOnDeadMVar
275 data BlockedIndefinitely = BlockedIndefinitely
276 data Deadlock = Deadlock
277 data AssertionFailed = AssertionFailed String
285 instance Show BlockedOnDeadMVar where
286 showsPrec _ BlockedOnDeadMVar = showString "thread blocked indefinitely"
288 instance Show BlockedIndefinitely where
289 showsPrec _ BlockedIndefinitely = showString "thread blocked indefinitely"
291 instance Show Deadlock where
292 showsPrec _ Deadlock = showString "<<deadlock>>"
294 instance Show AssertionFailed where
295 showsPrec _ (AssertionFailed err) = showString err
297 instance Show AsyncException where
298 showsPrec _ StackOverflow = showString "stack overflow"
299 showsPrec _ HeapOverflow = showString "heap overflow"
300 showsPrec _ ThreadKilled = showString "thread killed"
301 showsPrec _ UserInterrupt = showString "user interrupt"
303 instance Exception BlockedOnDeadMVar
304 instance Exception BlockedIndefinitely
305 instance Exception Deadlock
306 instance Exception AssertionFailed
307 instance Exception AsyncException
309 throw :: Exception e => e -> a
310 throw e = Hugs.Exception.throw (toException e)
312 throwIO :: Exception e => e -> IO a
313 throwIO e = Hugs.Exception.throwIO (toException e)
316 #ifndef __GLASGOW_HASKELL__
317 -- Dummy definitions for implementations lacking asynchonous exceptions
319 block :: IO a -> IO a
321 unblock :: IO a -> IO a
324 blocked = return False
327 -----------------------------------------------------------------------------
328 -- Catching exceptions
330 -- |This is the simplest of the exception-catching functions. It
331 -- takes a single argument, runs it, and if an exception is raised
332 -- the \"handler\" is executed, with the value of the exception passed as an
333 -- argument. Otherwise, the result is returned as normal. For example:
335 -- > catch (openFile f ReadMode)
336 -- > (\e -> hPutStr stderr ("Couldn't open "++f++": " ++ show e))
338 -- For catching exceptions in pure (non-'IO') expressions, see the
339 -- function 'evaluate'.
341 -- Note that due to Haskell\'s unspecified evaluation order, an
342 -- expression may return one of several possible exceptions: consider
343 -- the expression @error \"urk\" + 1 \`div\` 0@. Does
344 -- 'catch' execute the handler passing
345 -- @ErrorCall \"urk\"@, or @ArithError DivideByZero@?
347 -- The answer is \"either\": 'catch' makes a
348 -- non-deterministic choice about which exception to catch. If you
349 -- call it again, you might get a different exception back. This is
350 -- ok, because 'catch' is an 'IO' computation.
352 -- Note that 'catch' catches all types of exceptions, and is generally
353 -- used for \"cleaning up\" before passing on the exception using
354 -- 'throwIO'. It is not good practice to discard the exception and
355 -- continue, without first checking the type of the exception (it
356 -- might be a 'ThreadKilled', for example). In this case it is usually better
357 -- to use 'catchJust' and select the kinds of exceptions to catch.
359 -- Also note that the "Prelude" also exports a function called
360 -- 'Prelude.catch' with a similar type to 'Control.Exception.catch',
361 -- except that the "Prelude" version only catches the IO and user
362 -- families of exceptions (as required by Haskell 98).
364 -- We recommend either hiding the "Prelude" version of 'Prelude.catch'
365 -- when importing "Control.Exception":
367 -- > import Prelude hiding (catch)
369 -- or importing "Control.Exception" qualified, to avoid name-clashes:
371 -- > import qualified Control.Exception as C
373 -- and then using @C.catch@
377 => IO a -- ^ The computation to run
378 -> (e -> IO a) -- ^ Handler to invoke if an exception is raised
380 #if __GLASGOW_HASKELL__
381 catch = GHC.IOBase.catchException
383 catch m h = Hugs.Exception.catchException m h'
384 where h' e = case fromException e of
390 -- | The function 'catchJust' is like 'catch', but it takes an extra
391 -- argument which is an /exception predicate/, a function which
392 -- selects which type of exceptions we\'re interested in.
394 -- > result <- catchJust errorCalls thing_to_try handler
396 -- Any other exceptions which are not matched by the predicate
397 -- are re-raised, and may be caught by an enclosing
398 -- 'catch' or 'catchJust'.
401 => (e -> Maybe b) -- ^ Predicate to select exceptions
402 -> IO a -- ^ Computation to run
403 -> (b -> IO a) -- ^ Handler
405 catchJust p a handler = catch a handler'
406 where handler' e = case p e of
410 -- | A version of 'catch' with the arguments swapped around; useful in
411 -- situations where the code for the handler is shorter. For example:
413 -- > do handle (\e -> exitWith (ExitFailure 1)) $
415 handle :: Exception e => (e -> IO a) -> IO a -> IO a
418 -- | A version of 'catchJust' with the arguments swapped around (see
420 handleJust :: Exception e => (e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
421 handleJust p = flip (catchJust p)
423 -----------------------------------------------------------------------------
426 -- | This function maps one exception into another as proposed in the
427 -- paper \"A semantics for imprecise exceptions\".
429 -- Notice that the usage of 'unsafePerformIO' is safe here.
431 mapException :: (Exception e1, Exception e2) => (e1 -> e2) -> a -> a
432 mapException f v = unsafePerformIO (catch (evaluate v)
435 -----------------------------------------------------------------------------
436 -- 'try' and variations.
438 -- | Similar to 'catch', but returns an 'Either' result which is
439 -- @('Right' a)@ if no exception was raised, or @('Left' e)@ if an
440 -- exception was raised and its value is @e@.
442 -- > try a = catch (Right `liftM` a) (return . Left)
444 -- Note: as with 'catch', it is only polite to use this variant if you intend
445 -- to re-throw the exception after performing whatever cleanup is needed.
446 -- Otherwise, 'tryJust' is generally considered to be better.
448 -- Also note that "System.IO.Error" also exports a function called
449 -- 'System.IO.Error.try' with a similar type to 'Control.Exception.try',
450 -- except that it catches only the IO and user families of exceptions
451 -- (as required by the Haskell 98 @IO@ module).
453 try :: Exception e => IO a -> IO (Either e a)
454 try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))
456 -- | A variant of 'try' that takes an exception predicate to select
457 -- which exceptions are caught (c.f. 'catchJust'). If the exception
458 -- does not match the predicate, it is re-thrown.
459 tryJust :: Exception e => (e -> Maybe b) -> IO a -> IO (Either b a)
463 Right v -> return (Right v)
464 Left e -> case p e of
466 Just b -> return (Left b)
468 onException :: IO a -> IO b -> IO a
469 onException io what = io `catch` \e -> do what
470 throw (e :: SomeException)
472 -----------------------------------------------------------------------------
473 -- Some Useful Functions
475 -- | When you want to acquire a resource, do some work with it, and
476 -- then release the resource, it is a good idea to use 'bracket',
477 -- because 'bracket' will install the necessary exception handler to
478 -- release the resource in the event that an exception is raised
479 -- during the computation. If an exception is raised, then 'bracket' will
480 -- re-raise the exception (after performing the release).
482 -- A common example is opening a file:
485 -- > (openFile "filename" ReadMode)
487 -- > (\handle -> do { ... })
489 -- The arguments to 'bracket' are in this order so that we can partially apply
492 -- > withFile name mode = bracket (openFile name mode) hClose
496 :: IO a -- ^ computation to run first (\"acquire resource\")
497 -> (a -> IO b) -- ^ computation to run last (\"release resource\")
498 -> (a -> IO c) -- ^ computation to run in-between
499 -> IO c -- returns the value from the in-between computation
500 bracket before after thing =
503 r <- unblock (thing a) `onException` after a
509 -- | A specialised variant of 'bracket' with just a computation to run
512 finally :: IO a -- ^ computation to run first
513 -> IO b -- ^ computation to run afterward (even if an exception
515 -> IO a -- returns the value from the first computation
518 r <- unblock a `onException` sequel
523 -- | A variant of 'bracket' where the return value from the first computation
525 bracket_ :: IO a -> IO b -> IO c -> IO c
526 bracket_ before after thing = bracket before (const after) (const thing)
528 -- | Like bracket, but only performs the final action if there was an
529 -- exception raised by the in-between computation.
531 :: IO a -- ^ computation to run first (\"acquire resource\")
532 -> (a -> IO b) -- ^ computation to run last (\"release resource\")
533 -> (a -> IO c) -- ^ computation to run in-between
534 -> IO c -- returns the value from the in-between computation
535 bracketOnError before after thing =
538 unblock (thing a) `onException` after a
541 #if !(__GLASGOW_HASKELL__ || __NHC__)
542 assert :: Bool -> a -> a
544 assert False _ = throw (AssertionFailed "")
549 #if __GLASGOW_HASKELL__ || __HUGS__
550 data PatternMatchFail = PatternMatchFail String
551 INSTANCE_TYPEABLE0(PatternMatchFail,patternMatchFailTc,"PatternMatchFail")
553 instance Show PatternMatchFail where
554 showsPrec _ (PatternMatchFail err) = showString err
557 instance Exception PatternMatchFail where
558 toException (PatternMatchFail err) = Hugs.Exception.PatternMatchFail err
559 fromException (Hugs.Exception.PatternMatchFail err) = Just (PatternMatchFail err)
560 fromException _ = Nothing
562 instance Exception PatternMatchFail
567 data RecSelError = RecSelError String
568 INSTANCE_TYPEABLE0(RecSelError,recSelErrorTc,"RecSelError")
570 instance Show RecSelError where
571 showsPrec _ (RecSelError err) = showString err
574 instance Exception RecSelError where
575 toException (RecSelError err) = Hugs.Exception.RecSelError err
576 fromException (Hugs.Exception.RecSelError err) = Just (RecSelError err)
577 fromException _ = Nothing
579 instance Exception RecSelError
584 data RecConError = RecConError String
585 INSTANCE_TYPEABLE0(RecConError,recConErrorTc,"RecConError")
587 instance Show RecConError where
588 showsPrec _ (RecConError err) = showString err
591 instance Exception RecConError where
592 toException (RecConError err) = Hugs.Exception.RecConError err
593 fromException (Hugs.Exception.RecConError err) = Just (RecConError err)
594 fromException _ = Nothing
596 instance Exception RecConError
601 data RecUpdError = RecUpdError String
602 INSTANCE_TYPEABLE0(RecUpdError,recUpdErrorTc,"RecUpdError")
604 instance Show RecUpdError where
605 showsPrec _ (RecUpdError err) = showString err
608 instance Exception RecUpdError where
609 toException (RecUpdError err) = Hugs.Exception.RecUpdError err
610 fromException (Hugs.Exception.RecUpdError err) = Just (RecUpdError err)
611 fromException _ = Nothing
613 instance Exception RecUpdError
618 data NoMethodError = NoMethodError String
619 INSTANCE_TYPEABLE0(NoMethodError,noMethodErrorTc,"NoMethodError")
621 instance Show NoMethodError where
622 showsPrec _ (NoMethodError err) = showString err
625 instance Exception NoMethodError where
626 toException (NoMethodError err) = Hugs.Exception.NoMethodError err
627 fromException (Hugs.Exception.NoMethodError err) = Just (NoMethodError err)
628 fromException _ = Nothing
630 instance Exception NoMethodError
635 data NonTermination = NonTermination
636 INSTANCE_TYPEABLE0(NonTermination,nonTerminationTc,"NonTermination")
638 instance Show NonTermination where
639 showsPrec _ NonTermination = showString "<<loop>>"
642 instance Exception NonTermination where
643 toException NonTermination = Hugs.Exception.NonTermination
644 fromException Hugs.Exception.NonTermination = Just NonTermination
645 fromException _ = Nothing
647 instance Exception NonTermination
652 data NestedAtomically = NestedAtomically
653 INSTANCE_TYPEABLE0(NestedAtomically,nestedAtomicallyTc,"NestedAtomically")
655 instance Show NestedAtomically where
656 showsPrec _ NestedAtomically = showString "Control.Concurrent.STM.atomically was nested"
658 instance Exception NestedAtomically
662 instance Exception Dynamic
664 #endif /* __GLASGOW_HASKELL__ || __HUGS__ */
666 #ifdef __GLASGOW_HASKELL__
667 recSelError, recConError, irrefutPatError, runtimeError,
668 nonExhaustiveGuardsError, patError, noMethodBindingError
669 :: Addr# -> a -- All take a UTF8-encoded C string
671 recSelError s = throw (RecSelError ("No match in record selector "
672 ++ unpackCStringUtf8# s)) -- No location info unfortunately
673 runtimeError s = error (unpackCStringUtf8# s) -- No location info unfortunately
675 nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in"))
676 irrefutPatError s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern"))
677 recConError s = throw (RecConError (untangle s "Missing field in record construction"))
678 noMethodBindingError s = throw (NoMethodError (untangle s "No instance nor default method for class operation"))
679 patError s = throw (PatternMatchFail (untangle s "Non-exhaustive patterns in"))
681 -- GHC's RTS calls this
682 nonTermination :: SomeException
683 nonTermination = toException NonTermination
685 -- GHC's RTS calls this
686 nestedAtomically :: SomeException
687 nestedAtomically = toException NestedAtomically