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

{-# ANN module ("HLint: ignore Unused LANGUAGE pragma" :: String) #-}

newtype CodeIndex = CodeIndex
  { CodeIndex -> Map FilePath FileIndex
unCodeIndex :: Map FilePath FileIndex
  }
  deriving stock ((forall (m :: * -> *). Quote m => CodeIndex -> m Exp)
-> (forall (m :: * -> *). Quote m => CodeIndex -> Code m CodeIndex)
-> Lift CodeIndex
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => CodeIndex -> m Exp
forall (m :: * -> *). Quote m => CodeIndex -> Code m CodeIndex
$clift :: forall (m :: * -> *). Quote m => CodeIndex -> m Exp
lift :: forall (m :: * -> *). Quote m => CodeIndex -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => CodeIndex -> Code m CodeIndex
liftTyped :: forall (m :: * -> *). Quote m => CodeIndex -> Code m CodeIndex
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
$cshowsPrec :: Int -> CodeIndex -> ShowS
showsPrec :: Int -> CodeIndex -> ShowS
$cshow :: CodeIndex -> FilePath
show :: CodeIndex -> FilePath
$cshowList :: [CodeIndex] -> ShowS
showList :: [CodeIndex] -> ShowS
Show)

buildCodeIndex :: String -> Q Exp
buildCodeIndex :: FilePath -> Q Exp
buildCodeIndex FilePath
p = do
  CodeIndex
index <- IO CodeIndex -> Q CodeIndex
forall a. IO a -> Q a
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
  [|$(CodeIndex -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => CodeIndex -> m Exp
lift CodeIndex
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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 ((forall (m :: * -> *). Quote m => FileIndex -> m Exp)
-> (forall (m :: * -> *). Quote m => FileIndex -> Code m FileIndex)
-> Lift FileIndex
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => FileIndex -> m Exp
forall (m :: * -> *). Quote m => FileIndex -> Code m FileIndex
$clift :: forall (m :: * -> *). Quote m => FileIndex -> m Exp
lift :: forall (m :: * -> *). Quote m => FileIndex -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => FileIndex -> Code m FileIndex
liftTyped :: forall (m :: * -> *). Quote m => FileIndex -> Code m FileIndex
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
$cshowsPrec :: Int -> FileIndex -> ShowS
showsPrec :: Int -> FileIndex -> ShowS
$cshow :: FileIndex -> FilePath
show :: FileIndex -> FilePath
$cshowList :: [FileIndex] -> ShowS
showList :: [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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    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 a. [a] -> 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
fiSourceLines :: FileIndex -> Map Int Text
fiLastLine :: FileIndex -> Int
fiSourceLines :: Map Int Text
fiLastLine :: Int
..} <- 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