<commit_before>{-# LANGUAGE Haskell2010, BangPatterns, DeriveDataTypeable, OverloadedStrings, RankNTypes #-}

module Pygmalion.Index.Source
( runSourceAnalyses
, displayAST
) where

import qualified Clang.CrossReference as XRef
import qualified Clang.Cursor as C
import qualified Clang.Diagnostic as Diag
import qualified Clang.File as File
import Clang.Monad
import qualified Clang.Source as Source
import qualified Clang.String as CS
import Clang.TranslationUnit
import qualified Clang.Traversal as TV
import qualified Clang.Type as T
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as BU
import Data.Hashable
import qualified Data.IntMap.Strict as Map
import qualified Data.IntSet as Set
import Data.Typeable
import qualified Data.Vector.Storable as DVS

import Data.Bool.Predicate
import Pygmalion.Core
import Pygmalion.Log
import Pygmalion.RPC.Client

runSourceAnalyses :: CommandInfo -> RPCConnection -> IO ()
runSourceAnalyses ci conn = do
  result <- try $ withTranslationUnit ci $ \tu -> do
                    let sfHash = hash $ ciSourceFile ci
                    logDiagnostics tu
                    dirtyFiles <- inclusionsAnalysis conn sfHash tu
                    --addFileDefs conn ci dirtyFiles
                    defsAnalysis conn dirtyFiles tu
  case result of
    Right _ -> return ()
    Left (ClangException e) -> void $ logWarn ("Clang exception: " ++ e)

displayAST :: CommandInfo -> IO ()
displayAST ci = do
  result <- try $ withTranslationUnit ci doDisplayAST
  case result of
    Right _                 -> return ()
    Left (ClangException e) -> logWarn ("Clang exception: " ++ e )

inclusionsAnalysis :: RPCConnection -> SourceFileHash -> TranslationUnit
                   -> ClangApp s Set.IntSet
inclusionsAnalysis conn sfHash tu = do
    clangIncPath <- mkSourceFile <$> liftIO libclangIncludePath
    incs <- DVS.filterM (prefixIsNot clangIncPath)
        =<< TV.getInclusions tu
    incs' <- mapM toInclusion $ DVS.toList incs
    dirtyIncs <- liftIO $ runRPC (rpcUpdateAndFindDirtyInclusions sfHash incs') conn
    -- We include the source file itself in the list of dirty files.
    -- TODO: What we should do here is construct the 'dirtyFiles'
    -- cache here instead of lazily. Then we can pass it around with
    -- ReaderT instead of explicitly. This will remove significant
    -- complexity from defsAnalysis.
    return $ sfHash `Set.insert` Set.fromList dirtyIncs

  where

    toInclusion (TV.Inclusion file loc _) = do
      inc <- CS.unsafeUnpackByteString =<< File.getName file
      (f, _, _, _) <- Source.getSpellingLocation loc
      filename <- case f of Just f' -> File.getName f' >>= CS.unsafeUnpackByteString
                            Nothing -> return ""
      --liftIO $ putStrLn $ "Got inclusion " ++ show inc ++ " included by " ++ show filename
      return $ Inclusion inc (hash filename)

    prefixIsNot clangIncSF (TV.Inclusion file _ _) =
      (not . B.isPrefixOf clangIncSF) <$> (CS.unsafeUnpackByteString =<< File.getName file)

{-
addFileDefs :: RPCConnection -> CommandInfo -> Set.IntSet -> ClangApp s ()
addFileDefs conn ci dirtyFiles = do
  -- Add a special definition for the beginning of each file we're indexing. This is
  -- referenced by inclusion directives.
  forM_ (Set.elems dirtyFiles) $ \sfHash ->
    let def = DefUpdate (ciSourceFile ci) sfHash sfHash 1 1 SourceFile 0
    liftIO $ runRPC (rpcFoundDef def) conn
-}
  
defsAnalysis :: RPCConnection -> Set.IntSet -> TranslationUnit -> ClangApp s ()
defsAnalysis conn dirtyFiles tu = do
  cursor <- getCursor tu
  kids <- TV.getChildren cursor
  void $ DVS.foldM' (defsVisitor conn dirtyFiles tu) Map.empty kids

defsVisitor :: RPCConnection -> Set.IntSet -> TranslationUnit -> FileCache
            -> C.Cursor -> ClangApp s FileCache
defsVisitor conn dirtyFiles tu fileCache cursor = liftIO $ runClangApp $ do
  (loc, fileCache') <- getCursorLocation fileCache dirtyFiles cursor
  -- TODO: What to do about inclusions that aren't normal inclusions?
  -- Ones that are intended to be multiply included, etc?
  if tlShouldIndex loc then do
    cKind <- C.getKind cursor<commit_msg>Switch from runClangApp to clangScope<commit_after>{-# LANGUAGE Haskell2010, BangPatterns, DeriveDataTypeable, OverloadedStrings, RankNTypes #-}

module Pygmalion.Index.Source
( runSourceAnalyses
, displayAST
) where

import qualified Clang.CrossReference as XRef
import qualified Clang.Cursor as C
import qualified Clang.Diagnostic as Diag
import qualified Clang.File as File
import Clang.Monad
import qualified Clang.Source as Source
import qualified Clang.String as CS
import Clang.TranslationUnit
import qualified Clang.Traversal as TV
import qualified Clang.Type as T
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as BU
import Data.Hashable
import qualified Data.IntMap.Strict as Map
import qualified Data.IntSet as Set
import Data.Typeable
import qualified Data.Vector.Storable as DVS

import Data.Bool.Predicate
import Pygmalion.Core
import Pygmalion.Log
import Pygmalion.RPC.Client

runSourceAnalyses :: CommandInfo -> RPCConnection -> IO ()
runSourceAnalyses ci conn = do
  result <- try $ withTranslationUnit ci $ \tu -> do
                    let sfHash = hash $ ciSourceFile ci
                    logDiagnostics tu
                    dirtyFiles <- inclusionsAnalysis conn sfHash tu
                    --addFileDefs conn ci dirtyFiles
                    defsAnalysis conn dirtyFiles tu
  case result of
    Right _ -> return ()
    Left (ClangException e) -> void $ logWarn ("Clang exception: " ++ e)

displayAST :: CommandInfo -> IO ()
displayAST ci = do
  result <- try $ withTranslationUnit ci doDisplayAST
  case result of
    Right _                 -> return ()
    Left (ClangException e) -> logWarn ("Clang exception: " ++ e )

inclusionsAnalysis :: RPCConnection -> SourceFileHash -> TranslationUnit
                   -> ClangApp s Set.IntSet
inclusionsAnalysis conn sfHash tu = do
    clangIncPath <- mkSourceFile <$> liftIO libclangIncludePath
    incs <- DVS.filterM (prefixIsNot clangIncPath)
        =<< TV.getInclusions tu
    incs' <- mapM toInclusion $ DVS.toList incs
    dirtyIncs <- liftIO $ runRPC (rpcUpdateAndFindDirtyInclusions sfHash incs') conn
    -- We include the source file itself in the list of dirty files.
    -- TODO: What we should do here is construct the 'dirtyFiles'
    -- cache here instead of lazily. Then we can pass it around with
    -- ReaderT instead of explicitly. This will remove significant
    -- complexity from defsAnalysis.
    return $ sfHash `Set.insert` Set.fromList dirtyIncs

  where

    toInclusion (TV.Inclusion file loc _) = do
      inc <- CS.unsafeUnpackByteString =<< File.getName file
      (f, _, _, _) <- Source.getSpellingLocation loc
      filename <- case f of Just f' -> File.getName f' >>= CS.unsafeUnpackByteString
                            Nothing -> return ""
      --liftIO $ putStrLn $ "Got inclusion " ++ show inc ++ " included by " ++ show filename
      return $ Inclusion inc (hash filename)

    prefixIsNot clangIncSF (TV.Inclusion file _ _) =
      (not . B.isPrefixOf clangIncSF) <$> (CS.unsafeUnpackByteString =<< File.getName file)

{-
addFileDefs :: RPCConnection -> CommandInfo -> Set.IntSet -> ClangApp s ()
addFileDefs conn ci dirtyFiles = do
  -- Add a special definition for the beginning of each file we're indexing. This is
  -- referenced by inclusion directives.
  forM_ (Set.elems dirtyFiles) $ \sfHash ->
    let def = DefUpdate (ciSourceFile ci) sfHash sfHash 1 1 SourceFile 0
    liftIO $ runRPC (rpcFoundDef def) conn
-}
  
defsAnalysis :: RPCConnection -> Set.IntSet -> TranslationUnit -> ClangApp s ()
defsAnalysis conn dirtyFiles tu = do
  cursor <- getCursor tu
  kids <- TV.getChildren cursor
  void $ DVS.foldM' (defsVisitor conn dirtyFiles tu) Map.empty kids

defsVisitor :: RPCConnection -> Set.IntSet -> TranslationUnit -> FileCache
            -> C.Cursor -> ClangApp s FileCache
defsVisitor conn dirtyFiles tu fileCache cursor = clangScope $ do
  (loc, fileCache') <- getCursorLocation fileCache dirtyFiles cursor
  -- TODO: What to do about inclusions that aren't normal inclusions?
  -- Ones that are intended to be multiply included, etc?
  if tlShouldIndex loc then do
    cKind <- C.getKind cursor
{'fraction_non_alphanumeric': 0.07801501642421399, 'fraction_numerical': 0.0018770530267480056, 'mean_word_length': 3.17687408133268, 'pattern_counts': {'":': 0, '<': 47, '<?xml version=': 0, '>': 61, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6940459', 'n_tokens_mistral': 2482, 'n_tokens_neox': 2373, 'n_words': 860}