module GHC.Stack.Annotation.Types where

import GHC.Stack.Annotation.Compat.Class (StackAnnotation(..))
import GHC.Stack

-- | A 'String' only annotation with an optional source location.
data StringAnnotation where
  StringAnnotation :: !(Maybe SrcLoc) -> String -> StringAnnotation

instance StackAnnotation StringAnnotation where
  displayStackAnnotationShort :: StringAnnotation -> String
displayStackAnnotationShort (StringAnnotation Maybe SrcLoc
_srcLoc String
str) =
    String
str

  stackAnnotationSourceLocation :: StringAnnotation -> Maybe SrcLoc
stackAnnotationSourceLocation (StringAnnotation Maybe SrcLoc
srcLoc String
_str) =
    Maybe SrcLoc
srcLoc

-- | Use the 'Show' instance of a type to display as the 'StackAnnotation'.
data ShowAnnotation where
  ShowAnnotation :: forall a . Show a => !(Maybe SrcLoc) -> a -> ShowAnnotation

instance StackAnnotation ShowAnnotation where
  displayStackAnnotationShort :: ShowAnnotation -> String
displayStackAnnotationShort (ShowAnnotation Maybe SrcLoc
_srcLoc a
showAnno) =
    a -> String
forall a. Show a => a -> String
show a
showAnno

  stackAnnotationSourceLocation :: ShowAnnotation -> Maybe SrcLoc
stackAnnotationSourceLocation (ShowAnnotation Maybe SrcLoc
srcLoc a
_showAnno) =
    Maybe SrcLoc
srcLoc

-- | A 'CallStack' stack annotation.
--
-- Captures the whole 'CallStack'.
newtype CallStackAnnotation = CallStackAnnotation CallStack

instance Show CallStackAnnotation where
  show :: CallStackAnnotation -> String
show (CallStackAnnotation CallStack
cs) = CallStack -> String
prettyCallStack CallStack
cs

-- | Displays the first entry of the 'CallStack'
instance StackAnnotation CallStackAnnotation where
  stackAnnotationSourceLocation :: CallStackAnnotation -> Maybe SrcLoc
stackAnnotationSourceLocation (CallStackAnnotation CallStack
cs) =
    CallStack -> Maybe SrcLoc
callStackHeadSrcLoc CallStack
cs

  displayStackAnnotationShort :: CallStackAnnotation -> String
displayStackAnnotationShort (CallStackAnnotation CallStack
cs) =
    CallStack -> String
callStackHeadFunctionName CallStack
cs

callStackHeadSrcLoc :: CallStack -> Maybe SrcLoc
callStackHeadSrcLoc :: CallStack -> Maybe SrcLoc
callStackHeadSrcLoc CallStack
cs =
  case CallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs of
    [] -> Maybe SrcLoc
forall a. Maybe a
Nothing
    (String
_, SrcLoc
srcLoc):[(String, SrcLoc)]
_ -> SrcLoc -> Maybe SrcLoc
forall a. a -> Maybe a
Just SrcLoc
srcLoc

callStackHeadFunctionName :: CallStack -> String
callStackHeadFunctionName :: CallStack -> String
callStackHeadFunctionName CallStack
cs =
  case CallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs of
    [] -> String
"<unknown source location>"
    (String
fnName, SrcLoc
_):[(String, SrcLoc)]
_ -> String
fnName