StackFrame.hs

{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

module Network.Bugsnag.StackFrame
    ( attachBugsnagCode
    , currentStackFrame
    ) where

import Prelude

import Data.Bugsnag
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text, pack, unpack)
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax
import Network.Bugsnag.CodeIndex

-- | Attempt to attach code to a 'StackFrame'
--
-- Looks up the content in the Index by File/LineNumber and, if found, sets it
-- on the record.
--
attachBugsnagCode :: CodeIndex -> StackFrame -> StackFrame
attachBugsnagCode index sf = sf
    { stackFrame_code = findBugsnagCode
        (unpack $ stackFrame_file sf)
        (stackFrame_lineNumber sf)
        index
    }

findBugsnagCode :: FilePath -> Int -> CodeIndex -> Maybe (HashMap Int Text)
findBugsnagCode path n = fmap HashMap.fromList
    . findSourceRange path (begin, n + 3)
  where
    begin
        | n < 3 = 0
        | otherwise = n - 3

-- | Construct a 'StackFrame' from the point of this splice
--
-- Unfortunately there's no way to know the function, so that must be given:
--
currentStackFrame :: Q Exp
currentStackFrame = [|locStackFrame $(qLocation >>= liftLoc)|]

-- brittany-disable-next-binding

locStackFrame :: Loc -> Text -> StackFrame
locStackFrame (Loc path _ _ (ls, cs) _) func =
    defaultStackFrame
        { stackFrame_file = pack path
        , stackFrame_lineNumber = ls
        , stackFrame_columnNumber = Just cs
        , stackFrame_method = func
        , stackFrame_inProject = Just 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.
        , stackFrame_code = Nothing
        }

-- brittany-disable-next-binding

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