{-# 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(..)
       , someExceptionContext
       , addExceptionContext
       , mapExceptionContext
       , NoBacktrace(..)
         -- * Exception context
       , HasExceptionContext
       , ExceptionContext(..)
       , emptyExceptionContext
       , mergeExceptionContext
       , ExceptionWithContext(..)
         -- * Arithmetic exceptions
       , ArithException(..)
       , divZeroException, overflowException, ratioZeroDenomException
       , underflowException
       ) where

import GHC.Internal.Data.Maybe
import GHC.Internal.Data.Typeable (Typeable, cast)
   -- loop: GHC.Internal.Data.Typeable -> GHC.Internal.Err -> GHC.Internal.Exception
import GHC.Internal.Base
import GHC.Internal.Show
import GHC.Internal.Exception.Context

type HasExceptionContext = (?exceptionContext :: ExceptionContext)

{- |
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
someExceptionContext (SomeException e
_) = HasExceptionContext
ExceptionContext
?exceptionContext

-- | Add more 'ExceptionContext' to a 'SomeException'.
addExceptionContext :: ExceptionAnnotation a => a -> SomeException -> SomeException
addExceptionContext :: forall a.
ExceptionAnnotation a =>
a -> SomeException -> SomeException
addExceptionContext a
ann =
    (ExceptionContext -> ExceptionContext)
-> SomeException -> SomeException
mapExceptionContext (a -> ExceptionContext -> ExceptionContext
forall a.
ExceptionAnnotation a =>
a -> ExceptionContext -> ExceptionContext
addExceptionAnnotation a
ann)

mapExceptionContext :: (ExceptionContext -> ExceptionContext) -> SomeException -> SomeException
mapExceptionContext :: (ExceptionContext -> ExceptionContext)
-> SomeException -> SomeException
mapExceptionContext ExceptionContext -> ExceptionContext
f se :: SomeException
se@(SomeException e
e) =
    let ?exceptionContext = ExceptionContext -> ExceptionContext
f (SomeException -> ExceptionContext
someExceptionContext SomeException
se)
    in e -> SomeException
forall e. (Exception e, HasExceptionContext) => e -> SomeException
SomeException e
e

-- | @since 3.0
instance Show SomeException where
    showsPrec :: Int -> SomeException -> ShowS
showsPrec Int
p (SomeException e
e) = Int -> e -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p e
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
e = e -> SomeException
forall e. (Exception e, HasExceptionContext) => e -> SomeException
SomeException e
e
      where ?exceptionContext = HasExceptionContext
ExceptionContext
emptyExceptionContext
    fromException (SomeException e
e) = e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e

    -- | Render this exception value in a human-friendly manner.
    --
    -- Default implementation: @'show'@.
    --
    -- @since base-4.8.0.0
    displayException :: e -> String
    displayException = e -> String
forall a. Show a => a -> String
show

    backtraceDesired :: e -> Bool
    backtraceDesired e
_ = Bool
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 -> SomeException
toException (SomeException e
e) =
        let ?exceptionContext = HasExceptionContext
ExceptionContext
emptyExceptionContext
        in e -> SomeException
forall e. (Exception e, HasExceptionContext) => e -> SomeException
SomeException e
e
    fromException :: SomeException -> Maybe SomeException
fromException = SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just
    backtraceDesired :: SomeException -> Bool
backtraceDesired (SomeException e
e) = e -> Bool
forall e. Exception e => e -> Bool
backtraceDesired e
e
    displayException :: SomeException -> String
displayException (SomeException e
e) =
        e -> String
forall e. Exception e => e -> String
displayException e
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ExceptionContext -> String
displayContext HasExceptionContext
ExceptionContext
?exceptionContext

displayContext :: ExceptionContext -> String
displayContext :: ExceptionContext -> String
displayContext (ExceptionContext [SomeExceptionAnnotation]
anns0) = [SomeExceptionAnnotation] -> String
go [SomeExceptionAnnotation]
anns0
  where
    go :: [SomeExceptionAnnotation] -> String
go (SomeExceptionAnnotation a
ann : [SomeExceptionAnnotation]
anns) = a -> String
forall a. ExceptionAnnotation a => a -> String
displayExceptionAnnotation a
ann String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [SomeExceptionAnnotation] -> String
go [SomeExceptionAnnotation]
anns
    go [] = String
""

newtype NoBacktrace e = NoBacktrace e
    deriving (Int -> NoBacktrace e -> ShowS
[NoBacktrace e] -> ShowS
NoBacktrace e -> String
(Int -> NoBacktrace e -> ShowS)
-> (NoBacktrace e -> String)
-> ([NoBacktrace e] -> ShowS)
-> Show (NoBacktrace e)
forall e. Show e => Int -> NoBacktrace e -> ShowS
forall e. Show e => [NoBacktrace e] -> ShowS
forall e. Show e => NoBacktrace e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> NoBacktrace e -> ShowS
showsPrec :: Int -> NoBacktrace e -> ShowS
$cshow :: forall e. Show e => NoBacktrace e -> String
show :: NoBacktrace e -> String
$cshowList :: forall e. Show e => [NoBacktrace e] -> ShowS
showList :: [NoBacktrace e] -> ShowS
Show)

instance Exception e => Exception (NoBacktrace e) where
    fromException :: SomeException -> Maybe (NoBacktrace e)
fromException = (e -> NoBacktrace e) -> Maybe e -> Maybe (NoBacktrace e)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> NoBacktrace e
forall e. e -> NoBacktrace e
NoBacktrace (Maybe e -> Maybe (NoBacktrace e))
-> (SomeException -> Maybe e)
-> SomeException
-> Maybe (NoBacktrace e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException
    toException :: NoBacktrace e -> SomeException
toException (NoBacktrace e
e) = e -> SomeException
forall e. Exception e => e -> SomeException
toException e
e
    backtraceDesired :: NoBacktrace e -> Bool
backtraceDesired NoBacktrace e
_ = Bool
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 :: Int -> ExceptionWithContext a -> ShowS
showsPrec Int
_ (ExceptionWithContext ExceptionContext
_ a
e) = String -> ShowS
showString String
"ExceptionWithContext _ " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
e

instance Exception a => Exception (ExceptionWithContext a) where
    toException :: ExceptionWithContext a -> SomeException
toException (ExceptionWithContext ExceptionContext
ctxt a
e) =
        a -> SomeException
forall e. (Exception e, HasExceptionContext) => e -> SomeException
SomeException a
e
      where ?exceptionContext = HasExceptionContext
ExceptionContext
ctxt
    fromException :: SomeException -> Maybe (ExceptionWithContext a)
fromException SomeException
se = do
        e <- SomeException -> Maybe a
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se
        return (ExceptionWithContext (someExceptionContext se) e)
    backtraceDesired :: ExceptionWithContext a -> Bool
backtraceDesired (ExceptionWithContext ExceptionContext
_ a
e) = a -> Bool
forall e. Exception e => e -> Bool
backtraceDesired a
e
    displayException :: ExceptionWithContext a -> String
displayException = SomeException -> String
forall e. Exception e => e -> String
displayException (SomeException -> String)
-> (ExceptionWithContext a -> SomeException)
-> ExceptionWithContext a
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptionWithContext a -> SomeException
forall e. Exception e => e -> SomeException
toException

-- |Arithmetic exceptions.
data ArithException
  = Overflow
  | Underflow
  | LossOfPrecision
  | DivideByZero
  | Denormal
  | RatioZeroDenominator -- ^ @since base-4.6.0.0
  deriving ( ArithException -> ArithException -> Bool
(ArithException -> ArithException -> Bool)
-> (ArithException -> ArithException -> Bool) -> Eq ArithException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArithException -> ArithException -> Bool
== :: ArithException -> ArithException -> Bool
$c/= :: ArithException -> ArithException -> Bool
/= :: ArithException -> ArithException -> Bool
Eq  -- ^ @since base-3.0
           , Eq ArithException
Eq ArithException =>
(ArithException -> ArithException -> Ordering)
-> (ArithException -> ArithException -> Bool)
-> (ArithException -> ArithException -> Bool)
-> (ArithException -> ArithException -> Bool)
-> (ArithException -> ArithException -> Bool)
-> (ArithException -> ArithException -> ArithException)
-> (ArithException -> ArithException -> ArithException)
-> Ord ArithException
ArithException -> ArithException -> Bool
ArithException -> ArithException -> Ordering
ArithException -> ArithException -> ArithException
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ArithException -> ArithException -> Ordering
compare :: ArithException -> ArithException -> Ordering
$c< :: ArithException -> ArithException -> Bool
< :: ArithException -> ArithException -> Bool
$c<= :: ArithException -> ArithException -> Bool
<= :: ArithException -> ArithException -> Bool
$c> :: ArithException -> ArithException -> Bool
> :: ArithException -> ArithException -> Bool
$c>= :: ArithException -> ArithException -> Bool
>= :: ArithException -> ArithException -> Bool
$cmax :: ArithException -> ArithException -> ArithException
max :: ArithException -> ArithException -> ArithException
$cmin :: ArithException -> ArithException -> ArithException
min :: ArithException -> ArithException -> ArithException
Ord -- ^ @since base-3.0
           )

divZeroException, overflowException, ratioZeroDenomException, underflowException  :: SomeException
divZeroException :: SomeException
divZeroException        = ArithException -> SomeException
forall e. Exception e => e -> SomeException
toException ArithException
DivideByZero
overflowException :: SomeException
overflowException       = ArithException -> SomeException
forall e. Exception e => e -> SomeException
toException ArithException
Overflow
ratioZeroDenomException :: SomeException
ratioZeroDenomException = ArithException -> SomeException
forall e. Exception e => e -> SomeException
toException ArithException
RatioZeroDenominator
underflowException :: SomeException
underflowException      = ArithException -> SomeException
forall e. Exception e => e -> SomeException
toException ArithException
Underflow

-- | @since base-4.0.0.0
instance Exception ArithException

-- | @since base-4.0.0.0
instance Show ArithException where
  showsPrec :: Int -> ArithException -> ShowS
showsPrec Int
_ ArithException
Overflow        = String -> ShowS
showString String
"arithmetic overflow"
  showsPrec Int
_ ArithException
Underflow       = String -> ShowS
showString String
"arithmetic underflow"
  showsPrec Int
_ ArithException
LossOfPrecision = String -> ShowS
showString String
"loss of precision"
  showsPrec Int
_ ArithException
DivideByZero    = String -> ShowS
showString String
"divide by zero"
  showsPrec Int
_ ArithException
Denormal        = String -> ShowS
showString String
"denormal"
  showsPrec Int
_ ArithException
RatioZeroDenominator = String -> ShowS
showString String
"Ratio has zero denominator"