{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}

module Network.Bugsnag.CodeIndex
    ( CodeIndex
    , buildCodeIndex
    , findSourceRange
    )
where

import Prelude

import Data.List (genericLength)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Traversable (for)
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax
import Numeric.Natural (Natural)
import System.FilePath.Glob (glob)

newtype CodeIndex = CodeIndex
    { CodeIndex -> Map FilePath FileIndex
unCodeIndex :: Map FilePath FileIndex
    }
    deriving stock (CodeIndex -> Q Exp
CodeIndex -> Q (TExp CodeIndex)
(CodeIndex -> Q Exp)
-> (CodeIndex -> Q (TExp CodeIndex)) -> Lift CodeIndex
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: CodeIndex -> Q (TExp CodeIndex)
$cliftTyped :: CodeIndex -> Q (TExp CodeIndex)
lift :: CodeIndex -> Q Exp
$clift :: CodeIndex -> Q Exp
Lift, Int -> CodeIndex -> ShowS
[CodeIndex] -> ShowS
CodeIndex -> FilePath
(Int -> CodeIndex -> ShowS)
-> (CodeIndex -> FilePath)
-> ([CodeIndex] -> ShowS)
-> Show CodeIndex
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CodeIndex] -> ShowS
$cshowList :: [CodeIndex] -> ShowS
show :: CodeIndex -> FilePath
$cshow :: CodeIndex -> FilePath
showsPrec :: Int -> CodeIndex -> ShowS
$cshowsPrec :: Int -> CodeIndex -> ShowS
Show)

-- | Index code for attaching lines of source to 'StackFrame's
--
-- See the 'bsCodeIndex' field of 'BugsnagSettings' for details.
--
-- **WARNING**: This feature comes with a number of caveats.
--
-- 1. It's not frequently used and may not work.
-- 2. It (probably) means you will be holding all indexed source code in memory
--    during the life of your process.
-- 3. In larger projects, it will embed substantial amounts of source code in a
--    single file, which can significantly degrade compilation time.
--
buildCodeIndex :: String -> Q Exp
buildCodeIndex :: FilePath -> Q Exp
buildCodeIndex FilePath
p = do
    CodeIndex
index <- IO CodeIndex -> Q CodeIndex
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (IO CodeIndex -> Q CodeIndex) -> IO CodeIndex -> Q CodeIndex
forall a b. (a -> b) -> a -> b
$ FilePath -> IO CodeIndex
buildCodeIndex' FilePath
p
    [|index|]

buildCodeIndex' :: String -> IO CodeIndex
buildCodeIndex' :: FilePath -> IO CodeIndex
buildCodeIndex' FilePath
p = do
    [FilePath]
paths <- FilePath -> IO [FilePath]
glob FilePath
p
    Map FilePath FileIndex -> CodeIndex
CodeIndex (Map FilePath FileIndex -> CodeIndex)
-> ([(FilePath, FileIndex)] -> Map FilePath FileIndex)
-> [(FilePath, FileIndex)]
-> CodeIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FilePath, FileIndex)] -> Map FilePath FileIndex
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(FilePath, FileIndex)] -> CodeIndex)
-> IO [(FilePath, FileIndex)] -> IO CodeIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO (FilePath, FileIndex))
-> [FilePath] -> IO [(FilePath, FileIndex)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO (FilePath, FileIndex)
indexPath [FilePath]
paths
  where
    indexPath :: FilePath -> IO (FilePath, FileIndex)
    indexPath :: FilePath -> IO (FilePath, FileIndex)
indexPath FilePath
fp = (FilePath
fp, ) (FileIndex -> (FilePath, FileIndex))
-> IO FileIndex -> IO (FilePath, FileIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FileIndex
buildFileIndex FilePath
fp

data FileIndex = FileIndex
    { FileIndex -> Map Natural Text
fiSourceLines :: Map Natural Text
    , FileIndex -> Natural
fiLastLine :: Natural
    }
    deriving stock (FileIndex -> Q Exp
FileIndex -> Q (TExp FileIndex)
(FileIndex -> Q Exp)
-> (FileIndex -> Q (TExp FileIndex)) -> Lift FileIndex
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: FileIndex -> Q (TExp FileIndex)
$cliftTyped :: FileIndex -> Q (TExp FileIndex)
lift :: FileIndex -> Q Exp
$clift :: FileIndex -> Q Exp
Lift, Int -> FileIndex -> ShowS
[FileIndex] -> ShowS
FileIndex -> FilePath
(Int -> FileIndex -> ShowS)
-> (FileIndex -> FilePath)
-> ([FileIndex] -> ShowS)
-> Show FileIndex
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FileIndex] -> ShowS
$cshowList :: [FileIndex] -> ShowS
show :: FileIndex -> FilePath
$cshow :: FileIndex -> FilePath
showsPrec :: Int -> FileIndex -> ShowS
$cshowsPrec :: Int -> FileIndex -> ShowS
Show)

buildFileIndex :: FilePath -> IO FileIndex
buildFileIndex :: FilePath -> IO FileIndex
buildFileIndex FilePath
path = do
    [Text]
lns <- Text -> [Text]
T.lines (Text -> [Text]) -> IO Text -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
T.readFile FilePath
path

    FileIndex -> IO FileIndex
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileIndex :: Map Natural Text -> Natural -> FileIndex
FileIndex
        { fiSourceLines :: Map Natural Text
fiSourceLines = [(Natural, Text)] -> Map Natural Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Natural, Text)] -> Map Natural Text)
-> [(Natural, Text)] -> Map Natural Text
forall a b. (a -> b) -> a -> b
$ [Natural] -> [Text] -> [(Natural, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Natural
0 ..] [Text]
lns
        , fiLastLine :: Natural
fiLastLine = [Text] -> Natural
forall i a. Num i => [a] -> i
genericLength [Text]
lns Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1
        }

findSourceRange
    :: FilePath -> (Natural, Natural) -> CodeIndex -> Maybe [(Natural, Text)]
findSourceRange :: FilePath
-> (Natural, Natural) -> CodeIndex -> Maybe [(Natural, Text)]
findSourceRange FilePath
path (Natural
begin, Natural
end) CodeIndex
index = do
    FileIndex {Natural
Map Natural Text
fiLastLine :: Natural
fiSourceLines :: Map Natural Text
fiLastLine :: FileIndex -> Natural
fiSourceLines :: FileIndex -> Map Natural Text
..} <- FilePath -> Map FilePath FileIndex -> Maybe FileIndex
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
path (Map FilePath FileIndex -> Maybe FileIndex)
-> Map FilePath FileIndex -> Maybe FileIndex
forall a b. (a -> b) -> a -> b
$ CodeIndex -> Map FilePath FileIndex
unCodeIndex CodeIndex
index

    [Natural]
-> (Natural -> Maybe (Natural, Text)) -> Maybe [(Natural, Text)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Natural
begin .. Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
min Natural
end Natural
fiLastLine]
        ((Natural -> Maybe (Natural, Text)) -> Maybe [(Natural, Text)])
-> (Natural -> Maybe (Natural, Text)) -> Maybe [(Natural, Text)]
forall a b. (a -> b) -> a -> b
$ \Natural
n -> (Natural
n, ) (Text -> (Natural, Text)) -> Maybe Text -> Maybe (Natural, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> Map Natural Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Natural
n Map Natural Text
fiSourceLines