From 3fb3097c96ef581fb51203d814c127b6573fabf0 Mon Sep 17 00:00:00 2001 From: joshvera Date: Mon, 23 Apr 2018 19:47:13 -0400 Subject: [PATCH] back to using Maybe Language in File --- src/Data/File.hs | 7 +++++-- src/Parsing/Parser.hs | 4 ++-- src/Semantic/CLI.hs | 8 +++----- src/Semantic/IO.hs | 7 +++---- src/Semantic/Util.hs | 10 ++++++++-- test/Analysis/Go/Spec.hs | 3 ++- test/Analysis/PHP/Spec.hs | 3 ++- test/Analysis/Python/Spec.hs | 3 ++- test/Analysis/Ruby/Spec.hs | 3 ++- test/Analysis/TypeScript/Spec.hs | 3 ++- 10 files changed, 31 insertions(+), 20 deletions(-) diff --git a/src/Data/File.hs b/src/Data/File.hs index 05e1149b9..89c51c39f 100644 --- a/src/Data/File.hs +++ b/src/Data/File.hs @@ -2,13 +2,12 @@ module Data.File where import Data.ByteString.Char8 as BC (pack) import Data.Language -import qualified Data.List.NonEmpty as NonEmpty import Prologue import System.FilePath.Posix data File = File { filePath :: FilePath - , fileLanguage :: Language + , fileLanguage :: Maybe Language } deriving (Eq, Ord, Show) @@ -19,6 +18,10 @@ data Project = Project } deriving (Eq, Ord, Show) +file :: FilePath -> File +file path = File path (languageForFilePath path) + where languageForFilePath = languageForType . takeExtension + projectName :: Project -> ByteString projectName = BC.pack . dropExtensions . takeFileName . projectRootDir diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs index 24529909b..687d3aef4 100644 --- a/src/Parsing/Parser.hs +++ b/src/Parsing/Parser.hs @@ -71,8 +71,8 @@ someAnalysisParser :: ( ApplyAll' typeclasses Go.Syntax someAnalysisParser _ Go = SomeAnalysisParser goParser Nothing someAnalysisParser _ JavaScript = SomeAnalysisParser typescriptParser Nothing someAnalysisParser _ PHP = SomeAnalysisParser phpParser Nothing -someAnalysisParser _ Python = SomeAnalysisParser pythonParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) Python) -someAnalysisParser _ Ruby = SomeAnalysisParser rubyParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) Ruby) +someAnalysisParser _ Python = SomeAnalysisParser pythonParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) (Just Python)) +someAnalysisParser _ Ruby = SomeAnalysisParser rubyParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) (Just Ruby)) someAnalysisParser _ TypeScript = SomeAnalysisParser typescriptParser Nothing someAnalysisParser _ l = error $ "Analysis not supported for: " <> show l diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 10947f138..918a4b758 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -7,13 +7,12 @@ module Semantic.CLI ) where import Data.File +import Data.Language import Data.List (intercalate) -import qualified Data.List.NonEmpty as NonEmpty import Data.List.Split (splitWhen) import Data.Version (showVersion) import Development.GitRev import Options.Applicative -import Options.Applicative.Types (readerAsk) import qualified Paths_semantic as Library (version) import Prologue import Rendering.Renderer @@ -25,7 +24,6 @@ import qualified Semantic.Parse as Semantic (parseBlobs) import qualified Semantic.Task as Task import System.IO (Handle, stdin, stdout) import Text.Read -import Data.Language main :: IO () main = customExecParser (prefs showHelpOnEmpty) arguments >>= uncurry Task.runTaskWithOptions @@ -90,7 +88,7 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar graphArgumentsParser = do renderer <- flag (SomeRenderer DOTGraphRenderer) (SomeRenderer DOTGraphRenderer) (long "dot" <> help "Output in DOT graph format (default)") <|> flag' (SomeRenderer JSONGraphRenderer) (long "json" <> help "Output JSON graph") - rootDir <- argument (maybeReader readMaybe) (metavar "DIRECTORY") + rootDir <- argument (maybeReader readMaybe :: ReadM FilePath) (metavar "DIRECTORY") language <- argument (maybeReader readMaybe :: ReadM Language) (metavar "LANGUAGE") pure $ runGraph renderer rootDir language @@ -98,7 +96,7 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar parseFilePath arg = case splitWhen (== ':') arg of [a, b] | Just lang <- readMaybe a -> Right (File b lang) | Just lang <- readMaybe b -> Right (File a lang) - [path] -> maybe (Left $ "Cannot identify language for path:" <> path) (Right . File path) (languageForFilePath path) + [path] -> maybe (Left $ "Cannot identify language for path:" <> path) (Right . File path . Just) (languageForFilePath path) _ -> Left ("cannot parse `" <> arg <> "`\nexpecting LANGUAGE:FILE or just FILE") optionsReader options = eitherReader $ \ str -> maybe (Left ("expected one of: " <> intercalate ", " (fmap fst options))) (Right . snd) (find ((== str) . fst) options) diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs index 90c2fb1a6..631129a42 100644 --- a/src/Semantic/IO.hs +++ b/src/Semantic/IO.hs @@ -32,7 +32,6 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Language import Data.Source -import qualified Data.List.NonEmpty as NonEmpty import Prelude hiding (readFile) import Prologue hiding (MonadError (..), fail) import System.Directory (doesDirectoryExist) @@ -47,7 +46,7 @@ readFile :: forall m. MonadIO m => File -> m (Maybe Blob.Blob) readFile (File "/dev/null" _) = pure Nothing readFile (File path language) = do raw <- liftIO (Just <$> B.readFile path) - pure $ Blob.sourceBlob path (Just language) . fromBytes <$> raw + pure $ Blob.sourceBlob path language . fromBytes <$> raw readFilePair :: forall m. MonadIO m => File -> File -> m Blob.BlobPair readFilePair a b = do @@ -92,13 +91,13 @@ readProjectFromPaths rootDir lang = do paths <- liftIO $ fmap fold (globDir (compile . mappend "**/*." <$> exts) rootDir) pure $ Project rootDir (toFile <$> paths) lang where - toFile path = File path lang + 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) - let paths' = catMaybes $ fmap (\p -> File p <$> languageForFilePath p) paths + let paths' = catMaybes $ fmap (\p -> File p . Just <$> languageForFilePath p) paths blobs <- traverse readFile paths' pure (catMaybes blobs) diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 1840b56b4..159581543 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -52,12 +52,18 @@ evalPHPProject path = runAnalysis @(JustEvaluating PHP.Term) <$> evaluateProject evalPythonProject path = runAnalysis @(JustEvaluating Python.Term) <$> evaluateProject pythonParser Language.Python pythonPrelude path evalTypeScriptProject path = runAnalysis @(EvaluatingWithHoles TypeScript.Term) <$> evaluateProject typescriptParser Language.TypeScript Nothing path -rubyPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) Language.Ruby -pythonPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) Language.Python +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) +parseFile :: Parser term -> FilePath -> IO term +parseFile parser = runTask . (parse parser <=< readBlob . file) + +blob :: FilePath -> IO Blob +blob = runTask . readBlob . file + -- Diff helpers diffWithParser :: ( HasField fields Data.Span.Span , HasField fields Range diff --git a/test/Analysis/Go/Spec.hs b/test/Analysis/Go/Spec.hs index a46f0ab7e..97f9672ba 100644 --- a/test/Analysis/Go/Spec.hs +++ b/test/Analysis/Go/Spec.hs @@ -3,6 +3,7 @@ module Analysis.Go.Spec (spec) where import Data.Abstract.Evaluatable (EvalError(..), runAnalysis) import qualified Language.Go.Assignment as Go +import qualified Data.Language as Language import SpecHelpers @@ -31,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 Nothing path + evalGoProject path = runAnalysis @(TestEvaluating Go.Term) <$> evaluateProject goParser Language.Go Nothing path diff --git a/test/Analysis/PHP/Spec.hs b/test/Analysis/PHP/Spec.hs index 31f9361d0..e8a22cb9c 100644 --- a/test/Analysis/PHP/Spec.hs +++ b/test/Analysis/PHP/Spec.hs @@ -3,6 +3,7 @@ module Analysis.PHP.Spec (spec) where import Data.Abstract.Evaluatable (EvalError(..), runAnalysis) import qualified Language.PHP.Assignment as PHP +import qualified Data.Language as Language import SpecHelpers @@ -35,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 Nothing path + evalPHPProject path = runAnalysis @(TestEvaluating PHP.Term) <$> evaluateProject phpParser Language.PHP Nothing path diff --git a/test/Analysis/Python/Spec.hs b/test/Analysis/Python/Spec.hs index 13e970321..39c9edaab 100644 --- a/test/Analysis/Python/Spec.hs +++ b/test/Analysis/Python/Spec.hs @@ -5,6 +5,7 @@ import Data.Abstract.Evaluatable (EvalError(..), runAnalysis) import Data.Abstract.Value import Data.Map import qualified Language.Python.Assignment as Python +import qualified Data.Language as Language import SpecHelpers @@ -50,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 pythonPrelude path + evalPythonProject path = runAnalysis @(TestEvaluating Python.Term) <$> evaluateProject pythonParser Language.Python pythonPrelude path diff --git a/test/Analysis/Ruby/Spec.hs b/test/Analysis/Ruby/Spec.hs index f02cb1d84..0049680b6 100644 --- a/test/Analysis/Ruby/Spec.hs +++ b/test/Analysis/Ruby/Spec.hs @@ -10,6 +10,7 @@ import Data.List.NonEmpty (NonEmpty(..)) import Data.Map import Data.Map.Monoidal as Map import qualified Language.Ruby.Assignment as Ruby +import qualified Data.Language as Language import SpecHelpers @@ -63,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 rubyPrelude path + evalRubyProject path = runAnalysis @(TestEvaluating Ruby.Term) <$> evaluateProject rubyParser Language.Ruby rubyPrelude path diff --git a/test/Analysis/TypeScript/Spec.hs b/test/Analysis/TypeScript/Spec.hs index 528c24b7e..13c6e7f4d 100644 --- a/test/Analysis/TypeScript/Spec.hs +++ b/test/Analysis/TypeScript/Spec.hs @@ -5,6 +5,7 @@ import Data.Abstract.Evaluatable import qualified Language.TypeScript.Assignment as TypeScript import Data.Abstract.Value as Value import Data.Abstract.Number as Number +import qualified Data.Language as Language import SpecHelpers @@ -42,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 Nothing path + evalTypeScriptProject path = runAnalysis @(TestEvaluating TypeScript.Term) <$> evaluateProject typescriptParser Language.TypeScript Nothing path