module Freckle.App.Bugsnag.CallStack
  ( callStackBeforeNotify
  , attachCallStack
  , callStackToStackFrames
  , callSiteToStackFrame

    -- * Re-exports
  , CallStack
  , SrcLoc
  , StackFrame
  ) where

import Freckle.App.Prelude

import Control.Exception.Annotated (annotatedExceptionCallStack)
import Data.Bugsnag (Exception (..), StackFrame (..), defaultStackFrame)
import qualified Data.Text as T
import Freckle.App.Exception.Types (AnnotatedException)
import GHC.Stack (CallStack, SrcLoc (..), getCallStack)
import Network.Bugsnag (BeforeNotify, updateExceptions)
import Network.Bugsnag.BeforeNotify (updateEventFromOriginalException)

-- | Copy the call stack from an AnnotatedException
callStackBeforeNotify :: BeforeNotify
callStackBeforeNotify :: BeforeNotify
callStackBeforeNotify =
  forall e. Exception e => (e -> BeforeNotify) -> BeforeNotify
updateEventFromOriginalException @(AnnotatedException SomeException) forall a b. (a -> b) -> a -> b
$ \AnnotatedException SomeException
e ->
    forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap CallStack -> BeforeNotify
attachCallStack forall a b. (a -> b) -> a -> b
$ forall exception. AnnotatedException exception -> Maybe CallStack
annotatedExceptionCallStack AnnotatedException SomeException
e

attachCallStack :: CallStack -> BeforeNotify
attachCallStack :: CallStack -> BeforeNotify
attachCallStack CallStack
cs =
  (Exception -> Exception) -> BeforeNotify
updateExceptions forall a b. (a -> b) -> a -> b
$ \Exception
ex ->
    Exception
ex {exception_stacktrace :: [StackFrame]
exception_stacktrace = CallStack -> [StackFrame]
callStackToStackFrames CallStack
cs}

-- | Converts a GHC call stack to a list of stack frames suitable
--   for use as the stacktrace in a Bugsnag exception
callStackToStackFrames :: CallStack -> [StackFrame]
callStackToStackFrames :: CallStack -> [StackFrame]
callStackToStackFrames = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, SrcLoc) -> StackFrame
callSiteToStackFrame forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack -> [(String, SrcLoc)]
getCallStack

callSiteToStackFrame :: (String, SrcLoc) -> StackFrame
callSiteToStackFrame :: (String, SrcLoc) -> StackFrame
callSiteToStackFrame (String
str, SrcLoc
loc) =
  StackFrame
defaultStackFrame
    { stackFrame_method :: Text
stackFrame_method = String -> Text
T.pack String
str
    , stackFrame_file :: Text
stackFrame_file = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ SrcLoc -> String
srcLocFile SrcLoc
loc
    , stackFrame_lineNumber :: Int
stackFrame_lineNumber = SrcLoc -> Int
srcLocStartLine SrcLoc
loc
    , stackFrame_columnNumber :: Maybe Int
stackFrame_columnNumber = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SrcLoc -> Int
srcLocStartCol SrcLoc
loc
    }