{-# 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 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
liftTyped :: forall (m :: * -> *). Quote m => CodeIndex -> Code m CodeIndex
$cliftTyped :: forall (m :: * -> *). Quote m => CodeIndex -> Code m CodeIndex
lift :: forall (m :: * -> *). Quote m => CodeIndex -> m Exp
$clift :: forall (m :: * -> *). Quote m => CodeIndex -> m Exp
Lift, Int -> CodeIndex -> ShowS
[CodeIndex] -> ShowS
CodeIndex -> FilePath
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 <- forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO CodeIndex
buildCodeIndex' FilePath
p
  [|$(lift 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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,) 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 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
liftTyped :: forall (m :: * -> *). Quote m => FileIndex -> Code m FileIndex
$cliftTyped :: forall (m :: * -> *). Quote m => FileIndex -> Code m FileIndex
lift :: forall (m :: * -> *). Quote m => FileIndex -> m Exp
$clift :: forall (m :: * -> *). Quote m => FileIndex -> m Exp
Lift, Int -> FileIndex -> ShowS
[FileIndex] -> ShowS
FileIndex -> FilePath
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
T.readFile FilePath
path

  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    FileIndex
      { fiSourceLines :: Map Int Text
fiSourceLines = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [Text]
lns
      , fiLastLine :: Int
fiLastLine = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
lns 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
..} <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
path forall a b. (a -> b) -> a -> b
$ CodeIndex -> Map FilePath FileIndex
unCodeIndex CodeIndex
index

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