GHC/Exception.hs

    {-# LANGUAGE Trustworthy #-}
    {-# LANGUAGE NoImplicitPrelude
               , ExistentialQuantification
               , MagicHash
               , RecordWildCards
               , PatternSynonyms
      #-}
    {-# OPTIONS_HADDOCK hide #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  GHC.Exception
    -- Copyright   :  (c) The University of Glasgow, 1998-2002
    -- License     :  see libraries/base/LICENSE
    --
    -- Maintainer  :  cvs-ghc@haskell.org
    -- Stability   :  internal
    -- Portability :  non-portable (GHC extensions)
    --
    -- Exceptions and exception-handling functions.
    --
    -----------------------------------------------------------------------------

    module GHC.Exception
           ( Exception(..)    -- Class
           , throw
           , SomeException(..), ErrorCall(..,ErrorCall), ArithException(..)
           , divZeroException, overflowException, ratioZeroDenomException
           , underflowException
           , errorCallException, errorCallWithCallStackException
             -- re-export CallStack and SrcLoc from GHC.Types
           , CallStack, fromCallSiteList, getCallStack, prettyCallStack
           , prettyCallStackLines, showCCSStack
           , SrcLoc(..), prettySrcLoc
           ) where

    import Data.Maybe
    import Data.Typeable (Typeable, cast)
       -- loop: Data.Typeable -> GHC.Err -> GHC.Exception
    import GHC.Base
    import GHC.Show
    import GHC.Stack.Types
    import GHC.OldList
    import GHC.IO.Unsafe
    import {-# SOURCE #-} GHC.Stack.CCS

    {- |
    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 => 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   :: e -> SomeException
        fromException :: SomeException -> Maybe e

        toException = SomeException
        fromException (SomeException e) = cast e

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

    -- | @since 3.0
    instance Exception SomeException where
        toException se = se
        fromException = Just
        displayException (SomeException e) = displayException e

    -- | Throw an exception.  Exceptions may be thrown from purely
    -- functional code, but may only be caught within the 'IO' monad.
    throw :: Exception e => e -> a
    throw e = raise# (toException e)

    -- |This is thrown when the user calls 'error'. The @String@ is the
    -- argument given to 'error'.
    data ErrorCall = ErrorCallWithLocation String String
        deriving (Eq, Ord)

    pattern ErrorCall :: String -> ErrorCall
    pattern ErrorCall err <- ErrorCallWithLocation err _ where
      ErrorCall err = ErrorCallWithLocation err ""

    {-# COMPLETE ErrorCall #-}

    -- | @since 4.0.0.0
    instance Exception ErrorCall

    -- | @since 4.0.0.0
    instance Show ErrorCall where
      showsPrec _ (ErrorCallWithLocation err "") = showString err
      showsPrec _ (ErrorCallWithLocation err loc) = showString (err ++ '\n' : loc)

    errorCallException :: String -> SomeException
    errorCallException s = toException (ErrorCall s)

    errorCallWithCallStackException :: String -> CallStack -> SomeException
    errorCallWithCallStackException s stk = unsafeDupablePerformIO $ do
      ccsStack <- currentCallStack
      let
        implicitParamCallStack = prettyCallStackLines stk
        ccsCallStack = showCCSStack ccsStack
        stack = intercalate "\n" $ implicitParamCallStack ++ ccsCallStack
      return $ toException (ErrorCallWithLocation s stack)

    showCCSStack :: [String] -> [String]
    showCCSStack [] = []
    showCCSStack stk = "CallStack (from -prof):" : map ("  " ++) (reverse stk)

    -- prettySrcLoc and prettyCallStack are defined here to avoid hs-boot
    -- files. See Note [Definition of CallStack]

    -- | Pretty print a 'SrcLoc'.
    --
    -- @since 4.9.0.0
    prettySrcLoc :: SrcLoc -> String
    prettySrcLoc SrcLoc {..}
      = foldr (++) ""
          [ srcLocFile, ":"
          , show srcLocStartLine, ":"
          , show srcLocStartCol, " in "
          , srcLocPackage, ":", srcLocModule
          ]

    -- | Pretty print a 'CallStack'.
    --
    -- @since 4.9.0.0
    prettyCallStack :: CallStack -> String
    prettyCallStack = intercalate "\n" . prettyCallStackLines

    prettyCallStackLines :: CallStack -> [String]
    prettyCallStackLines cs = case getCallStack cs of
      []  -> []
      stk -> "CallStack (from HasCallStack):"
           : map (("  " ++) . prettyCallSite) stk
      where
        prettyCallSite (f, loc) = f ++ ", called at " ++ prettySrcLoc loc

    -- |Arithmetic exceptions.
    data ArithException
      = Overflow
      | Underflow
      | LossOfPrecision
      | DivideByZero
      | Denormal
      | RatioZeroDenominator -- ^ @since 4.6.0.0
      deriving (Eq, Ord)

    divZeroException, overflowException, ratioZeroDenomException, underflowException  :: SomeException
    divZeroException        = toException DivideByZero
    overflowException       = toException Overflow
    ratioZeroDenomException = toException RatioZeroDenominator
    underflowException      = toException Underflow

    -- | @since 4.0.0.0
    instance Exception ArithException

    -- | @since 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"