ghc-internal-9.1201.0: src/GHC/Internal/Exception/Type.hs
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE Trustworthy #-}
{-# OPTIONS_HADDOCK not-home #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Internal.Exception.Type
-- Copyright : (c) The University of Glasgow, 1998-2002
-- License : see libraries/base/LICENSE
--
-- Maintainer : ghc-devs@haskell.org
-- Stability : internal
-- Portability : non-portable (GHC extensions)
--
-- Exceptions and exception-handling functions.
--
-- /The API of this module is unstable and not meant to be consumed by the general public./
-- If you absolutely must depend on it, make sure to use a tight upper
-- bound, e.g., @base < 4.X@ rather than @base < 5@, because the interface can
-- change rapidly without much warning.
--
-----------------------------------------------------------------------------
module GHC.Internal.Exception.Type
( Exception(..) -- Class
, SomeException(..)
, displayExceptionWithInfo
, someExceptionContext
, addExceptionContext
, mapExceptionContext
, NoBacktrace(..)
-- * Exception context
, HasExceptionContext
, ExceptionContext(..)
, emptyExceptionContext
, mergeExceptionContext
, ExceptionWithContext(..)
-- * Exception propagation
, WhileHandling(..)
, whileHandling
-- * Arithmetic exceptions
, ArithException(..)
, divZeroException, overflowException, ratioZeroDenomException
, underflowException
) where
import GHC.Internal.Data.OldList (lines, unlines, null)
import GHC.Internal.Data.Maybe
import GHC.Internal.Data.Typeable (Typeable, TypeRep, cast)
import qualified GHC.Internal.Data.Typeable as Typeable
-- loop: GHC.Internal.Data.Typeable -> GHC.Internal.Err -> GHC.Internal.Exception
import GHC.Internal.Base
import GHC.Internal.Show
import GHC.Internal.Exception.Context
{- |
A constraint used to propagate 'ExceptionContext's.
GHC will automatically default any unsolved 'HasExceptionContext' constraints to an
empty exception context, similarly to 'HasCallStack'.
NOTE: The fact that @HasExceptionContext@ is defined as an implicit parameter is
an implementation detail and __should not__ be considered a part of the API.
It does however mean that any implicit parameter `?exceptionContext :: ExceptionContext`
will be subject to defaulting, as described above.
@since base-4.20.0.0
-}
type HasExceptionContext = (?exceptionContext :: ExceptionContext)
{- | @WhileHandling@ is used to annotate rethrow exceptions. By inspecting
the @WhileHandling@ annotation, all the places the exception has been rethrow
can be recovered.
-}
data WhileHandling = WhileHandling SomeException deriving Show
instance ExceptionAnnotation WhileHandling where
displayExceptionAnnotation (WhileHandling e) =
"While handling " ++ case lines $ displayException e of
[] -> ""
(l1:ls) ->
-- Indent lines forward.
-- displayException may be ill prepared for this?...
unlines $ l1:[if null l then " |" else " | " ++ l | l <- ls]
-- | Create 'SomeException' from an explicit context and exception.
whileHandling :: Exception e => ExceptionWithContext e -> WhileHandling
whileHandling e = WhileHandling (toException e)
{- |
The @SomeException@ type is the root of the exception type hierarchy.
When an exception of type @e@ is thrown, behind the scenes it is
encapsulated in a @SomeException@.
-}
data SomeException = forall e. (Exception e, HasExceptionContext) => SomeException e
-- | View the 'ExceptionContext' of a 'SomeException'.
someExceptionContext :: SomeException -> ExceptionContext
someExceptionContext (SomeException _) = ?exceptionContext
-- | Add more 'ExceptionContext' to a 'SomeException'.
addExceptionContext :: ExceptionAnnotation a => a -> SomeException -> SomeException
addExceptionContext ann =
mapExceptionContext (addExceptionAnnotation ann)
mapExceptionContext :: (ExceptionContext -> ExceptionContext) -> SomeException -> SomeException
mapExceptionContext f se@(SomeException e) =
let ?exceptionContext = f (someExceptionContext se)
in SomeException e
-- | @since 3.0
instance Show SomeException where
showsPrec p (SomeException e) = showsPrec p e
{- |
Any type that you wish to throw or catch as an exception must be an
instance of the @Exception@ class. The simplest case is a new exception
type directly below the root:
> data MyException = ThisException | ThatException
> deriving Show
>
> instance Exception MyException
The default method definitions in the @Exception@ class do what we need
in this case. You can now throw and catch @ThisException@ and
@ThatException@ as exceptions:
@
*Main> throw ThisException \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: MyException))
Caught ThisException
@
In more complicated examples, you may wish to define a whole hierarchy
of exceptions:
> ---------------------------------------------------------------------
> -- Make the root exception type for all the exceptions in a compiler
>
> data SomeCompilerException = forall e . Exception e => SomeCompilerException e
>
> instance Show SomeCompilerException where
> show (SomeCompilerException e) = show e
>
> instance Exception SomeCompilerException
>
> compilerExceptionToException :: Exception e => e -> SomeException
> compilerExceptionToException = toException . SomeCompilerException
>
> compilerExceptionFromException :: Exception e => SomeException -> Maybe e
> compilerExceptionFromException x = do
> SomeCompilerException a <- fromException x
> cast a
>
> ---------------------------------------------------------------------
> -- Make a subhierarchy for exceptions in the frontend of the compiler
>
> data SomeFrontendException = forall e . Exception e => SomeFrontendException e
>
> instance Show SomeFrontendException where
> show (SomeFrontendException e) = show e
>
> instance Exception SomeFrontendException where
> toException = compilerExceptionToException
> fromException = compilerExceptionFromException
>
> frontendExceptionToException :: Exception e => e -> SomeException
> frontendExceptionToException = toException . SomeFrontendException
>
> frontendExceptionFromException :: Exception e => SomeException -> Maybe e
> frontendExceptionFromException x = do
> SomeFrontendException a <- fromException x
> cast a
>
> ---------------------------------------------------------------------
> -- Make an exception type for a particular frontend compiler exception
>
> data MismatchedParentheses = MismatchedParentheses
> deriving Show
>
> instance Exception MismatchedParentheses where
> toException = frontendExceptionToException
> fromException = frontendExceptionFromException
We can now catch a @MismatchedParentheses@ exception as
@MismatchedParentheses@, @SomeFrontendException@ or
@SomeCompilerException@, but not other types, e.g. @IOException@:
@
*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: MismatchedParentheses))
Caught MismatchedParentheses
*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: SomeFrontendException))
Caught MismatchedParentheses
*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: SomeCompilerException))
Caught MismatchedParentheses
*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: IOException))
*** Exception: MismatchedParentheses
@
-}
class (Typeable e, Show e) => Exception e where
-- | @toException@ should produce a 'SomeException' with no attached 'ExceptionContext'.
toException :: e -> SomeException
fromException :: SomeException -> Maybe e
toException e = SomeException e
where ?exceptionContext = emptyExceptionContext
fromException (SomeException e) = cast e
-- | Render this exception value in a human-friendly manner.
--
-- Default implementation: @'show'@.
--
-- @since base-4.8.0.0
displayException :: e -> String
displayException = show
-- | @since base-4.20.0.0
backtraceDesired :: e -> Bool
backtraceDesired _ = True
-- | @since base-4.8.0.0
instance Exception Void
-- | This drops any attached 'ExceptionContext'.
--
-- @since base-3.0
instance Exception SomeException where
toException (SomeException e) =
let ?exceptionContext = emptyExceptionContext
in SomeException e
fromException = Just
backtraceDesired (SomeException e) = backtraceDesired e
displayException (SomeException e) = displayException e
-- | Displays a 'SomeException' with additional information:
--
-- * The type of the underlying exception
-- * The exception context
--
-- By default, 'uncaughtExceptionHandler' uses 'displayExceptionWithInfo' to print uncaught exceptions.
-- This default can be overriden with 'setUncaughtExceptionHandler', for
-- instance, to present custom error messages on exceptions to the user.
--
-- @since base-4.21
displayExceptionWithInfo :: SomeException -> String
displayExceptionWithInfo (SomeException e) =
case displayExceptionContext ?exceptionContext of
"" -> msg
dc -> msg ++ "\n\n" ++ dc
where
msg =
displayExceptionType (Typeable.typeOf e)
++ "\n\n"
++ displayException e
displayExceptionType :: TypeRep -> String
displayExceptionType rep =
tyMsg ++ ":"
where
tyMsg = Typeable.tyConPackage tyCon ++ ":" ++ Typeable.tyConModule tyCon ++ "." ++ Typeable.tyConName tyCon
tyCon = Typeable.typeRepTyCon rep
newtype NoBacktrace e = NoBacktrace e
deriving (Show)
instance Exception e => Exception (NoBacktrace e) where
fromException = fmap NoBacktrace . fromException
toException (NoBacktrace e) = toException e
backtraceDesired _ = False
-- | Wraps a particular exception exposing its 'ExceptionContext'. Intended to
-- be used when 'catch'ing exceptions in cases where access to the context is
-- desired.
data ExceptionWithContext a = ExceptionWithContext ExceptionContext a
instance Show a => Show (ExceptionWithContext a) where
showsPrec _ (ExceptionWithContext _ e) = showString "ExceptionWithContext _ " . shows e
instance Exception a => Exception (ExceptionWithContext a) where
toException (ExceptionWithContext ctxt e) =
case toException e of
SomeException c ->
let ?exceptionContext = ctxt
in SomeException c
fromException se = do
e <- fromException se
return (ExceptionWithContext (someExceptionContext se) e)
backtraceDesired (ExceptionWithContext _ e) = backtraceDesired e
displayException = displayException . toException
-- |Arithmetic exceptions.
data ArithException
= Overflow
| Underflow
| LossOfPrecision
| DivideByZero
| Denormal
| RatioZeroDenominator -- ^ @since base-4.6.0.0
deriving ( Eq -- ^ @since base-3.0
, Ord -- ^ @since base-3.0
)
divZeroException, overflowException, ratioZeroDenomException, underflowException :: SomeException
divZeroException = toException DivideByZero
overflowException = toException Overflow
ratioZeroDenomException = toException RatioZeroDenominator
underflowException = toException Underflow
-- | @since base-4.0.0.0
instance Exception ArithException
-- | @since base-4.0.0.0
instance Show ArithException where
showsPrec _ Overflow = showString "arithmetic overflow"
showsPrec _ Underflow = showString "arithmetic underflow"
showsPrec _ LossOfPrecision = showString "loss of precision"
showsPrec _ DivideByZero = showString "divide by zero"
showsPrec _ Denormal = showString "denormal"
showsPrec _ RatioZeroDenominator = showString "Ratio has zero denominator"