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__
109 import GHC.IO hiding (finally,onException)
110 import GHC.IO.Exception
113 -- import GHC.Exception hiding ( Exception )
118 import Prelude hiding (catch)
119 import Hugs.Prelude (ExitCode(..))
120 import Hugs.IOExts (unsafePerformIO)
121 import Hugs.Exception (SomeException(DynamicException, IOException,
122 ArithException, ArrayException, ExitException),
123 evaluate, IOException, ArithException, ArrayException)
124 import qualified Hugs.Exception
132 import qualified IO as H'98 (catch)
133 import IO (bracket,ioError)
134 import DIOError -- defn of IOError type
135 import System (ExitCode())
136 import System.IO.Unsafe (unsafePerformIO)
137 import Unsafe.Coerce (unsafeCoerce)
139 -- minimum needed for nhc98 to pretend it has Exceptions
142 data Exception = IOException IOException
143 | ArithException ArithException
144 | ArrayException ArrayException
145 | AsyncException AsyncException
146 | ExitException ExitCode
149 class ({-Typeable e,-} Show e) => Exception e where
150 toException :: e -> SomeException
151 fromException :: SomeException -> Maybe e
153 data SomeException = forall e . Exception e => SomeException e
155 INSTANCE_TYPEABLE0(SomeException,someExceptionTc,"SomeException")
157 instance Show SomeException where
158 showsPrec p (SomeException e) = showsPrec p e
159 instance Exception SomeException where
163 type IOException = IOError
164 instance Exception IOError where
165 toException = SomeException
166 fromException (SomeException e) = Just (unsafeCoerce e)
168 instance Exception ExitCode where
169 toException = SomeException
170 fromException (SomeException e) = Just (unsafeCoerce e)
176 data PatternMatchFail
179 data BlockedOnDeadMVar
180 data BlockedIndefinitely
185 instance Show ArithException
186 instance Show ArrayException
187 instance Show AsyncException
188 instance Show AssertionFailed
189 instance Show PatternMatchFail
190 instance Show NoMethodError
191 instance Show Deadlock
192 instance Show BlockedOnDeadMVar
193 instance Show BlockedIndefinitely
194 instance Show ErrorCall
195 instance Show RecConError
196 instance Show RecSelError
197 instance Show RecUpdError
200 => IO a -- ^ The computation to run
201 -> (e -> IO a) -- ^ Handler to invoke if an exception is raised
203 catch io h = H'98.catch io (h . fromJust . fromException . toException)
205 throwIO :: Exception e => e -> IO a
206 throwIO = ioError . fromJust . fromException . toException
208 throw :: Exception e => e -> a
209 throw = unsafePerformIO . throwIO
211 evaluate :: a -> IO a
212 evaluate x = x `seq` return x
214 assert :: Bool -> a -> a
216 assert False _ = throw (toException (UserError "" "Assertion failed"))
221 class (Typeable e, Show e) => Exception e where
222 toException :: e -> SomeException
223 fromException :: SomeException -> Maybe e
225 toException e = DynamicException (toDyn e) (flip showsPrec e)
226 fromException (DynamicException dyn _) = fromDynamic dyn
227 fromException _ = Nothing
229 INSTANCE_TYPEABLE0(SomeException,someExceptionTc,"SomeException")
230 INSTANCE_TYPEABLE0(IOException,iOExceptionTc,"IOException")
231 INSTANCE_TYPEABLE0(ArithException,arithExceptionTc,"ArithException")
232 INSTANCE_TYPEABLE0(ArrayException,arrayExceptionTc,"ArrayException")
233 INSTANCE_TYPEABLE0(ExitCode,exitCodeTc,"ExitCode")
234 INSTANCE_TYPEABLE0(ErrorCall,errorCallTc,"ErrorCall")
235 INSTANCE_TYPEABLE0(AssertionFailed,assertionFailedTc,"AssertionFailed")
236 INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException")
237 INSTANCE_TYPEABLE0(BlockedOnDeadMVar,blockedOnDeadMVarTc,"BlockedOnDeadMVar")
238 INSTANCE_TYPEABLE0(BlockedIndefinitely,blockedIndefinitelyTc,"BlockedIndefinitely")
239 INSTANCE_TYPEABLE0(Deadlock,deadlockTc,"Deadlock")
241 instance Exception SomeException where
245 instance Exception IOException where
246 toException = IOException
247 fromException (IOException e) = Just e
248 fromException _ = Nothing
250 instance Exception ArrayException where
251 toException = ArrayException
252 fromException (ArrayException e) = Just e
253 fromException _ = Nothing
255 instance Exception ArithException where
256 toException = ArithException
257 fromException (ArithException e) = Just e
258 fromException _ = Nothing
260 instance Exception ExitCode where
261 toException = ExitException
262 fromException (ExitException e) = Just e
263 fromException _ = Nothing
265 data ErrorCall = ErrorCall String
267 instance Show ErrorCall where
268 showsPrec _ (ErrorCall err) = showString err
270 instance Exception ErrorCall where
271 toException (ErrorCall s) = Hugs.Exception.ErrorCall s
272 fromException (Hugs.Exception.ErrorCall s) = Just (ErrorCall s)
273 fromException _ = Nothing
275 data BlockedOnDeadMVar = BlockedOnDeadMVar
276 data BlockedIndefinitely = BlockedIndefinitely
277 data Deadlock = Deadlock
278 data AssertionFailed = AssertionFailed String
286 instance Show BlockedOnDeadMVar where
287 showsPrec _ BlockedOnDeadMVar = showString "thread blocked indefinitely"
289 instance Show BlockedIndefinitely where
290 showsPrec _ BlockedIndefinitely = showString "thread blocked indefinitely"
292 instance Show Deadlock where
293 showsPrec _ Deadlock = showString "<<deadlock>>"
295 instance Show AssertionFailed where
296 showsPrec _ (AssertionFailed err) = showString err
298 instance Show AsyncException where
299 showsPrec _ StackOverflow = showString "stack overflow"
300 showsPrec _ HeapOverflow = showString "heap overflow"
301 showsPrec _ ThreadKilled = showString "thread killed"
302 showsPrec _ UserInterrupt = showString "user interrupt"
304 instance Exception BlockedOnDeadMVar
305 instance Exception BlockedIndefinitely
306 instance Exception Deadlock
307 instance Exception AssertionFailed
308 instance Exception AsyncException
310 throw :: Exception e => e -> a
311 throw e = Hugs.Exception.throw (toException e)
313 throwIO :: Exception e => e -> IO a
314 throwIO e = Hugs.Exception.throwIO (toException e)
317 #ifndef __GLASGOW_HASKELL__
318 -- Dummy definitions for implementations lacking asynchonous exceptions
320 block :: IO a -> IO a
322 unblock :: IO a -> IO a
325 blocked = return False
328 -----------------------------------------------------------------------------
329 -- Catching exceptions
331 -- |This is the simplest of the exception-catching functions. It
332 -- takes a single argument, runs it, and if an exception is raised
333 -- the \"handler\" is executed, with the value of the exception passed as an
334 -- argument. Otherwise, the result is returned as normal. For example:
336 -- > catch (readFile f)
337 -- > (\e -> do let err = show (e :: IOException)
338 -- > hPutStr stderr ("Warning: Couldn't open " ++ f ++ ": " ++ err)
341 -- Note that we have to give a type signature to @e@, or the program
342 -- will not typecheck as the type is ambiguous. While it is possible
343 -- to catch exceptions of any type, see $catchall for an explanation
344 -- of the problems with doing so.
346 -- For catching exceptions in pure (non-'IO') expressions, see the
347 -- function 'evaluate'.
349 -- Note that due to Haskell\'s unspecified evaluation order, an
350 -- expression may throw one of several possible exceptions: consider
351 -- the expression @(error \"urk\") + (1 \`div\` 0)@. Does
352 -- the expression throw
353 -- @ErrorCall \"urk\"@, or @DivideByZero@?
355 -- The answer is \"it might throw either\"; the choice is
356 -- non-deterministic. If you are catching any type of exception then you
357 -- might catch either. If you are calling @catch@ with type
358 -- @IO Int -> (ArithException -> IO Int) -> IO Int@ then the handler may
359 -- get run with @DivideByZero@ as an argument, or an @ErrorCall \"urk\"@
360 -- exception may be propogated further up. If you call it again, you
361 -- might get a the opposite behaviour. This is ok, because 'catch' is an
364 -- Note that the "Prelude" also exports a function called
365 -- 'Prelude.catch' with a similar type to 'Control.Exception.catch',
366 -- except that the "Prelude" version only catches the IO and user
367 -- families of exceptions (as required by Haskell 98).
369 -- We recommend either hiding the "Prelude" version of 'Prelude.catch'
370 -- when importing "Control.Exception":
372 -- > import Prelude hiding (catch)
374 -- or importing "Control.Exception" qualified, to avoid name-clashes:
376 -- > import qualified Control.Exception as C
378 -- and then using @C.catch@
382 => IO a -- ^ The computation to run
383 -> (e -> IO a) -- ^ Handler to invoke if an exception is raised
385 #if __GLASGOW_HASKELL__
386 catch = GHC.IO.catchException
388 catch m h = Hugs.Exception.catchException m h'
389 where h' e = case fromException e of
395 -- | The function 'catchJust' is like 'catch', but it takes an extra
396 -- argument which is an /exception predicate/, a function which
397 -- selects which type of exceptions we\'re interested in.
399 -- > catchJust (\e -> if isDoesNotExistErrorType (ioeGetErrorType e) then Just () else Nothing)
401 -- > (\_ -> do hPutStrLn stderr ("No such file: " ++ show f)
404 -- Any other exceptions which are not matched by the predicate
405 -- are re-raised, and may be caught by an enclosing
406 -- 'catch', 'catchJust', etc.
409 => (e -> Maybe b) -- ^ Predicate to select exceptions
410 -> IO a -- ^ Computation to run
411 -> (b -> IO a) -- ^ Handler
413 catchJust p a handler = catch a handler'
414 where handler' e = case p e of
418 -- | A version of 'catch' with the arguments swapped around; useful in
419 -- situations where the code for the handler is shorter. For example:
421 -- > do handle (\NonTermination -> exitWith (ExitFailure 1)) $
423 handle :: Exception e => (e -> IO a) -> IO a -> IO a
426 -- | A version of 'catchJust' with the arguments swapped around (see
428 handleJust :: Exception e => (e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
429 handleJust p = flip (catchJust p)
431 -----------------------------------------------------------------------------
434 -- | This function maps one exception into another as proposed in the
435 -- paper \"A semantics for imprecise exceptions\".
437 -- Notice that the usage of 'unsafePerformIO' is safe here.
439 mapException :: (Exception e1, Exception e2) => (e1 -> e2) -> a -> a
440 mapException f v = unsafePerformIO (catch (evaluate v)
443 -----------------------------------------------------------------------------
444 -- 'try' and variations.
446 -- | Similar to 'catch', but returns an 'Either' result which is
447 -- @('Right' a)@ if no exception of type @e@ was raised, or @('Left' ex)@
448 -- if an exception of type @e@ was raised and its value is @ex@.
449 -- If any other type of exception is raised than it will be propogated
450 -- up to the next enclosing exception handler.
452 -- > try a = catch (Right `liftM` a) (return . Left)
454 -- Note that "System.IO.Error" also exports a function called
455 -- 'System.IO.Error.try' with a similar type to 'Control.Exception.try',
456 -- except that it catches only the IO and user families of exceptions
457 -- (as required by the Haskell 98 @IO@ module).
459 try :: Exception e => IO a -> IO (Either e a)
460 try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))
462 -- | A variant of 'try' that takes an exception predicate to select
463 -- which exceptions are caught (c.f. 'catchJust'). If the exception
464 -- does not match the predicate, it is re-thrown.
465 tryJust :: Exception e => (e -> Maybe b) -> IO a -> IO (Either b a)
469 Right v -> return (Right v)
470 Left e -> case p e of
472 Just b -> return (Left b)
474 -- | Like 'finally', but only performs the final action if there was an
475 -- exception raised by the computation.
476 onException :: IO a -> IO b -> IO a
477 onException io what = io `catch` \e -> do _ <- what
478 throw (e :: SomeException)
480 -----------------------------------------------------------------------------
481 -- Some Useful Functions
483 -- | When you want to acquire a resource, do some work with it, and
484 -- then release the resource, it is a good idea to use 'bracket',
485 -- because 'bracket' will install the necessary exception handler to
486 -- release the resource in the event that an exception is raised
487 -- during the computation. If an exception is raised, then 'bracket' will
488 -- re-raise the exception (after performing the release).
490 -- A common example is opening a file:
493 -- > (openFile "filename" ReadMode)
495 -- > (\fileHandle -> do { ... })
497 -- The arguments to 'bracket' are in this order so that we can partially apply
500 -- > withFile name mode = bracket (openFile name mode) hClose
504 :: IO a -- ^ computation to run first (\"acquire resource\")
505 -> (a -> IO b) -- ^ computation to run last (\"release resource\")
506 -> (a -> IO c) -- ^ computation to run in-between
507 -> IO c -- returns the value from the in-between computation
508 bracket before after thing =
511 r <- unblock (thing a) `onException` after a
517 -- | A specialised variant of 'bracket' with just a computation to run
520 finally :: IO a -- ^ computation to run first
521 -> IO b -- ^ computation to run afterward (even if an exception
523 -> IO a -- returns the value from the first computation
526 r <- unblock a `onException` sequel
531 -- | A variant of 'bracket' where the return value from the first computation
533 bracket_ :: IO a -> IO b -> IO c -> IO c
534 bracket_ before after thing = bracket before (const after) (const thing)
536 -- | Like 'bracket', but only performs the final action if there was an
537 -- exception raised by the in-between computation.
539 :: IO a -- ^ computation to run first (\"acquire resource\")
540 -> (a -> IO b) -- ^ computation to run last (\"release resource\")
541 -> (a -> IO c) -- ^ computation to run in-between
542 -> IO c -- returns the value from the in-between computation
543 bracketOnError before after thing =
546 unblock (thing a) `onException` after a
549 #if !(__GLASGOW_HASKELL__ || __NHC__)
550 assert :: Bool -> a -> a
552 assert False _ = throw (AssertionFailed "")
557 #if __GLASGOW_HASKELL__ || __HUGS__
558 -- |A pattern match failed. The @String@ gives information about the
559 -- source location of the pattern.
560 data PatternMatchFail = PatternMatchFail String
561 INSTANCE_TYPEABLE0(PatternMatchFail,patternMatchFailTc,"PatternMatchFail")
563 instance Show PatternMatchFail where
564 showsPrec _ (PatternMatchFail err) = showString err
567 instance Exception PatternMatchFail where
568 toException (PatternMatchFail err) = Hugs.Exception.PatternMatchFail err
569 fromException (Hugs.Exception.PatternMatchFail err) = Just (PatternMatchFail err)
570 fromException _ = Nothing
572 instance Exception PatternMatchFail
577 -- |A record selector was applied to a constructor without the
578 -- appropriate field. This can only happen with a datatype with
579 -- multiple constructors, where some fields are in one constructor
580 -- but not another. The @String@ gives information about the source
581 -- location of the record selector.
582 data RecSelError = RecSelError String
583 INSTANCE_TYPEABLE0(RecSelError,recSelErrorTc,"RecSelError")
585 instance Show RecSelError where
586 showsPrec _ (RecSelError err) = showString err
589 instance Exception RecSelError where
590 toException (RecSelError err) = Hugs.Exception.RecSelError err
591 fromException (Hugs.Exception.RecSelError err) = Just (RecSelError err)
592 fromException _ = Nothing
594 instance Exception RecSelError
599 -- |An uninitialised record field was used. The @String@ gives
600 -- information about the source location where the record was
602 data RecConError = RecConError String
603 INSTANCE_TYPEABLE0(RecConError,recConErrorTc,"RecConError")
605 instance Show RecConError where
606 showsPrec _ (RecConError err) = showString err
609 instance Exception RecConError where
610 toException (RecConError err) = Hugs.Exception.RecConError err
611 fromException (Hugs.Exception.RecConError err) = Just (RecConError err)
612 fromException _ = Nothing
614 instance Exception RecConError
619 -- |A record update was performed on a constructor without the
620 -- appropriate field. This can only happen with a datatype with
621 -- multiple constructors, where some fields are in one constructor
622 -- but not another. The @String@ gives information about the source
623 -- location of the record update.
624 data RecUpdError = RecUpdError String
625 INSTANCE_TYPEABLE0(RecUpdError,recUpdErrorTc,"RecUpdError")
627 instance Show RecUpdError where
628 showsPrec _ (RecUpdError err) = showString err
631 instance Exception RecUpdError where
632 toException (RecUpdError err) = Hugs.Exception.RecUpdError err
633 fromException (Hugs.Exception.RecUpdError err) = Just (RecUpdError err)
634 fromException _ = Nothing
636 instance Exception RecUpdError
641 -- |A class method without a definition (neither a default definition,
642 -- nor a definition in the appropriate instance) was called. The
643 -- @String@ gives information about which method it was.
644 data NoMethodError = NoMethodError String
645 INSTANCE_TYPEABLE0(NoMethodError,noMethodErrorTc,"NoMethodError")
647 instance Show NoMethodError where
648 showsPrec _ (NoMethodError err) = showString err
651 instance Exception NoMethodError where
652 toException (NoMethodError err) = Hugs.Exception.NoMethodError err
653 fromException (Hugs.Exception.NoMethodError err) = Just (NoMethodError err)
654 fromException _ = Nothing
656 instance Exception NoMethodError
661 -- |Thrown when the runtime system detects that the computation is
662 -- guaranteed not to terminate. Note that there is no guarantee that
663 -- the runtime system will notice whether any given computation is
664 -- guaranteed to terminate or not.
665 data NonTermination = NonTermination
666 INSTANCE_TYPEABLE0(NonTermination,nonTerminationTc,"NonTermination")
668 instance Show NonTermination where
669 showsPrec _ NonTermination = showString "<<loop>>"
672 instance Exception NonTermination where
673 toException NonTermination = Hugs.Exception.NonTermination
674 fromException Hugs.Exception.NonTermination = Just NonTermination
675 fromException _ = Nothing
677 instance Exception NonTermination
682 -- |Thrown when the program attempts to call @atomically@, from the @stm@
683 -- package, inside another call to @atomically@.
684 data NestedAtomically = NestedAtomically
685 INSTANCE_TYPEABLE0(NestedAtomically,nestedAtomicallyTc,"NestedAtomically")
687 instance Show NestedAtomically where
688 showsPrec _ NestedAtomically = showString "Control.Concurrent.STM.atomically was nested"
690 instance Exception NestedAtomically
694 instance Exception Dynamic
696 #endif /* __GLASGOW_HASKELL__ || __HUGS__ */
698 #ifdef __GLASGOW_HASKELL__
699 recSelError, recConError, irrefutPatError, runtimeError,
700 nonExhaustiveGuardsError, patError, noMethodBindingError
701 :: Addr# -> a -- All take a UTF8-encoded C string
703 recSelError s = throw (RecSelError ("No match in record selector "
704 ++ unpackCStringUtf8# s)) -- No location info unfortunately
705 runtimeError s = error (unpackCStringUtf8# s) -- No location info unfortunately
707 nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in"))
708 irrefutPatError s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern"))
709 recConError s = throw (RecConError (untangle s "Missing field in record construction"))
710 noMethodBindingError s = throw (NoMethodError (untangle s "No instance nor default method for class operation"))
711 patError s = throw (PatternMatchFail (untangle s "Non-exhaustive patterns in"))
713 -- GHC's RTS calls this
714 nonTermination :: SomeException
715 nonTermination = toException NonTermination
717 -- GHC's RTS calls this
718 nestedAtomically :: SomeException
719 nestedAtomically = toException NestedAtomically