From 421cc0d1a1a5cc84d13c4bb12916b01bbf31649c Mon Sep 17 00:00:00 2001 From: joshvera Date: Tue, 24 Apr 2018 15:48:44 -0400 Subject: [PATCH] Add readProjectEntry to the Files effects --- src/Semantic/IO.hs | 15 +++++++++++++++ src/Semantic/Util.hs | 4 +++- test/Analysis/Go/Spec.hs | 2 +- test/Analysis/PHP/Spec.hs | 2 +- test/Analysis/Python/Spec.hs | 2 +- test/Analysis/Ruby/Spec.hs | 2 +- test/Analysis/TypeScript/Spec.hs | 2 +- 7 files changed, 23 insertions(+), 6 deletions(-) diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs index 631129a42..66fa16ad6 100644 --- a/src/Semantic/IO.hs +++ b/src/Semantic/IO.hs @@ -11,6 +11,7 @@ module Semantic.IO , NoLanguageForBlob(..) , readBlob , readProject +, readProjectEntry , readBlobs , readBlobPairs , writeToOutput @@ -94,6 +95,15 @@ readProjectFromPaths rootDir lang = do toFile path = File path (Just lang) exts = extensionsForLanguage lang +readProjectEntryFromPath :: MonadIO m => FilePath -> Language -> m Project +readProjectEntryFromPath path lang = do + paths <- liftIO $ filter (/= path) <$> fmap fold (globDir (compile . mappend "**/*." <$> exts) rootDir) + pure $ Project rootDir (toFile <$> (path : paths)) lang + where + rootDir = takeDirectory path + toFile path = File path (Just lang) + exts = extensionsForLanguage lang + readBlobsFromDir :: MonadIO m => FilePath -> m [Blob.Blob] readBlobsFromDir path = do paths <- liftIO (globDir1 (compile "[^vendor]**/*[.rb|.js|.tsx|.go|.py]") path) @@ -159,6 +169,9 @@ readBlobPairs = send . ReadBlobPairs readProject :: Member Files effs => FilePath -> Language -> Eff effs Project readProject dir = send . ReadProject dir +readProjectEntry :: Member Files effs => FilePath -> Language -> Eff effs Project +readProjectEntry file = send . ReadProjectEntry file + -- | A task which writes a 'B.ByteString' to a 'Handle' or a 'FilePath'. writeToOutput :: Member Files effs => Either Handle FilePath -> B.ByteString -> Eff effs () writeToOutput path = send . WriteToOutput path @@ -170,6 +183,7 @@ data Files out where ReadBlobs :: Either Handle [File] -> Files [Blob.Blob] ReadBlobPairs :: Either Handle [Both File] -> Files [Blob.BlobPair] ReadProject :: FilePath -> Language -> Files Project + ReadProjectEntry :: FilePath -> Language -> Files Project WriteToOutput :: Either Handle FilePath -> B.ByteString -> Files () -- | Run a 'Files' effect in 'IO'. @@ -181,6 +195,7 @@ runFiles = interpret $ \ files -> case files of ReadBlobs (Right paths) -> rethrowing (readBlobsFromPaths paths) ReadBlobPairs source -> rethrowing (either readBlobPairsFromHandle (traverse (runBothWith readFilePair)) source) ReadProject dir language -> rethrowing (readProjectFromPaths dir language) + ReadProjectEntry file language -> rethrowing (readProjectEntryFromPath file language) WriteToOutput destination contents -> liftIO (either B.hPutStr B.writeFile destination contents) diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 159581543..11544a037 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -50,13 +50,15 @@ evalGoProject path = runAnalysis @(JustEvaluating Go.Term) <$> evaluateProject g evalRubyProject path = runAnalysis @(JustEvaluating Ruby.Term) <$> evaluateProject rubyParser Language.Ruby rubyPrelude path evalPHPProject path = runAnalysis @(JustEvaluating PHP.Term) <$> evaluateProject phpParser Language.PHP Nothing path evalPythonProject path = runAnalysis @(JustEvaluating Python.Term) <$> evaluateProject pythonParser Language.Python pythonPrelude path -evalTypeScriptProject path = runAnalysis @(EvaluatingWithHoles TypeScript.Term) <$> evaluateProject typescriptParser Language.TypeScript Nothing path +evalTypeScriptProjectQuietly path = runAnalysis @(EvaluatingWithHoles TypeScript.Term) <$> evaluateProject typescriptParser Language.TypeScript Nothing path +evalTypeScriptProject path = runAnalysis @(JustEvaluating TypeScript.Term) <$> evaluateProject typescriptParser Language.TypeScript Nothing path rubyPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) (Just Language.Ruby) pythonPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) (Just Language.Python) -- Evaluate a project, starting at a single entrypoint. evaluateProject parser lang prelude path = evaluatePackage <$> runTask (readProject path lang >>= parsePackage parser prelude) +evaluateProjectEntry parser lang prelude path = evaluatePackage <$> runTask (readProjectEntry path lang >>= parsePackage parser prelude) parseFile :: Parser term -> FilePath -> IO term parseFile parser = runTask . (parse parser <=< readBlob . file) diff --git a/test/Analysis/Go/Spec.hs b/test/Analysis/Go/Spec.hs index 97f9672ba..9222ed48f 100644 --- a/test/Analysis/Go/Spec.hs +++ b/test/Analysis/Go/Spec.hs @@ -32,4 +32,4 @@ spec = parallel $ do where fixtures = "test/fixtures/go/analysis/" evaluate entry = evalGoProject (fixtures <> entry) - evalGoProject path = runAnalysis @(TestEvaluating Go.Term) <$> evaluateProject goParser Language.Go Nothing path + evalGoProject path = runAnalysis @(TestEvaluating Go.Term) <$> evaluateProjectEntry goParser Language.Go Nothing path diff --git a/test/Analysis/PHP/Spec.hs b/test/Analysis/PHP/Spec.hs index e8a22cb9c..e32c64aed 100644 --- a/test/Analysis/PHP/Spec.hs +++ b/test/Analysis/PHP/Spec.hs @@ -36,4 +36,4 @@ spec = parallel $ do where fixtures = "test/fixtures/php/analysis/" evaluate entry = evalPHPProject (fixtures <> entry) - evalPHPProject path = runAnalysis @(TestEvaluating PHP.Term) <$> evaluateProject phpParser Language.PHP Nothing path + evalPHPProject path = runAnalysis @(TestEvaluating PHP.Term) <$> evaluateProjectEntry phpParser Language.PHP Nothing path diff --git a/test/Analysis/Python/Spec.hs b/test/Analysis/Python/Spec.hs index 39c9edaab..d54875a68 100644 --- a/test/Analysis/Python/Spec.hs +++ b/test/Analysis/Python/Spec.hs @@ -51,4 +51,4 @@ spec = parallel $ do addr = Address . Precise fixtures = "test/fixtures/python/analysis/" evaluate entry = evalPythonProject (fixtures <> entry) - evalPythonProject path = runAnalysis @(TestEvaluating Python.Term) <$> evaluateProject pythonParser Language.Python pythonPrelude path + evalPythonProject path = runAnalysis @(TestEvaluating Python.Term) <$> evaluateProjectEntry pythonParser Language.Python pythonPrelude path diff --git a/test/Analysis/Ruby/Spec.hs b/test/Analysis/Ruby/Spec.hs index 0049680b6..f0e4bebbf 100644 --- a/test/Analysis/Ruby/Spec.hs +++ b/test/Analysis/Ruby/Spec.hs @@ -64,4 +64,4 @@ spec = parallel $ do addr = Address . Precise fixtures = "test/fixtures/ruby/analysis/" evaluate entry = evalRubyProject (fixtures <> entry) - evalRubyProject path = runAnalysis @(TestEvaluating Ruby.Term) <$> evaluateProject rubyParser Language.Ruby rubyPrelude path + evalRubyProject path = runAnalysis @(TestEvaluating Ruby.Term) <$> evaluateProjectEntry rubyParser Language.Ruby rubyPrelude path diff --git a/test/Analysis/TypeScript/Spec.hs b/test/Analysis/TypeScript/Spec.hs index 13c6e7f4d..631c6d676 100644 --- a/test/Analysis/TypeScript/Spec.hs +++ b/test/Analysis/TypeScript/Spec.hs @@ -43,4 +43,4 @@ spec = parallel $ do where fixtures = "test/fixtures/typescript/analysis/" evaluate entry = evalTypeScriptProject (fixtures <> entry) - evalTypeScriptProject path = runAnalysis @(TestEvaluating TypeScript.Term) <$> evaluateProject typescriptParser Language.TypeScript Nothing path + evalTypeScriptProject path = runAnalysis @(TestEvaluating TypeScript.Term) <$> evaluateProjectEntry typescriptParser Language.TypeScript Nothing path