{-# 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.-------------------------------------------------------------------------------moduleGHC.Internal.Exception.Context (-- * Exception contextExceptionContext (..),emptyExceptionContext ,addExceptionAnnotation ,getExceptionAnnotations ,getAllExceptionAnnotations ,mergeExceptionContext ,displayExceptionContext -- * Exception annotations,SomeExceptionAnnotation (..),ExceptionAnnotation (..))whereimportGHC.Internal.Data.OldList (intersperse )importGHC.Internal.Base (($) ,map ,(++) ,return ,String ,Maybe (..),Semigroup (..),Monoid (..))importGHC.Internal.Show (Show (..))importGHC.Internal.Data.Typeable.Internal (Typeable ,typeRep ,eqTypeRep )importGHC.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'.dataExceptionContext =ExceptionContext [SomeExceptionAnnotation ]instanceSemigroup ExceptionContext where<> :: ExceptionContext -> ExceptionContext -> ExceptionContext
(<>) =ExceptionContext -> ExceptionContext -> ExceptionContext
mergeExceptionContext instanceMonoid ExceptionContext wheremempty :: ExceptionContext
mempty =ExceptionContext
emptyExceptionContext -- | An 'ExceptionContext' containing no annotations.---- @since base-4.20.0.0emptyExceptionContext ::ExceptionContext emptyExceptionContext :: ExceptionContext
emptyExceptionContext =[SomeExceptionAnnotation] -> ExceptionContext
ExceptionContext []-- | Construct a singleton 'ExceptionContext' from an 'ExceptionAnnotation'.---- @since base-4.20.0.0addExceptionAnnotation ::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.0getExceptionAnnotations ::foralla .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.0mergeExceptionContext ::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.0displayExceptionContext ::ExceptionContext ->String displayExceptionContext :: ExceptionContext -> String
displayExceptionContext (ExceptionContext [SomeExceptionAnnotation]
anns0 )=[String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"\n"([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (SomeExceptionAnnotation -> String)
-> [SomeExceptionAnnotation] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SomeExceptionAnnotation -> String
go [SomeExceptionAnnotation]
anns0 wherego :: SomeExceptionAnnotation -> String
go (SomeExceptionAnnotation a
ann )=a -> String
forall a. ExceptionAnnotation a => a -> String
displayExceptionAnnotation a
ann dataSomeExceptionAnnotation =foralla .ExceptionAnnotation a =>SomeExceptionAnnotation a -- | 'ExceptionAnnotation's are types which can decorate exceptions as-- 'ExceptionContext'.---- @since base-4.20.0.0class(Typeable a )=>ExceptionAnnotation a where-- | Render the annotation for display to the user.displayExceptionAnnotation ::a ->String defaultdisplayExceptionAnnotation ::Show a =>a ->String displayExceptionAnnotation =a -> String
forall a. Show a => a -> String
show