    {-# LANGUAGE NoImplicitPrelude #-}
    {-# LANGUAGE DefaultSignatures #-}
    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeApplications #-}
    {-# LANGUAGE GADTs #-}
    {-# OPTIONS_HADDOCK not-home #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  GHC.Internal.Exception.Context
    -- 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)
    --
    -- Exception context type.
    --
    -----------------------------------------------------------------------------

    module GHC.Internal.Exception.Context
        ( -- * Exception context
          ExceptionContext(..)
        , emptyExceptionContext
        , addExceptionAnnotation
        , getExceptionAnnotations
        , getAllExceptionAnnotations
        , mergeExceptionContext
        , displayExceptionContext
          -- * Exception annotations
        , SomeExceptionAnnotation(..)
        , ExceptionAnnotation(..)
        ) where

    import GHC.Internal.Base ((++), return, String, Maybe(..), Semigroup(..), Monoid(..))
    import GHC.Internal.Show (Show(..))
    import GHC.Internal.Data.Typeable.Internal (Typeable, typeRep, eqTypeRep)
    import GHC.Internal.Data.Type.Equality ( (:~~:)(HRefl) )

    -- | Exception context represents a list of 'ExceptionAnnotation's. These are
    -- attached to 'SomeException's via 'Control.Exception.addExceptionContext' and
    -- can be used to capture various ad-hoc metadata about the exception including
    -- backtraces and application-specific context.
    --
    -- 'ExceptionContext's can be merged via concatenation using the 'Semigroup'
    -- instance or 'mergeExceptionContext'.
    --
    -- Note that GHC will automatically solve implicit constraints of type 'ExceptionContext'
    -- with 'emptyExceptionContext'.
    data ExceptionContext = ExceptionContext [SomeExceptionAnnotation]

    instance Semigroup ExceptionContext where
        <> :: ExceptionContext -> ExceptionContext -> ExceptionContext
    (<>) = ExceptionContext -> ExceptionContext -> ExceptionContext
    mergeExceptionContext

    instance Monoid ExceptionContext where
        mempty :: ExceptionContext
    mempty = ExceptionContext
    emptyExceptionContext

    -- | An 'ExceptionContext' containing no annotations.
    --
    -- @since base-4.20.0.0
    emptyExceptionContext :: ExceptionContext
    emptyExceptionContext :: ExceptionContext
    emptyExceptionContext = [SomeExceptionAnnotation] -> ExceptionContext
    ExceptionContext []

    -- | Construct a singleton 'ExceptionContext' from an 'ExceptionAnnotation'.
    --
    -- @since base-4.20.0.0
    addExceptionAnnotation :: ExceptionAnnotation a => a -> ExceptionContext -> ExceptionContext
    addExceptionAnnotation :: forall a.
    ExceptionAnnotation a =>
    a -> ExceptionContext -> ExceptionContext
    addExceptionAnnotation a
    x (ExceptionContext [SomeExceptionAnnotation]
    xs) = [SomeExceptionAnnotation] -> ExceptionContext
    ExceptionContext (a -> SomeExceptionAnnotation
    forall a. ExceptionAnnotation a => a -> SomeExceptionAnnotation
    SomeExceptionAnnotation a
    x SomeExceptionAnnotation
    -> [SomeExceptionAnnotation] -> [SomeExceptionAnnotation]
    forall a. a -> [a] -> [a]
    : [SomeExceptionAnnotation]
    xs)

    -- | Retrieve all 'ExceptionAnnotation's of the given type from an 'ExceptionContext'.
    --
    -- @since base-4.20.0.0
    getExceptionAnnotations :: forall a. ExceptionAnnotation a => ExceptionContext -> [a]
    getExceptionAnnotations :: forall a. ExceptionAnnotation a => ExceptionContext -> [a]
    getExceptionAnnotations (ExceptionContext [SomeExceptionAnnotation]
    xs) =
        [ a
    a
    x
        | SomeExceptionAnnotation (a
    x :: b) <- [SomeExceptionAnnotation]
    xs
        , Just a :~~: a
    HRefl <- Maybe (a :~~: a) -> [Maybe (a :~~: a)]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. Typeable a => TypeRep a
    forall {k} (a :: k). Typeable a => TypeRep a
    typeRep @a TypeRep a -> TypeRep a -> Maybe (a :~~: a)
    forall k1 k2 (a :: k1) (b :: k2).
    TypeRep a -> TypeRep b -> Maybe (a :~~: b)
    `eqTypeRep` forall a. Typeable a => TypeRep a
    forall {k} (a :: k). Typeable a => TypeRep a
    typeRep @b)
        ]

    getAllExceptionAnnotations :: ExceptionContext -> [SomeExceptionAnnotation]
    getAllExceptionAnnotations :: ExceptionContext -> [SomeExceptionAnnotation]
    getAllExceptionAnnotations (ExceptionContext [SomeExceptionAnnotation]
    xs) = [SomeExceptionAnnotation]
    xs

    -- | Merge two 'ExceptionContext's via concatenation
    --
    -- @since base-4.20.0.0
    mergeExceptionContext :: ExceptionContext -> ExceptionContext -> ExceptionContext
    mergeExceptionContext :: ExceptionContext -> ExceptionContext -> ExceptionContext
    mergeExceptionContext (ExceptionContext [SomeExceptionAnnotation]
    a) (ExceptionContext [SomeExceptionAnnotation]
    b) = [SomeExceptionAnnotation] -> ExceptionContext
    ExceptionContext ([SomeExceptionAnnotation]
    a [SomeExceptionAnnotation]
    -> [SomeExceptionAnnotation] -> [SomeExceptionAnnotation]
    forall a. [a] -> [a] -> [a]
    ++ [SomeExceptionAnnotation]
    b)

    -- | Render 'ExceptionContext' to a human-readable 'String'.
    --
    -- @since base-4.20.0.0
    displayExceptionContext :: ExceptionContext -> String
    displayExceptionContext :: ExceptionContext -> String
    displayExceptionContext (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 -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [SomeExceptionAnnotation] -> String
    go [SomeExceptionAnnotation]
    anns
        go [] = String
    "\n"

    data SomeExceptionAnnotation = forall a. ExceptionAnnotation a => SomeExceptionAnnotation a

    -- | 'ExceptionAnnotation's are types which can decorate exceptions as
    -- 'ExceptionContext'.
    --
    -- @since base-4.20.0.0
    class (Typeable a) => ExceptionAnnotation a where
        -- | Render the annotation for display to the user.
        displayExceptionAnnotation :: a -> String

        default displayExceptionAnnotation :: Show a => a -> String
        displayExceptionAnnotation = a -> String
    forall a. Show a => a -> String
    show