{-# 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 first @String@ is the -- argument given to 'error', second @String@ is the location. 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"