    {-# 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.
    --
    -----------------------------------------------------------------------------

    module GHC.Exception
           ( module GHC.Exception.Type
           , throw
           , ErrorCall(..,ErrorCall)
           , errorCallException
           , errorCallWithCallStackException
             -- re-export CallStack and SrcLoc from GHC.Types
           , CallStack, fromCallSiteList, getCallStack, prettyCallStack
           , prettyCallStackLines, showCCSStack
           , SrcLoc(..), prettySrcLoc
           ) where

    import GHC.Base
    import GHC.Show
    import GHC.Stack.Types
    import GHC.OldList
    import GHC.Prim
    import GHC.IO.Unsafe
    import {-# SOURCE #-} GHC.Stack.CCS
    import GHC.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 :: TYPE r). forall e.
             Exception e => e -> a
    throw :: forall a e. Exception e => e -> a
    throw 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.
    data ErrorCall = ErrorCallWithLocation String String
        deriving ( ErrorCall -> ErrorCall -> Bool
    (ErrorCall -> ErrorCall -> Bool)
    -> (ErrorCall -> ErrorCall -> Bool) -> Eq ErrorCall
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: ErrorCall -> ErrorCall -> Bool
    $c/= :: ErrorCall -> ErrorCall -> Bool
    == :: ErrorCall -> ErrorCall -> Bool
    $c== :: ErrorCall -> ErrorCall -> Bool
    Eq  -- ^ @since 4.7.0.0
                 , Eq ErrorCall
    Eq ErrorCall
    -> (ErrorCall -> ErrorCall -> Ordering)
    -> (ErrorCall -> ErrorCall -> Bool)
    -> (ErrorCall -> ErrorCall -> Bool)
    -> (ErrorCall -> ErrorCall -> Bool)
    -> (ErrorCall -> ErrorCall -> Bool)
    -> (ErrorCall -> ErrorCall -> ErrorCall)
    -> (ErrorCall -> ErrorCall -> ErrorCall)
    -> Ord ErrorCall
    ErrorCall -> ErrorCall -> Bool
    ErrorCall -> ErrorCall -> Ordering
    ErrorCall -> ErrorCall -> ErrorCall
    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
    min :: ErrorCall -> ErrorCall -> ErrorCall
    $cmin :: ErrorCall -> ErrorCall -> ErrorCall
    max :: ErrorCall -> ErrorCall -> ErrorCall
    $cmax :: ErrorCall -> ErrorCall -> ErrorCall
    >= :: ErrorCall -> ErrorCall -> Bool
    $c>= :: ErrorCall -> ErrorCall -> Bool
    > :: ErrorCall -> ErrorCall -> Bool
    $c> :: ErrorCall -> ErrorCall -> Bool
    <= :: ErrorCall -> ErrorCall -> Bool
    $c<= :: ErrorCall -> ErrorCall -> Bool
    < :: ErrorCall -> ErrorCall -> Bool
    $c< :: ErrorCall -> ErrorCall -> Bool
    compare :: ErrorCall -> ErrorCall -> Ordering
    $ccompare :: ErrorCall -> ErrorCall -> Ordering
    Ord -- ^ @since 4.7.0.0
                 )

    pattern ErrorCall :: String -> ErrorCall
    pattern $mErrorCall :: forall {r}. ErrorCall -> (String -> r) -> ((# #) -> r) -> r
    $bErrorCall :: String -> ErrorCall
    ErrorCall err <- ErrorCallWithLocation err _ where
      ErrorCall String
    err = String -> String -> ErrorCall
    ErrorCallWithLocation String
    err String
    ""

    {-# COMPLETE ErrorCall #-}

    -- | @since 4.0.0.0
    instance Exception ErrorCall

    -- | @since 4.0.0.0
    instance Show ErrorCall where
      showsPrec :: Int -> ErrorCall -> ShowS
    showsPrec Int
    _ (ErrorCallWithLocation String
    err String
    "") = String -> ShowS
    showString String
    err
      showsPrec Int
    _ (ErrorCallWithLocation String
    err String
    loc) =
          String -> ShowS
    showString String
    err ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    showChar Char
    '\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 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 String
    s 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
      let
        implicitParamCallStack :: [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 String
    "\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 [String]
    stk = String
    "CallStack (from -prof):" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    "  " 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.0
    prettySrcLoc :: SrcLoc -> String
    prettySrcLoc :: SrcLoc -> String
    prettySrcLoc SrcLoc {Int
    String
    srcLocStartLine :: SrcLoc -> Int
    srcLocStartCol :: SrcLoc -> Int
    srcLocPackage :: SrcLoc -> String
    srcLocModule :: SrcLoc -> String
    srcLocFile :: SrcLoc -> String
    srcLocEndLine :: SrcLoc -> Int
    srcLocEndCol :: SrcLoc -> Int
    srcLocEndCol :: Int
    srcLocEndLine :: Int
    srcLocStartCol :: Int
    srcLocStartLine :: Int
    srcLocFile :: String
    srcLocModule :: String
    srcLocPackage :: String
    ..}
      = (String -> ShowS) -> String -> [String] -> String
    forall a b. (a -> b -> b) -> b -> [a] -> b
    foldr String -> ShowS
    forall a. [a] -> [a] -> [a]
    (++) String
    ""
          [ String
    srcLocFile, String
    ":"
          , Int -> String
    forall a. Show a => a -> String
    show Int
    srcLocStartLine, String
    ":"
          , Int -> String
    forall a. Show a => a -> String
    show Int
    srcLocStartCol, String
    " in "
          , String
    srcLocPackage, String
    ":", String
    srcLocModule
          ]

    -- | Pretty print a 'CallStack'.
    --
    -- @since 4.9.0.0
    prettyCallStack :: CallStack -> String
    prettyCallStack :: CallStack -> String
    prettyCallStack = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\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 CallStack
    cs = case CallStack -> [(String, SrcLoc)]
    getCallStack CallStack
    cs of
      []  -> []
      [(String, SrcLoc)]
    stk -> String
    "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
    "  " 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
      where
        prettyCallSite :: (String, SrcLoc) -> String
    prettyCallSite (String
    f, SrcLoc
    loc) = String
    f String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ", called at " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ SrcLoc -> String
    prettySrcLoc SrcLoc
    loc