From 8208a4154f79ecbdbe9e7bc9dba1700fef8be1a4 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 18 Mar 2019 10:53:02 -0700 Subject: [PATCH 1/3] Include function calls in symbols output --- src/Semantic/Api/Symbols.hs | 11 +++++++++-- src/Tags/Taggable.hs | 13 +++++++++++-- src/Tags/Tagging.hs | 12 +++++------- test/Tags/Spec.hs | 30 +++++++++++++++++------------- 4 files changed, 42 insertions(+), 24 deletions(-) diff --git a/src/Semantic/Api/Symbols.hs b/src/Semantic/Api/Symbols.hs index 2f4f43144..a514d9851 100644 --- a/src/Semantic/Api/Symbols.hs +++ b/src/Semantic/Api/Symbols.hs @@ -37,8 +37,12 @@ legacyParseSymbols blobs = Legacy.ParseTreeSymbolResponse <$> distributeFoldMap go blob@Blob{..} = (doParse blob >>= withSomeTerm (renderToSymbols blob)) `catchError` (\(SomeException _) -> pure (pure emptyFile)) where emptyFile = Legacy.File (pack blobPath) (pack (show blobLanguage)) [] + -- Legacy symbols output doesn't include Function Calls. + symbolsToSummarize :: [Text] + symbolsToSummarize = ["Function", "Method", "Class", "Module"] + renderToSymbols :: (IsTaggable f, Applicative m) => Blob -> Term f Location -> m [Legacy.File] - renderToSymbols blob term = pure $ either mempty (pure . tagsToFile blob) (runTagging blob term) + renderToSymbols blob term = pure $ either mempty (pure . tagsToFile blob) (runTagging blob symbolsToSummarize term) tagsToFile :: Blob -> [Tag] -> Legacy.File tagsToFile Blob{..} tags = Legacy.File (pack blobPath) (pack (show blobLanguage)) (fmap tagToSymbol tags) @@ -63,8 +67,11 @@ parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distribut where errorFile e = File (pack blobPath) (bridging # blobLanguage) mempty (V.fromList [ParseError (T.pack e)]) + symbolsToSummarize :: [Text] + symbolsToSummarize = ["Function", "Method", "Class", "Module", "Call", "Send"] + renderToSymbols :: (IsTaggable f, Applicative m) => Blob -> Term f Location -> m File - renderToSymbols blob@Blob{..} term = pure $ either (errorFile . show) (tagsToFile blob) (runTagging blob term) + renderToSymbols blob@Blob{..} term = pure $ either (errorFile . show) (tagsToFile blob) (runTagging blob symbolsToSummarize term) tagsToFile :: Blob -> [Tag] -> File tagsToFile Blob{..} tags = File (pack blobPath) (bridging # blobLanguage) (V.fromList (fmap tagToSymbol tags)) mempty diff --git a/src/Tags/Taggable.hs b/src/Tags/Taggable.hs index e6ea213cb..41a62361b 100644 --- a/src/Tags/Taggable.hs +++ b/src/Tags/Taggable.hs @@ -200,6 +200,17 @@ instance Taggable TypeScript.Module where snippet ann (TypeScript.Module _ _ ) = Just $ locationByteRange ann symbolName = declaredName . TypeScript.moduleIdentifier +instance Taggable Expression.Call where + snippet ann (Expression.Call _ _ _ (Term (In body _))) = Just $ subtractLocation ann body + symbolName = declaredName . Expression.callFunction + +instance Taggable Ruby.Send where + snippet ann (Ruby.Send _ _ _ (Just (Term (In body _)))) = Just $ subtractLocation ann body + snippet ann _ = Just $ locationByteRange ann + symbolName Ruby.Send{..} = case sendSelector of + Just sel -> maybeM Nothing (declaredName sel) + Nothing -> Just (name "call") + instance Taggable [] instance Taggable Comment.Comment instance Taggable Comment.HashBang @@ -209,7 +220,6 @@ instance Taggable Expression.Await instance Taggable Expression.BAnd instance Taggable Expression.BOr instance Taggable Expression.BXOr -instance Taggable Expression.Call instance Taggable Expression.Cast instance Taggable Expression.Comparison instance Taggable Expression.Complement @@ -606,7 +616,6 @@ instance Taggable PHP.PropertyModifier instance Taggable PHP.InterfaceDeclaration instance Taggable PHP.Declare -instance Taggable Ruby.Send instance Taggable Ruby.Require instance Taggable Ruby.Load instance Taggable Ruby.LowPrecedenceAnd diff --git a/src/Tags/Tagging.hs b/src/Tags/Tagging.hs index 2cc205d4b..1cd83ebd9 100644 --- a/src/Tags/Tagging.hs +++ b/src/Tags/Tagging.hs @@ -21,19 +21,17 @@ import Data.Term import Data.Text hiding (empty) import Tags.Taggable -symbolsToSummarize :: [Text] -symbolsToSummarize = ["Function", "Method", "Class", "Module"] - runTagging :: (IsTaggable syntax) => Blob + -> [Text] -> Term syntax Location -> Either TranslationError [Tag] -runTagging blob tree +runTagging blob symbolsToSummarize tree = Eff.run . Error.runError . State.evalState mempty . runT $ source (tagging blob tree) - ~> contextualizing blob + ~> contextualizing blob symbolsToSummarize type ContextToken = (Text, Maybe Range) @@ -41,8 +39,8 @@ type Contextualizer = StateC [ContextToken] ( ErrorC TranslationError PureC) -contextualizing :: Blob -> Machine.ProcessT Contextualizer Token Tag -contextualizing Blob{..} = repeatedly $ await >>= \case +contextualizing :: Blob -> [Text] -> Machine.ProcessT Contextualizer Token Tag +contextualizing Blob{..} symbolsToSummarize = repeatedly $ await >>= \case Enter x r -> enterScope (x, r) Exit x r -> exitScope (x, r) Iden iden span docsLiteralRange -> lift State.get >>= \case diff --git a/test/Tags/Spec.hs b/test/Tags/Spec.hs index 34d9aeba0..1593bdf80 100644 --- a/test/Tags/Spec.hs +++ b/test/Tags/Spec.hs @@ -1,7 +1,8 @@ module Tags.Spec (spec) where -import Tags.Tagging +import Data.Text (Text) import SpecHelpers +import Tags.Tagging spec :: Spec @@ -9,35 +10,35 @@ spec = parallel $ do describe "go" $ do it "produces tags for functions with docs" $ do (blob, tree) <- parseTestFile goParser "test/fixtures/go/tags/simple_functions.go" - runTagging blob tree `shouldBe` Right + runTagging blob symbolsToSummarize tree `shouldBe` Right [ Tag "TestFromBits" "Function" (Span (Pos 6 1) (Pos 7 2)) ["Statements"] (Just "func TestFromBits(t *testing.T)") (Just "// TestFromBits ...") , Tag "Hi" "Function" (Span (Pos 9 1) (Pos 10 2)) ["Statements"] (Just "func Hi()") Nothing ] it "produces tags for methods" $ do (blob, tree) <- parseTestFile goParser "test/fixtures/go/tags/method.go" - runTagging blob tree `shouldBe` Right + runTagging blob symbolsToSummarize tree `shouldBe` Right [ Tag "CheckAuth" "Method" (Span (Pos 3 1) (Pos 3 100)) ["Statements"] (Just "func (c *apiClient) CheckAuth(req *http.Request, user, repo string) (*authenticatedActor, error)") Nothing] describe "javascript and typescript" $ do it "produces tags for functions with docs" $ do (blob, tree) <- parseTestFile typescriptParser "test/fixtures/javascript/tags/simple_function_with_docs.js" - runTagging blob tree `shouldBe` Right + runTagging blob symbolsToSummarize tree `shouldBe` Right [ Tag "myFunction" "Function" (Span (Pos 2 1) (Pos 4 2)) ["Statements"] (Just "function myFunction()") (Just "// This is myFunction") ] it "produces tags for classes" $ do (blob, tree) <- parseTestFile typescriptParser "test/fixtures/typescript/tags/class.ts" - runTagging blob tree `shouldBe` Right + runTagging blob symbolsToSummarize tree `shouldBe` Right [ Tag "FooBar" "Class" (Span (Pos 1 1) (Pos 1 16)) ["Statements"] (Just "class FooBar") Nothing ] it "produces tags for modules" $ do (blob, tree) <- parseTestFile typescriptParser "test/fixtures/typescript/tags/module.ts" - runTagging blob tree `shouldBe` Right + runTagging blob symbolsToSummarize tree `shouldBe` Right [ Tag "APromise" "Module" (Span (Pos 1 1) (Pos 1 20)) ["Statements"] (Just "module APromise { }") Nothing ] describe "python" $ do it "produces tags for functions" $ do (blob, tree) <- parseTestFile pythonParser "test/fixtures/python/tags/simple_functions.py" - runTagging blob tree `shouldBe` Right + runTagging blob symbolsToSummarize tree `shouldBe` Right [ Tag "Foo" "Function" (Span (Pos 1 1) (Pos 5 17)) ["Statements"] (Just "def Foo(x)") Nothing , Tag "Bar" "Function" (Span (Pos 7 1) (Pos 11 13)) ["Statements"] (Just "def Bar()") Nothing , Tag "local" "Function" (Span (Pos 8 5) (Pos 9 17)) ["Statements", "Function", "Statements"] (Just "def local()") Nothing @@ -45,35 +46,35 @@ spec = parallel $ do it "produces tags for functions with docs" $ do (blob, tree) <- parseTestFile pythonParser "test/fixtures/python/tags/simple_function_with_docs.py" - runTagging blob tree `shouldBe` Right + runTagging blob symbolsToSummarize tree `shouldBe` Right [ Tag "Foo" "Function" (Span (Pos 1 1) (Pos 3 13)) ["Statements"] (Just "def Foo(x)") (Just "\"\"\"This is the foo function\"\"\"") ] it "produces tags for classes" $ do (blob, tree) <- parseTestFile pythonParser "test/fixtures/python/tags/class.py" - runTagging blob tree `shouldBe` Right + runTagging blob symbolsToSummarize tree `shouldBe` Right [ Tag "Foo" "Class" (Span (Pos 1 1) (Pos 5 17)) ["Statements"] (Just "class Foo") (Just "\"\"\"The Foo class\"\"\"") , Tag "f" "Function" (Span (Pos 3 5) (Pos 5 17)) ["Statements", "Class", "Statements"] (Just "def f(self)") (Just "\"\"\"The f method\"\"\"") ] it "produces tags for multi-line functions" $ do (blob, tree) <- parseTestFile pythonParser "test/fixtures/python/tags/multiline.py" - runTagging blob tree `shouldBe` Right + runTagging blob symbolsToSummarize tree `shouldBe` Right [ Tag "Foo" "Function" (Span (Pos 1 1) (Pos 3 13)) ["Statements"] (Just "def Foo(x,") Nothing ] describe "ruby" $ do it "produces tags for methods" $ do (blob, tree) <- parseTestFile rubyParser "test/fixtures/ruby/tags/simple_method.rb" - runTagging blob tree `shouldBe` Right + runTagging blob symbolsToSummarize tree `shouldBe` Right [ Tag "foo" "Method" (Span (Pos 1 1) (Pos 2 4)) ["Statements"] (Just "def foo") Nothing ] it "produces tags for methods with docs" $ do (blob, tree) <- parseTestFile rubyParser "test/fixtures/ruby/tags/simple_method_with_docs.rb" - runTagging blob tree `shouldBe` Right + runTagging blob symbolsToSummarize tree `shouldBe` Right [ Tag "foo" "Method" (Span (Pos 2 1) (Pos 3 4)) ["Statements"] (Just "def foo") (Just "# Public: foo") ] it "produces tags for methods and classes with docs" $ do (blob, tree) <- parseTestFile rubyParser "test/fixtures/ruby/tags/class_module.rb" - runTagging blob tree `shouldBe` Right + runTagging blob symbolsToSummarize tree `shouldBe` Right [ Tag "Foo" "Module" (Span (Pos 2 1 ) (Pos 12 4)) ["Statements"] (Just "module Foo") (Just "# Public: Foo") , Tag "Bar" "Class" (Span (Pos 5 3 ) (Pos 11 6)) ["Module", "Context", "Statements"] (Just "class Bar") (Just "# Public: Bar") , Tag "baz" "Method" (Span (Pos 8 5 ) (Pos 10 8)) ["Class", "Context", "Module", "Context", "Statements"] (Just "def baz(a)") (Just "# Public: baz") @@ -81,3 +82,6 @@ spec = parallel $ do , Tag "foo" "Method" (Span (Pos 15 3) (Pos 17 6)) ["Statements", "Class", "Statements"] (Just "def foo") Nothing , Tag "foo" "Method" (Span (Pos 18 3) (Pos 19 6)) ["Statements", "Class", "Statements"] (Just "def self.foo") Nothing ] + +symbolsToSummarize :: [Text] +symbolsToSummarize = ["Function", "Method", "Class", "Module"] From a507a687bee716ef69c65a89ee5b7248f8915c83 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 18 Mar 2019 12:23:54 -0700 Subject: [PATCH 2/3] Just pick out the selector --- src/Tags/Taggable.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/Tags/Taggable.hs b/src/Tags/Taggable.hs index 41a62361b..5912194af 100644 --- a/src/Tags/Taggable.hs +++ b/src/Tags/Taggable.hs @@ -207,9 +207,7 @@ instance Taggable Expression.Call where instance Taggable Ruby.Send where snippet ann (Ruby.Send _ _ _ (Just (Term (In body _)))) = Just $ subtractLocation ann body snippet ann _ = Just $ locationByteRange ann - symbolName Ruby.Send{..} = case sendSelector of - Just sel -> maybeM Nothing (declaredName sel) - Nothing -> Just (name "call") + symbolName Ruby.Send{..} = maybe Nothing declaredName sendSelector instance Taggable [] instance Taggable Comment.Comment From 7865ba7464bda3f3e8df370ce142dd4b98b87f4b Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 18 Mar 2019 12:24:10 -0700 Subject: [PATCH 3/3] Couple of extra tests to show picking out calls --- test/Tags/Spec.hs | 19 ++++++++++++++++--- test/fixtures/go/tags/simple_functions.go | 1 + test/fixtures/ruby/tags/simple_method.rb | 2 ++ 3 files changed, 19 insertions(+), 3 deletions(-) diff --git a/test/Tags/Spec.hs b/test/Tags/Spec.hs index 1593bdf80..04cbb3001 100644 --- a/test/Tags/Spec.hs +++ b/test/Tags/Spec.hs @@ -11,14 +11,19 @@ spec = parallel $ do it "produces tags for functions with docs" $ do (blob, tree) <- parseTestFile goParser "test/fixtures/go/tags/simple_functions.go" runTagging blob symbolsToSummarize tree `shouldBe` Right - [ Tag "TestFromBits" "Function" (Span (Pos 6 1) (Pos 7 2)) ["Statements"] (Just "func TestFromBits(t *testing.T)") (Just "// TestFromBits ...") - , Tag "Hi" "Function" (Span (Pos 9 1) (Pos 10 2)) ["Statements"] (Just "func Hi()") Nothing ] + [ Tag "TestFromBits" "Function" (Span (Pos 6 1) (Pos 8 2)) ["Statements"] (Just "func TestFromBits(t *testing.T) {") (Just "// TestFromBits ...") + , Tag "Hi" "Function" (Span (Pos 10 1) (Pos 11 2)) ["Statements"] (Just "func Hi()") Nothing ] it "produces tags for methods" $ do (blob, tree) <- parseTestFile goParser "test/fixtures/go/tags/method.go" runTagging blob symbolsToSummarize tree `shouldBe` Right [ Tag "CheckAuth" "Method" (Span (Pos 3 1) (Pos 3 100)) ["Statements"] (Just "func (c *apiClient) CheckAuth(req *http.Request, user, repo string) (*authenticatedActor, error)") Nothing] + it "produces tags for calls" $ do + (blob, tree) <- parseTestFile goParser "test/fixtures/go/tags/simple_functions.go" + runTagging blob ["Call"] tree `shouldBe` Right + [ Tag "Hi" "Call" (Span (Pos 7 2) (Pos 7 6)) ["Function", "Context", "Statements"] (Just "Hi()") Nothing] + describe "javascript and typescript" $ do it "produces tags for functions with docs" $ do (blob, tree) <- parseTestFile typescriptParser "test/fixtures/javascript/tags/simple_function_with_docs.js" @@ -65,7 +70,15 @@ spec = parallel $ do it "produces tags for methods" $ do (blob, tree) <- parseTestFile rubyParser "test/fixtures/ruby/tags/simple_method.rb" runTagging blob symbolsToSummarize tree `shouldBe` Right - [ Tag "foo" "Method" (Span (Pos 1 1) (Pos 2 4)) ["Statements"] (Just "def foo") Nothing ] + [ Tag "foo" "Method" (Span (Pos 1 1) (Pos 4 4)) ["Statements"] (Just "def foo") Nothing ] + + it "produces tags for sends" $ do + (blob, tree) <- parseTestFile rubyParser "test/fixtures/ruby/tags/simple_method.rb" + runTagging blob ["Send"] tree `shouldBe` Right + [ Tag "puts" "Send" (Span (Pos 2 3) (Pos 2 12)) ["Statements", "Method", "Statements"] (Just "puts \"hi\"") Nothing + , Tag "bar" "Send" (Span (Pos 3 3) (Pos 3 8)) ["Statements", "Method", "Statements"] (Just "a.bar") Nothing + , Tag "a" "Send" (Span (Pos 3 3) (Pos 3 4)) ["Send", "Statements", "Method", "Statements"] (Just "a") Nothing + ] it "produces tags for methods with docs" $ do (blob, tree) <- parseTestFile rubyParser "test/fixtures/ruby/tags/simple_method_with_docs.rb" diff --git a/test/fixtures/go/tags/simple_functions.go b/test/fixtures/go/tags/simple_functions.go index a9595e745..3b411672d 100644 --- a/test/fixtures/go/tags/simple_functions.go +++ b/test/fixtures/go/tags/simple_functions.go @@ -4,6 +4,7 @@ import "testing" // TestFromBits ... func TestFromBits(t *testing.T) { + Hi() } func Hi() { diff --git a/test/fixtures/ruby/tags/simple_method.rb b/test/fixtures/ruby/tags/simple_method.rb index ff7bbbe94..b3d1487af 100644 --- a/test/fixtures/ruby/tags/simple_method.rb +++ b/test/fixtures/ruby/tags/simple_method.rb @@ -1,2 +1,4 @@ def foo + puts "hi" + a.bar end