{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Network.Bugsnag.StackFrame
( BugsnagCode(..)
, attachBugsnagCode
, BugsnagStackFrame(..)
, bugsnagStackFrame
, currentStackFrame
)
where
import Prelude
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 newtype (Int -> BugsnagCode -> ShowS
[BugsnagCode] -> ShowS
BugsnagCode -> String
(Int -> BugsnagCode -> ShowS)
-> (BugsnagCode -> String)
-> ([BugsnagCode] -> ShowS)
-> Show BugsnagCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BugsnagCode] -> ShowS
$cshowList :: [BugsnagCode] -> ShowS
show :: BugsnagCode -> String
$cshow :: BugsnagCode -> String
showsPrec :: Int -> BugsnagCode -> ShowS
$cshowsPrec :: Int -> BugsnagCode -> ShowS
Show, [BugsnagCode] -> Encoding
[BugsnagCode] -> Value
BugsnagCode -> Encoding
BugsnagCode -> Value
(BugsnagCode -> Value)
-> (BugsnagCode -> Encoding)
-> ([BugsnagCode] -> Value)
-> ([BugsnagCode] -> Encoding)
-> ToJSON BugsnagCode
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [BugsnagCode] -> Encoding
$ctoEncodingList :: [BugsnagCode] -> Encoding
toJSONList :: [BugsnagCode] -> Value
$ctoJSONList :: [BugsnagCode] -> Value
toEncoding :: BugsnagCode -> Encoding
$ctoEncoding :: BugsnagCode -> Encoding
toJSON :: BugsnagCode -> Value
$ctoJSON :: BugsnagCode -> Value
ToJSON)
attachBugsnagCode :: CodeIndex -> BugsnagStackFrame -> BugsnagStackFrame
attachBugsnagCode :: CodeIndex -> BugsnagStackFrame -> BugsnagStackFrame
attachBugsnagCode CodeIndex
index BugsnagStackFrame
sf =
BugsnagStackFrame
sf { bsfCode :: Maybe BugsnagCode
bsfCode = String -> Natural -> CodeIndex -> Maybe BugsnagCode
findBugsnagCode (BugsnagStackFrame -> String
bsfFile BugsnagStackFrame
sf) (BugsnagStackFrame -> Natural
bsfLineNumber BugsnagStackFrame
sf) CodeIndex
index }
findBugsnagCode :: FilePath -> Natural -> CodeIndex -> Maybe BugsnagCode
findBugsnagCode :: String -> Natural -> CodeIndex -> Maybe BugsnagCode
findBugsnagCode String
path Natural
n = ([(Natural, Text)] -> BugsnagCode)
-> Maybe [(Natural, Text)] -> Maybe BugsnagCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Natural, Text)] -> BugsnagCode
BugsnagCode (Maybe [(Natural, Text)] -> Maybe BugsnagCode)
-> (CodeIndex -> Maybe [(Natural, Text)])
-> CodeIndex
-> Maybe BugsnagCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> (Natural, Natural) -> CodeIndex -> Maybe [(Natural, Text)]
findSourceRange String
path (Natural
begin, Natural
n Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
3)
where
begin :: Natural
begin
| Natural
n Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
3 = Natural
0
| Bool
otherwise = Natural
n Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
3
data BugsnagStackFrame = BugsnagStackFrame
{ BugsnagStackFrame -> String
bsfFile :: FilePath
, BugsnagStackFrame -> Natural
bsfLineNumber :: Natural
, BugsnagStackFrame -> Maybe Natural
bsfColumnNumber :: Maybe Natural
, BugsnagStackFrame -> Text
bsfMethod :: Text
, BugsnagStackFrame -> Maybe Bool
bsfInProject :: Maybe Bool
, BugsnagStackFrame -> Maybe BugsnagCode
bsfCode :: Maybe BugsnagCode
}
deriving stock ((forall x. BugsnagStackFrame -> Rep BugsnagStackFrame x)
-> (forall x. Rep BugsnagStackFrame x -> BugsnagStackFrame)
-> Generic BugsnagStackFrame
forall x. Rep BugsnagStackFrame x -> BugsnagStackFrame
forall x. BugsnagStackFrame -> Rep BugsnagStackFrame x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BugsnagStackFrame x -> BugsnagStackFrame
$cfrom :: forall x. BugsnagStackFrame -> Rep BugsnagStackFrame x
Generic, Int -> BugsnagStackFrame -> ShowS
[BugsnagStackFrame] -> ShowS
BugsnagStackFrame -> String
(Int -> BugsnagStackFrame -> ShowS)
-> (BugsnagStackFrame -> String)
-> ([BugsnagStackFrame] -> ShowS)
-> Show BugsnagStackFrame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BugsnagStackFrame] -> ShowS
$cshowList :: [BugsnagStackFrame] -> ShowS
show :: BugsnagStackFrame -> String
$cshow :: BugsnagStackFrame -> String
showsPrec :: Int -> BugsnagStackFrame -> ShowS
$cshowsPrec :: Int -> BugsnagStackFrame -> ShowS
Show)
instance ToJSON BugsnagStackFrame where
toJSON :: BugsnagStackFrame -> Value
toJSON = Options -> BugsnagStackFrame -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> BugsnagStackFrame -> Value)
-> Options -> BugsnagStackFrame -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
bsAesonOptions String
"bsf"
toEncoding :: BugsnagStackFrame -> Encoding
toEncoding = Options -> BugsnagStackFrame -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> BugsnagStackFrame -> Encoding)
-> Options -> BugsnagStackFrame -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
bsAesonOptions String
"bsf"
bugsnagStackFrame :: FilePath -> Natural -> Text -> BugsnagStackFrame
bugsnagStackFrame :: String -> Natural -> Text -> BugsnagStackFrame
bugsnagStackFrame String
path Natural
ln Text
method = BugsnagStackFrame :: String
-> Natural
-> Maybe Natural
-> Text
-> Maybe Bool
-> Maybe BugsnagCode
-> BugsnagStackFrame
BugsnagStackFrame
{ bsfFile :: String
bsfFile = String
path
, bsfLineNumber :: Natural
bsfLineNumber = Natural
ln
, bsfColumnNumber :: Maybe Natural
bsfColumnNumber = Maybe Natural
forall a. Maybe a
Nothing
, bsfMethod :: Text
bsfMethod = Text
method
, bsfInProject :: Maybe Bool
bsfInProject = Maybe Bool
forall a. Maybe a
Nothing
, bsfCode :: Maybe BugsnagCode
bsfCode = Maybe BugsnagCode
forall a. Maybe a
Nothing
}
currentStackFrame :: Q Exp
currentStackFrame :: Q Exp
currentStackFrame = [|locStackFrame $(qLocation >>= liftLoc)|]
locStackFrame :: Loc -> Text -> BugsnagStackFrame
locStackFrame :: Loc -> Text -> BugsnagStackFrame
locStackFrame (Loc String
path String
_ String
_ (Int
ls, Int
cs) (Int, Int)
_) Text
func =
BugsnagStackFrame :: String
-> Natural
-> Maybe Natural
-> Text
-> Maybe Bool
-> Maybe BugsnagCode
-> BugsnagStackFrame
BugsnagStackFrame
{ bsfFile :: String
bsfFile = String
path
, bsfLineNumber :: Natural
bsfLineNumber = Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ls
, bsfColumnNumber :: Maybe Natural
bsfColumnNumber = Natural -> Maybe Natural
forall a. a -> Maybe a
Just (Natural -> Maybe Natural) -> Natural -> Maybe Natural
forall a b. (a -> b) -> a -> b
$ Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cs
, bsfMethod :: Text
bsfMethod = Text
func
, bsfInProject :: Maybe Bool
bsfInProject = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
, bsfCode :: Maybe BugsnagCode
bsfCode = Maybe BugsnagCode
forall a. Maybe a
Nothing
}
liftLoc :: Loc -> Q Exp
liftLoc :: Loc -> Q Exp
liftLoc (Loc String
a String
b String
c (Int
d1, Int
d2) (Int
e1, Int
e2)) = [|Loc
$(lift a)
$(lift b)
$(lift c)
($(lift d1), $(lift d2))
($(lift e1), $(lift e2))
|]