{-# LANGUAGE Trustworthy #-}{-# LANGUAGE NoImplicitPrelude
 , ExistentialQuantification
 , MagicHash
 , RecordWildCards
 , PatternSynonyms
 #-}{-# LANGUAGE TypeInType #-}{-# OPTIONS_HADDOCK not-home #-}------------------------------------------------------------------------------- |-- 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.-------------------------------------------------------------------------------moduleGHC.Exception(moduleGHC.Exception.Type ,throw ,ErrorCall (..,ErrorCall ),errorCallException ,errorCallWithCallStackException -- re-export CallStack and SrcLoc from GHC.Types,CallStack ,fromCallSiteList ,getCallStack ,prettyCallStack ,prettyCallStackLines ,showCCSStack ,SrcLoc (..),prettySrcLoc )whereimportGHC.Base importGHC.Show importGHC.Stack.Types importGHC.OldList importGHC.PrimimportGHC.IO.Unsafe import{-# SOURCE#-}GHC.Stack.CCS importGHC.Exception.Type -- | Throw an exception. Exceptions may be thrown from purely-- functional code, but may only be caught within the 'IO' monad.throw ::forall(r ::RuntimeRep).forall(a ::TYPEr ).foralle .Exception e =>e ->a throw :: e -> a
throw e :: e
e =SomeException -> a
forall b a. b -> a
raise#(e -> SomeException
forall e. Exception e => e -> SomeException
toException e
e )-- | This is thrown when the user calls 'error'. The first @String@ is the-- argument given to 'error', second @String@ is the location.dataErrorCall =ErrorCallWithLocation String String deriving(Eq-- ^ @since 4.7.0.0,Ord-- ^ @since 4.7.0.0)patternErrorCall ::String ->ErrorCall pattern$bErrorCall :: String -> ErrorCall
$mErrorCall :: forall r. ErrorCall -> (String -> r) -> (Void# -> r) -> r
ErrorCall err <-ErrorCallWithLocation err _whereErrorCall err :: String
err =String -> String -> ErrorCall
ErrorCallWithLocation String
err ""{-# COMPLETEErrorCall #-}-- | @since 4.0.0.0instanceException ErrorCall -- | @since 4.0.0.0instanceShow ErrorCall whereshowsPrec :: Int -> ErrorCall -> ShowS
showsPrec _(ErrorCallWithLocation err :: String
err "")=String -> ShowS
showString String
err showsPrec _(ErrorCallWithLocation err :: String
err loc :: String
loc )=String -> ShowS
showString String
err ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar '\n'ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
loc errorCallException ::String ->SomeException errorCallException :: String -> SomeException
errorCallException s :: String
s =ErrorCall -> SomeException
forall e. Exception e => e -> SomeException
toException (String -> ErrorCall
ErrorCall String
s )errorCallWithCallStackException ::String ->CallStack ->SomeException errorCallWithCallStackException :: String -> CallStack -> SomeException
errorCallWithCallStackException s :: String
s stk :: CallStack
stk =IO SomeException -> SomeException
forall a. IO a -> a
unsafeDupablePerformIO (IO SomeException -> SomeException)
-> IO SomeException -> SomeException
forall a b. (a -> b) -> a -> b
$ do[String]
ccsStack <-IO [String]
currentCallStack letimplicitParamCallStack :: [String]
implicitParamCallStack =CallStack -> [String]
prettyCallStackLines CallStack
stk ccsCallStack :: [String]
ccsCallStack =[String] -> [String]
showCCSStack [String]
ccsStack stack :: String
stack =String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n"([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
implicitParamCallStack [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ccsCallStack SomeException -> IO SomeException
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> IO SomeException)
-> SomeException -> IO SomeException
forall a b. (a -> b) -> a -> b
$ ErrorCall -> SomeException
forall e. Exception e => e -> SomeException
toException (String -> String -> ErrorCall
ErrorCallWithLocation String
s String
stack )showCCSStack ::[String ]->[String ]showCCSStack :: [String] -> [String]
showCCSStack []=[]showCCSStack stk :: [String]
stk ="CallStack (from -prof):"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (" "String -> ShowS
forall a. [a] -> [a] -> [a]
++ )([String] -> [String]
forall a. [a] -> [a]
reverse [String]
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.0prettySrcLoc ::SrcLoc ->String prettySrcLoc :: SrcLoc -> String
prettySrcLoc SrcLoc {..}=(String -> ShowS) -> String -> [String] -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr String -> ShowS
forall a. [a] -> [a] -> [a]
(++) ""[String
srcLocFile ,":",Int -> String
forall a. Show a => a -> String
show Int
srcLocStartLine ,":",Int -> String
forall a. Show a => a -> String
show Int
srcLocStartCol ," in ",String
srcLocPackage ,":",String
srcLocModule ]-- | Pretty print a 'CallStack'.---- @since 4.9.0.0prettyCallStack ::CallStack ->String prettyCallStack :: CallStack -> String
prettyCallStack =String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n"([String] -> String)
-> (CallStack -> [String]) -> CallStack -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack -> [String]
prettyCallStackLines prettyCallStackLines ::CallStack ->[String ]prettyCallStackLines :: CallStack -> [String]
prettyCallStackLines cs :: CallStack
cs =caseCallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs of[]->[]stk :: [(String, SrcLoc)]
stk ->"CallStack (from HasCallStack):"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:((String, SrcLoc) -> String) -> [(String, SrcLoc)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((" "String -> ShowS
forall a. [a] -> [a] -> [a]
++ )ShowS -> ((String, SrcLoc) -> String) -> (String, SrcLoc) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, SrcLoc) -> String
prettyCallSite )[(String, SrcLoc)]
stk whereprettyCallSite :: (String, SrcLoc) -> String
prettyCallSite (f :: String
f ,loc :: SrcLoc
loc )=String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", called at "String -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcLoc -> String
prettySrcLoc SrcLoc
loc