content: {-
    Copyright (c) Meta Platforms, Inc. and affiliates.
    All rights reserved.
  
    This source code is licensed under the BSD-style license found in the
    LICENSE file in the root directory of this source tree.
  -}
  
  {-
  
  Generic indexer for LSIF. Supply name of lsif binary in $PATH to run
  predicates for typescript.
  
  -}
  
  {-# LANGUAGE OverloadedStrings #-}
  
  module Glean.LSIF.Driver (
      LsifIndexerParams(..),
      processLSIF,
      runIndexer,
  
      -- writing
      writeJSON
   ) where
  
  import Control.Exception ( throwIO, ErrorCall(ErrorCall) )
  import Control.Monad.State.Strict
  import Data.Text ( Text )
  import Data.List ( intersperse )
  import System.Directory ( getHomeDirectory, withCurrentDirectory, makeAbsolute )
  import System.FilePath
      ( (</>), dropTrailingPathSeparator, takeBaseName )
  import System.IO ( openFile, IOMode(WriteMode), hClose )
  import System.IO.Temp ( withSystemTempDirectory )
  import System.Process ( callProcess, callCommand )
  import Text.Printf ( printf )
  import Util.Log ( logInfo )
  import qualified Data.Aeson as Aeson
  import qualified Data.ByteString.Char8 as Strict
  import qualified Data.ByteString.Lazy.Char8 as Lazy
  import qualified Data.Vector as V
  import qualified Data.HashMap.Strict as HashMap
  import qualified Data.Text as Text
  
  import qualified Foreign.CPP.Dynamic
  
  import qualified Data.LSIF.Angle as LSIF
  
  data LsifIndexerParams = LsifIndexerParams
    { lsifBinary :: FilePath
    , lsifArgs :: FilePath -> [String]
    , lsifRoot :: FilePath
    , lsifStdout :: Bool
    }
  
  -- | Run an LSIF indexer, and convert to a Glean's lsif.angle database
  -- foramt, returning a single JSON value that can be sent to the Glean server
  runIndexer :: LsifIndexerParams -> IO Aeson.Value
  runIndexer params@LsifIndexerParams{..} = do
    repoDir <- makeAbsolute lsifRoot -- save this before we switch to tmp
    withSystemTempDirectory "glean-lsif" $ \lsifDir -> do
      let lsifFile = lsifDir </> "index.lsif"
      runLSIFIndexer params { lsifRoot = repoDir } lsifFile
      processLSIF repoDir lsifFile
  
  -- | Run a generic lsif-producing indexer on a repository,
  -- put lsif dump output into outputFile
  runLSIFIndexer :: LsifIndexerParams -> FilePath -> IO ()
  runLSIFIndexer LsifIndexerParams{..} outputFile =
    withCurrentDirectory lsifRoot $ do
      logInfo $ printf "Indexing %s with %s" (takeBaseName lsifRoot) lsifBinary
      let args = lsifArgs outputFile
      if lsifStdout
        then callCommand $
          printf "%s %s > %s" lsifBinary (unwords args) outputFile
        else callProcess lsifBinary args
  
  -- | Convert an lsif json dump into Glean lsif.angle JSON object
  processLSIF :: FilePath -> FilePath -> IO Aeson.Value
  processLSIF repoDir lsifFile = do
    logInfo $ "Using LSIF from " <> lsifFile
    toLsifAngle repoDir =<< Lazy.readFile lsifFile
  
  -- | Write json to file
  writeJSON :: FilePath -> Aeson.Value -> IO ()
  writeJSON outFile json = do
    logInfo $ "Writing Angle facts to " <> outFile
    case json of
      Aeson.Array facts -> encodeChunks outFile facts
      _ -> Aeson.encodeFile outFile json
  
  -- Uses less memory if we do this piece-wise
  encodeChunks :: FilePath -> V.Vector Aeson.Value -> IO ()
  encodeChunks file vs = do
    handle <- openFile file WriteMode
    Lazy.hPut handle "["
    mapM_ (writeChunk handle) $
            intersperse (Right ",") (map Left (V.toList vs))
    Lazy.hPut handle "]\n"
    hClose handle
    where
      writeChunk handle (Left c) = Lazy.hPut handle (Aeson.encode c)
      writeChunk handle (Right s) = Lazy.hPut handle (s <> "\n")
  
  -- Get some likely prefix paths to drop from indexers
  -- E.g. typescript with a yarn install puts .config/yarn paths for libraries
  dropPrefixPaths :: FilePath -> IO [Text]
  dropPrefixPaths repoDir = do
    home <- Text.pack <$> getHomeDirectory
    return $ map ("file://" <>)
    -- typescript system paths
      [ home <> "/.config/yarn/global/node_modules"
      , "/usr/local/share/.config/yarn/global/node_modules"
      -- tests/CI install path
      , home <> "/.hsthrift/lib/node_modules"
     -- typescript with npm
      , "/usr/lib/node_modules"
     -- rust system paths
      , "/usr/lib"
      , home <> "/.cargo/registry"
      , home <> "/.rustup/toolchains/stable-x86_64-unknown-linux-gnu"
      , home <> "/.rustup/toolchains/stable-aarch64-unknown-linux-gnu"
      -- repoDir root, so everything is repo-relative
      , Text.pack (dropTrailingPathSeparator repoDir)
      ]
  
  toLsifAngle :: FilePath -> Lazy.ByteString -> IO Aeson.Value
  toLsifAngle repoDir str = do
    paths <- dropPrefixPaths repoDir
    (facts, env) <- parseChunks paths str
    logInfo "Generating cross-references"
    let !xrefs = evalState LSIF.emitFileFactSets  env
    let result = LSIF.generateJSON (LSIF.insertPredicateMap facts xrefs)
    return (Aeson.Array $ V.fromList result)
  
  -- | Lazily parse lsif as one object per line. File is consumed and can be
  -- dropped at end of parsing We go to some lengths to avoid retaining things,
  -- just the state needed to emit xrefs at the end of
  -- the analysis.
  parseChunks :: [Text] -> Lazy.ByteString -> IO (LSIF.PredicateMap, LSIF.Env)
  parseChunks paths str =
    let contents = map (Strict.concat . Lazy.toChunks) (Lazy.lines str)
        initState = LSIF.emptyEnv { LSIF.root = paths }
    in runStateT (runToAngle contents) initState
  
  -- strict left fold over each chunk, producing accumulating output facts
  -- and final global state of the analysis
  runToAngle :: [Strict.ByteString] -> StateT LSIF.Env IO LSIF.PredicateMap
  runToAngle = go HashMap.empty -- a foldlM'
    where
      go !acc [] = return acc
      go !acc (line:lines) = do
        preds <- parseAsJSON line
        go (LSIF.insertPredicateMap acc preds) lines
  
  parseAsJSON :: Strict.ByteString -> StateT LSIF.Env IO [LSIF.Predicate]
  parseAsJSON line = do
    rawjson <- liftIO $ Foreign.CPP.Dynamic.parseJSON line
    case rawjson of
      Left bad -> liftIO $ throwIO (ErrorCall (Text.unpack bad))
      Right good -> case Aeson.fromJSON good of
        Aeson.Error err -> liftIO $ throwIO (ErrorCall err)
        Aeson.Success fact -> LSIF.factToAngle fact
  