1 {-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}
5 -----------------------------------------------------------------------------
7 -- Module : Control.Exception.Base
8 -- Copyright : (c) The University of Glasgow 2001
9 -- License : BSD-style (see the file libraries/base/LICENSE)
11 -- Maintainer : libraries@haskell.org
12 -- Stability : experimental
13 -- Portability : non-portable (extended exceptions)
15 -- Extensible exceptions, except for multiple handlers.
17 -----------------------------------------------------------------------------
19 module Control.Exception.Base (
21 -- * The Exception type
34 #if __GLASGOW_HASKELL__ || __HUGS__
39 BlockedIndefinitelyOnMVar(..),
40 BlockedIndefinitelyOnSTM(..),
49 -- * Throwing exceptions
53 #ifdef __GLASGOW_HASKELL__
57 -- * Catching Exceptions
59 -- ** The @catch@ functions
63 -- ** The @handle@ functions
67 -- ** The @try@ functions
72 -- ** The @evaluate@ function
75 -- ** The @mapException@ function
78 -- * Asynchronous Exceptions
80 -- ** Asynchronous exception control
90 -- ** (deprecated) Asynchronous exception control
108 #ifdef __GLASGOW_HASKELL__
109 -- * Calls for GHC runtime
110 recSelError, recConError, irrefutPatError, runtimeError,
111 nonExhaustiveGuardsError, patError, noMethodBindingError,
113 nonTermination, nestedAtomically,
117 #ifdef __GLASGOW_HASKELL__
119 import GHC.IO hiding (finally,onException)
120 import GHC.IO.Exception
123 -- import GHC.Exception hiding ( Exception )
128 import Prelude hiding (catch)
129 import Hugs.Prelude (ExitCode(..))
130 import Hugs.IOExts (unsafePerformIO)
131 import Hugs.Exception (SomeException(DynamicException, IOException,
132 ArithException, ArrayException, ExitException),
133 evaluate, IOException, ArithException, ArrayException)
134 import qualified Hugs.Exception
142 import qualified IO as H'98 (catch)
143 import IO (bracket,ioError)
144 import DIOError -- defn of IOError type
145 import System (ExitCode())
146 import System.IO.Unsafe (unsafePerformIO)
147 import Unsafe.Coerce (unsafeCoerce)
149 -- minimum needed for nhc98 to pretend it has Exceptions
152 data Exception = IOException IOException
153 | ArithException ArithException
154 | ArrayException ArrayException
155 | AsyncException AsyncException
156 | ExitException ExitCode
159 class ({-Typeable e,-} Show e) => Exception e where
160 toException :: e -> SomeException
161 fromException :: SomeException -> Maybe e
163 data SomeException = forall e . Exception e => SomeException e
165 INSTANCE_TYPEABLE0(SomeException,someExceptionTc,"SomeException")
167 instance Show SomeException where
168 showsPrec p (SomeException e) = showsPrec p e
169 instance Exception SomeException where
173 type IOException = IOError
174 instance Exception IOError where
175 toException = SomeException
176 fromException (SomeException e) = Just (unsafeCoerce e)
178 instance Exception ExitCode where
179 toException = SomeException
180 fromException (SomeException e) = Just (unsafeCoerce e)
186 data PatternMatchFail
189 data BlockedIndefinitelyOnMVar
190 data BlockedIndefinitelyOnSTM
195 instance Show ArithException
196 instance Show ArrayException
197 instance Show AsyncException
198 instance Show AssertionFailed
199 instance Show PatternMatchFail
200 instance Show NoMethodError
201 instance Show Deadlock
202 instance Show BlockedIndefinitelyOnMVar
203 instance Show BlockedIndefinitelyOnSTM
204 instance Show ErrorCall
205 instance Show RecConError
206 instance Show RecSelError
207 instance Show RecUpdError
210 => IO a -- ^ The computation to run
211 -> (e -> IO a) -- ^ Handler to invoke if an exception is raised
213 catch io h = H'98.catch io (h . fromJust . fromException . toException)
215 throwIO :: Exception e => e -> IO a
216 throwIO = ioError . fromJust . fromException . toException
218 throw :: Exception e => e -> a
219 throw = unsafePerformIO . throwIO
221 evaluate :: a -> IO a
222 evaluate x = x `seq` return x
224 assert :: Bool -> a -> a
226 assert False _ = throw (toException (UserError "" "Assertion failed"))
228 mask :: ((IO a-> IO a) -> IO a) -> IO a
229 mask action = action restore
230 where restore act = act
235 class (Typeable e, Show e) => Exception e where
236 toException :: e -> SomeException
237 fromException :: SomeException -> Maybe e
239 toException e = DynamicException (toDyn e) (flip showsPrec e)
240 fromException (DynamicException dyn _) = fromDynamic dyn
241 fromException _ = Nothing
243 INSTANCE_TYPEABLE0(SomeException,someExceptionTc,"SomeException")
244 INSTANCE_TYPEABLE0(IOException,iOExceptionTc,"IOException")
245 INSTANCE_TYPEABLE0(ArithException,arithExceptionTc,"ArithException")
246 INSTANCE_TYPEABLE0(ArrayException,arrayExceptionTc,"ArrayException")
247 INSTANCE_TYPEABLE0(ExitCode,exitCodeTc,"ExitCode")
248 INSTANCE_TYPEABLE0(ErrorCall,errorCallTc,"ErrorCall")
249 INSTANCE_TYPEABLE0(AssertionFailed,assertionFailedTc,"AssertionFailed")
250 INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException")
251 INSTANCE_TYPEABLE0(BlockedIndefinitelyOnMVar,blockedIndefinitelyOnMVarTc,"BlockedIndefinitelyOnMVar")
252 INSTANCE_TYPEABLE0(BlockedIndefinitelyOnSTM,blockedIndefinitelyOnSTM,"BlockedIndefinitelyOnSTM")
253 INSTANCE_TYPEABLE0(Deadlock,deadlockTc,"Deadlock")
255 instance Exception SomeException where
259 instance Exception IOException where
260 toException = IOException
261 fromException (IOException e) = Just e
262 fromException _ = Nothing
264 instance Exception ArrayException where
265 toException = ArrayException
266 fromException (ArrayException e) = Just e
267 fromException _ = Nothing
269 instance Exception ArithException where
270 toException = ArithException
271 fromException (ArithException e) = Just e
272 fromException _ = Nothing
274 instance Exception ExitCode where
275 toException = ExitException
276 fromException (ExitException e) = Just e
277 fromException _ = Nothing
279 data ErrorCall = ErrorCall String
281 instance Show ErrorCall where
282 showsPrec _ (ErrorCall err) = showString err
284 instance Exception ErrorCall where
285 toException (ErrorCall s) = Hugs.Exception.ErrorCall s
286 fromException (Hugs.Exception.ErrorCall s) = Just (ErrorCall s)
287 fromException _ = Nothing
289 data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar
290 data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM
291 data Deadlock = Deadlock
292 data AssertionFailed = AssertionFailed String
300 instance Show BlockedIndefinitelyOnMVar where
301 showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely"
303 instance Show BlockedIndefinitely where
304 showsPrec _ BlockedIndefinitely = showString "thread blocked indefinitely"
306 instance Show Deadlock where
307 showsPrec _ Deadlock = showString "<<deadlock>>"
309 instance Show AssertionFailed where
310 showsPrec _ (AssertionFailed err) = showString err
312 instance Show AsyncException where
313 showsPrec _ StackOverflow = showString "stack overflow"
314 showsPrec _ HeapOverflow = showString "heap overflow"
315 showsPrec _ ThreadKilled = showString "thread killed"
316 showsPrec _ UserInterrupt = showString "user interrupt"
318 instance Exception BlockedOnDeadMVar
319 instance Exception BlockedIndefinitely
320 instance Exception Deadlock
321 instance Exception AssertionFailed
322 instance Exception AsyncException
324 throw :: Exception e => e -> a
325 throw e = Hugs.Exception.throw (toException e)
327 throwIO :: Exception e => e -> IO a
328 throwIO e = Hugs.Exception.throwIO (toException e)
331 #ifndef __GLASGOW_HASKELL__
332 -- Dummy definitions for implementations lacking asynchonous exceptions
334 block :: IO a -> IO a
336 unblock :: IO a -> IO a
339 blocked = return False
342 -----------------------------------------------------------------------------
343 -- Catching exceptions
345 -- |This is the simplest of the exception-catching functions. It
346 -- takes a single argument, runs it, and if an exception is raised
347 -- the \"handler\" is executed, with the value of the exception passed as an
348 -- argument. Otherwise, the result is returned as normal. For example:
350 -- > catch (readFile f)
351 -- > (\e -> do let err = show (e :: IOException)
352 -- > hPutStr stderr ("Warning: Couldn't open " ++ f ++ ": " ++ err)
355 -- Note that we have to give a type signature to @e@, or the program
356 -- will not typecheck as the type is ambiguous. While it is possible
357 -- to catch exceptions of any type, see the previous section \"Catching all
358 -- exceptions\" for an explanation of the problems with doing so.
360 -- For catching exceptions in pure (non-'IO') expressions, see the
361 -- function 'evaluate'.
363 -- Note that due to Haskell\'s unspecified evaluation order, an
364 -- expression may throw one of several possible exceptions: consider
365 -- the expression @(error \"urk\") + (1 \`div\` 0)@. Does
366 -- the expression throw
367 -- @ErrorCall \"urk\"@, or @DivideByZero@?
369 -- The answer is \"it might throw either\"; the choice is
370 -- non-deterministic. If you are catching any type of exception then you
371 -- might catch either. If you are calling @catch@ with type
372 -- @IO Int -> (ArithException -> IO Int) -> IO Int@ then the handler may
373 -- get run with @DivideByZero@ as an argument, or an @ErrorCall \"urk\"@
374 -- exception may be propogated further up. If you call it again, you
375 -- might get a the opposite behaviour. This is ok, because 'catch' is an
378 -- Note that the "Prelude" also exports a function called
379 -- 'Prelude.catch' with a similar type to 'Control.Exception.catch',
380 -- except that the "Prelude" version only catches the IO and user
381 -- families of exceptions (as required by Haskell 98).
383 -- We recommend either hiding the "Prelude" version of 'Prelude.catch'
384 -- when importing "Control.Exception":
386 -- > import Prelude hiding (catch)
388 -- or importing "Control.Exception" qualified, to avoid name-clashes:
390 -- > import qualified Control.Exception as C
392 -- and then using @C.catch@
396 => IO a -- ^ The computation to run
397 -> (e -> IO a) -- ^ Handler to invoke if an exception is raised
399 #if __GLASGOW_HASKELL__
400 catch = GHC.IO.catchException
402 catch m h = Hugs.Exception.catchException m h'
403 where h' e = case fromException e of
409 -- | The function 'catchJust' is like 'catch', but it takes an extra
410 -- argument which is an /exception predicate/, a function which
411 -- selects which type of exceptions we\'re interested in.
413 -- > catchJust (\e -> if isDoesNotExistErrorType (ioeGetErrorType e) then Just () else Nothing)
415 -- > (\_ -> do hPutStrLn stderr ("No such file: " ++ show f)
418 -- Any other exceptions which are not matched by the predicate
419 -- are re-raised, and may be caught by an enclosing
420 -- 'catch', 'catchJust', etc.
423 => (e -> Maybe b) -- ^ Predicate to select exceptions
424 -> IO a -- ^ Computation to run
425 -> (b -> IO a) -- ^ Handler
427 catchJust p a handler = catch a handler'
428 where handler' e = case p e of
432 -- | A version of 'catch' with the arguments swapped around; useful in
433 -- situations where the code for the handler is shorter. For example:
435 -- > do handle (\NonTermination -> exitWith (ExitFailure 1)) $
437 handle :: Exception e => (e -> IO a) -> IO a -> IO a
440 -- | A version of 'catchJust' with the arguments swapped around (see
442 handleJust :: Exception e => (e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
443 handleJust p = flip (catchJust p)
445 -----------------------------------------------------------------------------
448 -- | This function maps one exception into another as proposed in the
449 -- paper \"A semantics for imprecise exceptions\".
451 -- Notice that the usage of 'unsafePerformIO' is safe here.
453 mapException :: (Exception e1, Exception e2) => (e1 -> e2) -> a -> a
454 mapException f v = unsafePerformIO (catch (evaluate v)
455 (\x -> throwIO (f x)))
457 -----------------------------------------------------------------------------
458 -- 'try' and variations.
460 -- | Similar to 'catch', but returns an 'Either' result which is
461 -- @('Right' a)@ if no exception of type @e@ was raised, or @('Left' ex)@
462 -- if an exception of type @e@ was raised and its value is @ex@.
463 -- If any other type of exception is raised than it will be propogated
464 -- up to the next enclosing exception handler.
466 -- > try a = catch (Right `liftM` a) (return . Left)
468 -- Note that "System.IO.Error" also exports a function called
469 -- 'System.IO.Error.try' with a similar type to 'Control.Exception.try',
470 -- except that it catches only the IO and user families of exceptions
471 -- (as required by the Haskell 98 @IO@ module).
473 try :: Exception e => IO a -> IO (Either e a)
474 try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))
476 -- | A variant of 'try' that takes an exception predicate to select
477 -- which exceptions are caught (c.f. 'catchJust'). If the exception
478 -- does not match the predicate, it is re-thrown.
479 tryJust :: Exception e => (e -> Maybe b) -> IO a -> IO (Either b a)
483 Right v -> return (Right v)
484 Left e -> case p e of
486 Just b -> return (Left b)
488 -- | Like 'finally', but only performs the final action if there was an
489 -- exception raised by the computation.
490 onException :: IO a -> IO b -> IO a
491 onException io what = io `catch` \e -> do _ <- what
492 throwIO (e :: SomeException)
494 -----------------------------------------------------------------------------
495 -- Some Useful Functions
497 -- | When you want to acquire a resource, do some work with it, and
498 -- then release the resource, it is a good idea to use 'bracket',
499 -- because 'bracket' will install the necessary exception handler to
500 -- release the resource in the event that an exception is raised
501 -- during the computation. If an exception is raised, then 'bracket' will
502 -- re-raise the exception (after performing the release).
504 -- A common example is opening a file:
507 -- > (openFile "filename" ReadMode)
509 -- > (\fileHandle -> do { ... })
511 -- The arguments to 'bracket' are in this order so that we can partially apply
514 -- > withFile name mode = bracket (openFile name mode) hClose
518 :: IO a -- ^ computation to run first (\"acquire resource\")
519 -> (a -> IO b) -- ^ computation to run last (\"release resource\")
520 -> (a -> IO c) -- ^ computation to run in-between
521 -> IO c -- returns the value from the in-between computation
522 bracket before after thing =
523 mask $ \restore -> do
525 r <- restore (thing a) `onException` after a
530 -- | A specialised variant of 'bracket' with just a computation to run
533 finally :: IO a -- ^ computation to run first
534 -> IO b -- ^ computation to run afterward (even if an exception
536 -> IO a -- returns the value from the first computation
538 mask $ \restore -> do
539 r <- restore a `onException` sequel
543 -- | A variant of 'bracket' where the return value from the first computation
545 bracket_ :: IO a -> IO b -> IO c -> IO c
546 bracket_ before after thing = bracket before (const after) (const thing)
548 -- | Like 'bracket', but only performs the final action if there was an
549 -- exception raised by the in-between computation.
551 :: IO a -- ^ computation to run first (\"acquire resource\")
552 -> (a -> IO b) -- ^ computation to run last (\"release resource\")
553 -> (a -> IO c) -- ^ computation to run in-between
554 -> IO c -- returns the value from the in-between computation
555 bracketOnError before after thing =
556 mask $ \restore -> do
558 restore (thing a) `onException` after a
560 #if !(__GLASGOW_HASKELL__ || __NHC__)
561 assert :: Bool -> a -> a
563 assert False _ = throw (AssertionFailed "")
568 #if __GLASGOW_HASKELL__ || __HUGS__
569 -- |A pattern match failed. The @String@ gives information about the
570 -- source location of the pattern.
571 data PatternMatchFail = PatternMatchFail String
572 INSTANCE_TYPEABLE0(PatternMatchFail,patternMatchFailTc,"PatternMatchFail")
574 instance Show PatternMatchFail where
575 showsPrec _ (PatternMatchFail err) = showString err
578 instance Exception PatternMatchFail where
579 toException (PatternMatchFail err) = Hugs.Exception.PatternMatchFail err
580 fromException (Hugs.Exception.PatternMatchFail err) = Just (PatternMatchFail err)
581 fromException _ = Nothing
583 instance Exception PatternMatchFail
588 -- |A record selector was applied to a constructor without the
589 -- appropriate field. This can only happen with a datatype with
590 -- multiple constructors, where some fields are in one constructor
591 -- but not another. The @String@ gives information about the source
592 -- location of the record selector.
593 data RecSelError = RecSelError String
594 INSTANCE_TYPEABLE0(RecSelError,recSelErrorTc,"RecSelError")
596 instance Show RecSelError where
597 showsPrec _ (RecSelError err) = showString err
600 instance Exception RecSelError where
601 toException (RecSelError err) = Hugs.Exception.RecSelError err
602 fromException (Hugs.Exception.RecSelError err) = Just (RecSelError err)
603 fromException _ = Nothing
605 instance Exception RecSelError
610 -- |An uninitialised record field was used. The @String@ gives
611 -- information about the source location where the record was
613 data RecConError = RecConError String
614 INSTANCE_TYPEABLE0(RecConError,recConErrorTc,"RecConError")
616 instance Show RecConError where
617 showsPrec _ (RecConError err) = showString err
620 instance Exception RecConError where
621 toException (RecConError err) = Hugs.Exception.RecConError err
622 fromException (Hugs.Exception.RecConError err) = Just (RecConError err)
623 fromException _ = Nothing
625 instance Exception RecConError
630 -- |A record update was performed on a constructor without the
631 -- appropriate field. This can only happen with a datatype with
632 -- multiple constructors, where some fields are in one constructor
633 -- but not another. The @String@ gives information about the source
634 -- location of the record update.
635 data RecUpdError = RecUpdError String
636 INSTANCE_TYPEABLE0(RecUpdError,recUpdErrorTc,"RecUpdError")
638 instance Show RecUpdError where
639 showsPrec _ (RecUpdError err) = showString err
642 instance Exception RecUpdError where
643 toException (RecUpdError err) = Hugs.Exception.RecUpdError err
644 fromException (Hugs.Exception.RecUpdError err) = Just (RecUpdError err)
645 fromException _ = Nothing
647 instance Exception RecUpdError
652 -- |A class method without a definition (neither a default definition,
653 -- nor a definition in the appropriate instance) was called. The
654 -- @String@ gives information about which method it was.
655 data NoMethodError = NoMethodError String
656 INSTANCE_TYPEABLE0(NoMethodError,noMethodErrorTc,"NoMethodError")
658 instance Show NoMethodError where
659 showsPrec _ (NoMethodError err) = showString err
662 instance Exception NoMethodError where
663 toException (NoMethodError err) = Hugs.Exception.NoMethodError err
664 fromException (Hugs.Exception.NoMethodError err) = Just (NoMethodError err)
665 fromException _ = Nothing
667 instance Exception NoMethodError
672 -- |Thrown when the runtime system detects that the computation is
673 -- guaranteed not to terminate. Note that there is no guarantee that
674 -- the runtime system will notice whether any given computation is
675 -- guaranteed to terminate or not.
676 data NonTermination = NonTermination
677 INSTANCE_TYPEABLE0(NonTermination,nonTerminationTc,"NonTermination")
679 instance Show NonTermination where
680 showsPrec _ NonTermination = showString "<<loop>>"
683 instance Exception NonTermination where
684 toException NonTermination = Hugs.Exception.NonTermination
685 fromException Hugs.Exception.NonTermination = Just NonTermination
686 fromException _ = Nothing
688 instance Exception NonTermination
693 -- |Thrown when the program attempts to call @atomically@, from the @stm@
694 -- package, inside another call to @atomically@.
695 data NestedAtomically = NestedAtomically
696 INSTANCE_TYPEABLE0(NestedAtomically,nestedAtomicallyTc,"NestedAtomically")
698 instance Show NestedAtomically where
699 showsPrec _ NestedAtomically = showString "Control.Concurrent.STM.atomically was nested"
701 instance Exception NestedAtomically
705 #endif /* __GLASGOW_HASKELL__ || __HUGS__ */
707 #ifdef __GLASGOW_HASKELL__
708 recSelError, recConError, irrefutPatError, runtimeError,
709 nonExhaustiveGuardsError, patError, noMethodBindingError,
711 :: Addr# -> a -- All take a UTF8-encoded C string
713 recSelError s = throw (RecSelError ("No match in record selector "
714 ++ unpackCStringUtf8# s)) -- No location info unfortunately
715 runtimeError s = error (unpackCStringUtf8# s) -- No location info unfortunately
716 absentError s = error ("Oops! Entered absent arg " ++ unpackCStringUtf8# s)
718 nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in"))
719 irrefutPatError s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern"))
720 recConError s = throw (RecConError (untangle s "Missing field in record construction"))
721 noMethodBindingError s = throw (NoMethodError (untangle s "No instance nor default method for class operation"))
722 patError s = throw (PatternMatchFail (untangle s "Non-exhaustive patterns in"))
724 -- GHC's RTS calls this
725 nonTermination :: SomeException
726 nonTermination = toException NonTermination
728 -- GHC's RTS calls this
729 nestedAtomically :: SomeException
730 nestedAtomically = toException NestedAtomically