{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE GADTs #-}
{-# OPTIONS_HADDOCK not-home #-}
module GHC.Internal.Exception.Context
(
ExceptionContext(..)
, emptyExceptionContext
, addExceptionAnnotation
, getExceptionAnnotations
, getAllExceptionAnnotations
, mergeExceptionContext
, displayExceptionContext
, 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) )
data ExceptionContext = ExceptionContext [SomeExceptionAnnotation]
instance Semigroup ExceptionContext where
<> :: ExceptionContext -> ExceptionContext -> ExceptionContext
(<>) = ExceptionContext -> ExceptionContext -> ExceptionContext
mergeExceptionContext
instance Monoid ExceptionContext where
mempty :: ExceptionContext
mempty = ExceptionContext
emptyExceptionContext
emptyExceptionContext :: ExceptionContext
emptyExceptionContext :: ExceptionContext
emptyExceptionContext = [SomeExceptionAnnotation] -> ExceptionContext
ExceptionContext []
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)
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
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)
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
class (Typeable a) => ExceptionAnnotation a where
displayExceptionAnnotation :: a -> String
default displayExceptionAnnotation :: Show a => a -> String
displayExceptionAnnotation = a -> String
forall a. Show a => a -> String
show