1 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
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
98 #ifdef __GLASGOW_HASKELL__
99 -- * Calls for GHC runtime
100 recSelError, recConError, irrefutPatError, runtimeError,
101 nonExhaustiveGuardsError, patError, noMethodBindingError,
102 nonTermination, nestedAtomically,
106 #ifdef __GLASGOW_HASKELL__
108 import GHC.IO hiding (finally,onException)
109 import GHC.IO.Exception
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 BlockedIndefinitelyOnMVar
179 data BlockedIndefinitelyOnSTM
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 BlockedIndefinitelyOnMVar
192 instance Show BlockedIndefinitelyOnSTM
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(BlockedIndefinitelyOnMVar,blockedIndefinitelyOnMVarTc,"BlockedIndefinitelyOnMVar")
237 INSTANCE_TYPEABLE0(BlockedIndefinitelyOnSTM,blockedIndefinitelyOnSTM,"BlockedIndefinitelyOnSTM")
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 BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar
275 data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM
276 data Deadlock = Deadlock
277 data AssertionFailed = AssertionFailed String
285 instance Show BlockedIndefinitelyOnMVar where
286 showsPrec _ BlockedIndefinitelyOnMVar = 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 (readFile f)
336 -- > (\e -> do let err = show (e :: IOException)
337 -- > hPutStr stderr ("Warning: Couldn't open " ++ f ++ ": " ++ err)
340 -- Note that we have to give a type signature to @e@, or the program
341 -- will not typecheck as the type is ambiguous. While it is possible
342 -- to catch exceptions of any type, see the previous section \"Catching all
343 -- exceptions \" for an explanation of the problems with doing so.
345 -- For catching exceptions in pure (non-'IO') expressions, see the
346 -- function 'evaluate'.
348 -- Note that due to Haskell\'s unspecified evaluation order, an
349 -- expression may throw one of several possible exceptions: consider
350 -- the expression @(error \"urk\") + (1 \`div\` 0)@. Does
351 -- the expression throw
352 -- @ErrorCall \"urk\"@, or @DivideByZero@?
354 -- The answer is \"it might throw either\"; the choice is
355 -- non-deterministic. If you are catching any type of exception then you
356 -- might catch either. If you are calling @catch@ with type
357 -- @IO Int -> (ArithException -> IO Int) -> IO Int@ then the handler may
358 -- get run with @DivideByZero@ as an argument, or an @ErrorCall \"urk\"@
359 -- exception may be propogated further up. If you call it again, you
360 -- might get a the opposite behaviour. This is ok, because 'catch' is an
363 -- Note that the "Prelude" also exports a function called
364 -- 'Prelude.catch' with a similar type to 'Control.Exception.catch',
365 -- except that the "Prelude" version only catches the IO and user
366 -- families of exceptions (as required by Haskell 98).
368 -- We recommend either hiding the "Prelude" version of 'Prelude.catch'
369 -- when importing "Control.Exception":
371 -- > import Prelude hiding (catch)
373 -- or importing "Control.Exception" qualified, to avoid name-clashes:
375 -- > import qualified Control.Exception as C
377 -- and then using @C.catch@
381 => IO a -- ^ The computation to run
382 -> (e -> IO a) -- ^ Handler to invoke if an exception is raised
384 #if __GLASGOW_HASKELL__
385 catch = GHC.IO.catchException
387 catch m h = Hugs.Exception.catchException m h'
388 where h' e = case fromException e of
394 -- | The function 'catchJust' is like 'catch', but it takes an extra
395 -- argument which is an /exception predicate/, a function which
396 -- selects which type of exceptions we\'re interested in.
398 -- > catchJust (\e -> if isDoesNotExistErrorType (ioeGetErrorType e) then Just () else Nothing)
400 -- > (\_ -> do hPutStrLn stderr ("No such file: " ++ show f)
403 -- Any other exceptions which are not matched by the predicate
404 -- are re-raised, and may be caught by an enclosing
405 -- 'catch', 'catchJust', etc.
408 => (e -> Maybe b) -- ^ Predicate to select exceptions
409 -> IO a -- ^ Computation to run
410 -> (b -> IO a) -- ^ Handler
412 catchJust p a handler = catch a handler'
413 where handler' e = case p e of
417 -- | A version of 'catch' with the arguments swapped around; useful in
418 -- situations where the code for the handler is shorter. For example:
420 -- > do handle (\NonTermination -> exitWith (ExitFailure 1)) $
422 handle :: Exception e => (e -> IO a) -> IO a -> IO a
425 -- | A version of 'catchJust' with the arguments swapped around (see
427 handleJust :: Exception e => (e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
428 handleJust p = flip (catchJust p)
430 -----------------------------------------------------------------------------
433 -- | This function maps one exception into another as proposed in the
434 -- paper \"A semantics for imprecise exceptions\".
436 -- Notice that the usage of 'unsafePerformIO' is safe here.
438 mapException :: (Exception e1, Exception e2) => (e1 -> e2) -> a -> a
439 mapException f v = unsafePerformIO (catch (evaluate v)
442 -----------------------------------------------------------------------------
443 -- 'try' and variations.
445 -- | Similar to 'catch', but returns an 'Either' result which is
446 -- @('Right' a)@ if no exception of type @e@ was raised, or @('Left' ex)@
447 -- if an exception of type @e@ was raised and its value is @ex@.
448 -- If any other type of exception is raised than it will be propogated
449 -- up to the next enclosing exception handler.
451 -- > try a = catch (Right `liftM` a) (return . Left)
453 -- Note that "System.IO.Error" also exports a function called
454 -- 'System.IO.Error.try' with a similar type to 'Control.Exception.try',
455 -- except that it catches only the IO and user families of exceptions
456 -- (as required by the Haskell 98 @IO@ module).
458 try :: Exception e => IO a -> IO (Either e a)
459 try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))
461 -- | A variant of 'try' that takes an exception predicate to select
462 -- which exceptions are caught (c.f. 'catchJust'). If the exception
463 -- does not match the predicate, it is re-thrown.
464 tryJust :: Exception e => (e -> Maybe b) -> IO a -> IO (Either b a)
468 Right v -> return (Right v)
469 Left e -> case p e of
471 Just b -> return (Left b)
473 -- | Like 'finally', but only performs the final action if there was an
474 -- exception raised by the computation.
475 onException :: IO a -> IO b -> IO a
476 onException io what = io `catch` \e -> do _ <- what
477 throw (e :: SomeException)
479 -----------------------------------------------------------------------------
480 -- Some Useful Functions
482 -- | When you want to acquire a resource, do some work with it, and
483 -- then release the resource, it is a good idea to use 'bracket',
484 -- because 'bracket' will install the necessary exception handler to
485 -- release the resource in the event that an exception is raised
486 -- during the computation. If an exception is raised, then 'bracket' will
487 -- re-raise the exception (after performing the release).
489 -- A common example is opening a file:
492 -- > (openFile "filename" ReadMode)
494 -- > (\fileHandle -> do { ... })
496 -- The arguments to 'bracket' are in this order so that we can partially apply
499 -- > withFile name mode = bracket (openFile name mode) hClose
503 :: IO a -- ^ computation to run first (\"acquire resource\")
504 -> (a -> IO b) -- ^ computation to run last (\"release resource\")
505 -> (a -> IO c) -- ^ computation to run in-between
506 -> IO c -- returns the value from the in-between computation
507 bracket before after thing =
510 r <- unblock (thing a) `onException` after a
516 -- | A specialised variant of 'bracket' with just a computation to run
519 finally :: IO a -- ^ computation to run first
520 -> IO b -- ^ computation to run afterward (even if an exception
522 -> IO a -- returns the value from the first computation
525 r <- unblock a `onException` sequel
530 -- | A variant of 'bracket' where the return value from the first computation
532 bracket_ :: IO a -> IO b -> IO c -> IO c
533 bracket_ before after thing = bracket before (const after) (const thing)
535 -- | Like 'bracket', but only performs the final action if there was an
536 -- exception raised by the in-between computation.
538 :: IO a -- ^ computation to run first (\"acquire resource\")
539 -> (a -> IO b) -- ^ computation to run last (\"release resource\")
540 -> (a -> IO c) -- ^ computation to run in-between
541 -> IO c -- returns the value from the in-between computation
542 bracketOnError before after thing =
545 unblock (thing a) `onException` after a
548 #if !(__GLASGOW_HASKELL__ || __NHC__)
549 assert :: Bool -> a -> a
551 assert False _ = throw (AssertionFailed "")
556 #if __GLASGOW_HASKELL__ || __HUGS__
557 -- |A pattern match failed. The @String@ gives information about the
558 -- source location of the pattern.
559 data PatternMatchFail = PatternMatchFail String
560 INSTANCE_TYPEABLE0(PatternMatchFail,patternMatchFailTc,"PatternMatchFail")
562 instance Show PatternMatchFail where
563 showsPrec _ (PatternMatchFail err) = showString err
566 instance Exception PatternMatchFail where
567 toException (PatternMatchFail err) = Hugs.Exception.PatternMatchFail err
568 fromException (Hugs.Exception.PatternMatchFail err) = Just (PatternMatchFail err)
569 fromException _ = Nothing
571 instance Exception PatternMatchFail
576 -- |A record selector was applied to a constructor without the
577 -- appropriate field. This can only happen with a datatype with
578 -- multiple constructors, where some fields are in one constructor
579 -- but not another. The @String@ gives information about the source
580 -- location of the record selector.
581 data RecSelError = RecSelError String
582 INSTANCE_TYPEABLE0(RecSelError,recSelErrorTc,"RecSelError")
584 instance Show RecSelError where
585 showsPrec _ (RecSelError err) = showString err
588 instance Exception RecSelError where
589 toException (RecSelError err) = Hugs.Exception.RecSelError err
590 fromException (Hugs.Exception.RecSelError err) = Just (RecSelError err)
591 fromException _ = Nothing
593 instance Exception RecSelError
598 -- |An uninitialised record field was used. The @String@ gives
599 -- information about the source location where the record was
601 data RecConError = RecConError String
602 INSTANCE_TYPEABLE0(RecConError,recConErrorTc,"RecConError")
604 instance Show RecConError where
605 showsPrec _ (RecConError err) = showString err
608 instance Exception RecConError where
609 toException (RecConError err) = Hugs.Exception.RecConError err
610 fromException (Hugs.Exception.RecConError err) = Just (RecConError err)
611 fromException _ = Nothing
613 instance Exception RecConError
618 -- |A record update was performed on a constructor without the
619 -- appropriate field. This can only happen with a datatype with
620 -- multiple constructors, where some fields are in one constructor
621 -- but not another. The @String@ gives information about the source
622 -- location of the record update.
623 data RecUpdError = RecUpdError String
624 INSTANCE_TYPEABLE0(RecUpdError,recUpdErrorTc,"RecUpdError")
626 instance Show RecUpdError where
627 showsPrec _ (RecUpdError err) = showString err
630 instance Exception RecUpdError where
631 toException (RecUpdError err) = Hugs.Exception.RecUpdError err
632 fromException (Hugs.Exception.RecUpdError err) = Just (RecUpdError err)
633 fromException _ = Nothing
635 instance Exception RecUpdError
640 -- |A class method without a definition (neither a default definition,
641 -- nor a definition in the appropriate instance) was called. The
642 -- @String@ gives information about which method it was.
643 data NoMethodError = NoMethodError String
644 INSTANCE_TYPEABLE0(NoMethodError,noMethodErrorTc,"NoMethodError")
646 instance Show NoMethodError where
647 showsPrec _ (NoMethodError err) = showString err
650 instance Exception NoMethodError where
651 toException (NoMethodError err) = Hugs.Exception.NoMethodError err
652 fromException (Hugs.Exception.NoMethodError err) = Just (NoMethodError err)
653 fromException _ = Nothing
655 instance Exception NoMethodError
660 -- |Thrown when the runtime system detects that the computation is
661 -- guaranteed not to terminate. Note that there is no guarantee that
662 -- the runtime system will notice whether any given computation is
663 -- guaranteed to terminate or not.
664 data NonTermination = NonTermination
665 INSTANCE_TYPEABLE0(NonTermination,nonTerminationTc,"NonTermination")
667 instance Show NonTermination where
668 showsPrec _ NonTermination = showString "<<loop>>"
671 instance Exception NonTermination where
672 toException NonTermination = Hugs.Exception.NonTermination
673 fromException Hugs.Exception.NonTermination = Just NonTermination
674 fromException _ = Nothing
676 instance Exception NonTermination
681 -- |Thrown when the program attempts to call @atomically@, from the @stm@
682 -- package, inside another call to @atomically@.
683 data NestedAtomically = NestedAtomically
684 INSTANCE_TYPEABLE0(NestedAtomically,nestedAtomicallyTc,"NestedAtomically")
686 instance Show NestedAtomically where
687 showsPrec _ NestedAtomically = showString "Control.Concurrent.STM.atomically was nested"
689 instance Exception NestedAtomically
693 #endif /* __GLASGOW_HASKELL__ || __HUGS__ */
695 #ifdef __GLASGOW_HASKELL__
696 recSelError, recConError, irrefutPatError, runtimeError,
697 nonExhaustiveGuardsError, patError, noMethodBindingError
698 :: Addr# -> a -- All take a UTF8-encoded C string
700 recSelError s = throw (RecSelError ("No match in record selector "
701 ++ unpackCStringUtf8# s)) -- No location info unfortunately
702 runtimeError s = error (unpackCStringUtf8# s) -- No location info unfortunately
704 nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in"))
705 irrefutPatError s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern"))
706 recConError s = throw (RecConError (untangle s "Missing field in record construction"))
707 noMethodBindingError s = throw (NoMethodError (untangle s "No instance nor default method for class operation"))
708 patError s = throw (PatternMatchFail (untangle s "Non-exhaustive patterns in"))
710 -- GHC's RTS calls this
711 nonTermination :: SomeException
712 nonTermination = toException NonTermination
714 -- GHC's RTS calls this
715 nestedAtomically :: SomeException
716 nestedAtomically = toException NestedAtomically