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

-- | Compile-time snapshot of your project source
--
-- This is necessary to attach source code snippets to exceptions reported to
-- Bugsnag. We do this by reading the project source at compile-time and
-- stashing the result in 'Settings'.
--
-- **WARNING**: This feature (probably) means you will be holding all indexed
-- source code in memory during the life of your process. And in larger
-- projects, it will embed substantial amounts of source code in a single file,
-- which can significantly degrade compilation time.
--
module Network.Bugsnag.CodeIndex
    ( CodeIndex
    , buildCodeIndex
    , findSourceRange
    ) where

import Prelude

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

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 Int Text
fiSourceLines :: Map Int Text
    , FileIndex -> Int
fiLastLine :: Int
    }
    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 Int Text -> Int -> FileIndex
FileIndex
        { fiSourceLines :: Map Int Text
fiSourceLines = [(Int, Text)] -> Map Int Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Int, Text)] -> Map Int Text) -> [(Int, Text)] -> Map Int Text
forall a b. (a -> b) -> a -> b
$ [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [Text]
lns
        , fiLastLine :: Int
fiLastLine = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
lns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        }

findSourceRange :: FilePath -> (Int, Int) -> CodeIndex -> Maybe [(Int, Text)]
findSourceRange :: FilePath -> (Int, Int) -> CodeIndex -> Maybe [(Int, Text)]
findSourceRange FilePath
path (Int
begin, Int
end) CodeIndex
index = do
    FileIndex {Int
Map Int Text
fiLastLine :: Int
fiSourceLines :: Map Int Text
fiLastLine :: FileIndex -> Int
fiSourceLines :: FileIndex -> Map Int 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

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