{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Network.Bugsnag.StackFrame
( BugsnagCode(..)
, attachBugsnagCode
, BugsnagStackFrame(..)
, bugsnagStackFrame
, currentStackFrame
) where
import Data.Aeson
import Data.Aeson.Ext
import Data.Text (Text)
import GHC.Generics
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax
import Network.Bugsnag.CodeIndex
import Numeric.Natural (Natural)
newtype BugsnagCode = BugsnagCode [(Natural, Text)]
deriving (Show, ToJSON)
attachBugsnagCode :: CodeIndex -> BugsnagStackFrame -> BugsnagStackFrame
attachBugsnagCode index sf =
sf { bsfCode = findBugsnagCode (bsfFile sf) (bsfLineNumber sf) index }
findBugsnagCode :: FilePath -> Natural -> CodeIndex -> Maybe BugsnagCode
findBugsnagCode path n = fmap BugsnagCode . findSourceRange path (begin, n + 3)
where
begin
| n < 3 = 0
| otherwise = n - 3
data BugsnagStackFrame = BugsnagStackFrame
{ bsfFile :: FilePath
, bsfLineNumber :: Natural
, bsfColumnNumber :: Maybe Natural
, bsfMethod :: Text
, bsfInProject :: Maybe Bool
, bsfCode :: Maybe BugsnagCode
}
deriving (Generic, Show)
instance ToJSON BugsnagStackFrame where
toJSON = genericToJSON $ bsAesonOptions "bsf"
toEncoding = genericToEncoding $ bsAesonOptions "bsf"
bugsnagStackFrame :: FilePath -> Natural -> Text -> BugsnagStackFrame
bugsnagStackFrame path ln method = BugsnagStackFrame
{ bsfFile = path
, bsfLineNumber = ln
, bsfColumnNumber = Nothing
, bsfMethod = method
, bsfInProject = Nothing
, bsfCode = Nothing
}
currentStackFrame :: Q Exp
currentStackFrame = [|locStackFrame $(qLocation >>= liftLoc)|]
locStackFrame :: Loc -> Text -> BugsnagStackFrame
locStackFrame (Loc path _ _ (ls, cs) _) func =
BugsnagStackFrame
{ bsfFile = path
, bsfLineNumber = fromIntegral ls
, bsfColumnNumber = Just $ fromIntegral cs
, bsfMethod = func
, bsfInProject = Just True
, bsfCode = Nothing
}
liftLoc :: Loc -> Q Exp
liftLoc (Loc a b c (d1, d2) (e1, e2)) = [|Loc
$(lift a)
$(lift b)
$(lift c)
($(lift d1), $(lift d2))
($(lift e1), $(lift e2))
|]