{-# 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)

-- | Lines of code surrounding the error
--
-- Pairs of @(line-number, line-of-code)@, up to 3 on either side.
--
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)

-- | Attempt to attach a @'BugsnagCode'@ to a @'BugsnagStackFrame'@
--
-- Looks up the content in the Index by File/LineNumber and, if found, sets it
-- on the record.
--
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 -- ^ Function, in our parlance
    , 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
    }

-- | Construct a @'BugsnagStackFrame'@ from the point of this splice
--
-- Unfortunately there's no way to know the function, so that must be given:
--
-- >>> :set -XOverloadedStrings -XTemplateHaskell
-- >>> :m +Control.Arrow
-- >>> (bsfFile &&& bsfMethod) $ $(currentStackFrame) "myFunc"
-- ("<interactive>","myFunc")
--
currentStackFrame :: Q Exp
currentStackFrame :: Q Exp
currentStackFrame = [|locStackFrame $(qLocation >>= liftLoc)|]

-- brittany-disable-next-binding

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
        -- N.B. this assumes we're unlikely to see adoption within libraries, or
        -- that such a thing would even work. If this function's used, it's
        -- assumed to be in end-user code.
        , bsfCode :: Maybe BugsnagCode
bsfCode = Maybe BugsnagCode
forall a. Maybe a
Nothing
        }

-- brittany-disable-next-binding

-- Taken from monad-logger
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))
    |]