github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-05 22:28:10 +03:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into codegen-cleanup

Browse Source
This commit is contained in:
Ayman Nadeem 2020-04-30 13:14:10 -04:00
commit 2f6f950edf
14 changed files with 873 additions and 843 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
docs/codegen.md
View File

@ -1,45 +1,36 @@
@ -1,216 +0,0 @@
# CodeGen Documentation
CodeGen is the process for auto-generating language-specific, strongly-typed ASTs to be used in [Semantic](https://github.com/github/semantic-code/blob/d9f91a05dc30a61b9ff8c536d75661d417f3c506/design-docs/precise-code-navigation.md).
CodeGen is the process for auto-generating language-specific, strongly-typed ASTs to be used in Semantic. Since it is a critical component of Semantic's language support process, we recommend reading [these docs](https://github.com/github/semantic/blob/715971067634f677bff8619add6490e03bb1825e/docs/adding-new-languages.md) first, as they provide an overview of the pipeline CodeGen supports.
### Prerequisites
To get started, first make sure your language has:
## Table of Contents
- [CodeGen Pipeline](#codegen-pipeline)
- [Generating ASTs](#generating-asts)
- [Inspecting auto-generated datatypes](#inspecting-auto-generated-datatypes)
- [Tests](#tests)
- [Additional notes](#additional-notes)
1. An existing [tree-sitter](http://tree-sitter.github.io/tree-sitter/) parser;
2. An existing Cabal package in [tree-sitter](http://tree-sitter.github.io/tree-sitter/) for said language. This will provide an interface into tree-sitter's C source. [Here](https://github.com/tree-sitter/haskell-tree-sitter/tree/master/tree-sitter-python) is an example of a library for Python, a supported language that the remaining documentation will refer to.
## CodeGen Pipeline
### CodeGen Pipeline
The following diagram outlines the entire language support pipeline.
During parser generation, tree-sitter produces a JSON file that captures the structure of a language's grammar. Based on this, we're able to derive datatypes representing surface languages, and then use those datatypes to generically build ASTs. This automates the engineering effort [historically required for adding a new language](https://github.com/github/semantic/blob/master/docs/adding-new-languages.md).
![image](https://user-images.githubusercontent.com/875834/80392707-801e9980-887d-11ea-9c95-e004bbe04be0.png)
The following steps provide a high-level outline of the process:
1. [**Deserialize.**](https://github.com/github/semantic/blob/master/semantic-ast/src/AST/Deserialize.hs) First, we deserialize the `node-types.json` file for a given language into the desired shape of datatypes via parsing capabilities afforded by the [Aeson](http://hackage.haskell.org/package/aeson) library. There are four distinct types represented in the node-types.json file takes on: sums, products, named leaves and anonymous leaves.
2. [**Generate Syntax.**](https://github.com/github/semantic/blob/master/semantic-ast/src/AST/GenerateSyntax.hs) We then use Template Haskell to auto-generate language-specific, strongly-typed datatypes that represent various language constructs. This API exports the top-level function `astDeclarationsForLanguage` to auto-generate datatypes at compile-time, which is is invoked by a given language [AST](https://github.com/github/semantic/blob/master/semantic-python/src/Language/Python/AST.hs) module.
3. [**Unmarshal.**](https://github.com/github/semantic/blob/master/semantic-ast/src/AST/Unmarshal.hs) Unmarshaling is the process of iterating over tree-sitter’s parse trees using its tree cursor API, and producing Haskell ASTs for the relevant nodes. We parse source code from tree-sitter and unmarshal the data we get to build these ASTs generically. This file exports the top-level function `parseByteString`, which takes source code and a language as arguments, and produces an AST.
Here is an example that describes the relationship between a Python identifier represented in the tree-sitter generated JSON file, and a datatype generated by Template Haskell based on the provided JSON:
| Type | JSON | TH-generated code |
|----------|--------------|------------|
|Named leaf|<code>{<br>"type": "identifier",<br>"named": true<br>}|<code>data TreeSitter.Python.AST.Identifier a<br>= TreeSitter.Python.AST.Identifier {TreeSitter.Python.AST.ann :: a,<br>TreeSitter.Python.AST.bytes :: text-1.2.3.1:Data.Text.Internal.Text} -- Defined at TreeSitter/Python/AST.hs:10:1<br>instance Show a => Show (TreeSitter.Python.AST.Identifier a) -- Defined at TreeSitter/Python/AST.hs:10:1<br>instance Ord a => Ord (TreeSitter.Python.AST.Identifier a) -- Defined at TreeSitter/Python/AST.hs:10:1<br>instance Eq a => Eq (TreeSitter.Python.AST.Identifier a) -- Defined at TreeSitter/Python/AST.hs:10:1<br>instance Traversable TreeSitter.Python.AST.Identifier -- Defined at TreeSitter/Python/AST.hs:10:1<br>instance Functor TreeSitter.Python.AST.Identifier -- Defined at TreeSitter/Python/AST.hs:10:1<br>instance Foldable TreeSitter.Python.AST.Identifier -- Defined at TreeSitter/Python/AST.hs:10:1<br>instance Unmarshal TreeSitter.Python.AST.Identifier -- Defined at TreeSitter/Python/AST.hs:10:1<br>instance SymbolMatching TreeSitter.Python.AST.Identifier -- Defined at TreeSitter/Python/AST.hs:10:1|
1. **Ingest source code.** The input to our system is blob data on GitHub.
2. **Write and generate tree-sitter grammar.** During parser generation, tree-sitter produces a `node-types.json` file that captures the structure of a language's grammar. Based on this JSON file, we're able to derive datatypes representing surface languages, and then use those datatypes to generically build ASTs.
3. **Provide interface to the C source.** The FFI provides us a way to bridge tree-sitter to our Haskell library. For more information, see our docs on [adding a new language](https://github.com/github/semantic/blob/master/docs/adding-new-languages.md).
4. **Automated AST generation via CodeGen APIs.** The CodeGen APIs live in the [`semantic-ast`](https://github.com/github/semantic/tree/715971067634f677bff8619add6490e03bb1825e/semantic-ast) package within [Semantic](https://github.com/github/semantic/tree/715971067634f677bff8619add6490e03bb1825e), and are explained as follows:
- [**Deserialize.**](https://github.com/github/semantic/blob/715971067634f677bff8619add6490e03bb1825e/semantic-ast/src/AST/Deserialize.hs) First, we deserialize the `node-types.json` file for a given language into the desired shape of datatypes via parsing capabilities afforded by the [Aeson](http://hackage.haskell.org/package/aeson) library. There are four distinct types represented in the node-types.json file takes on: sums, products, named leaves and anonymous leaves.
- [**Generate Syntax.**](https://github.com/github/semantic/blob/715971067634f677bff8619add6490e03bb1825e/semantic-ast/src/AST/GenerateSyntax.hs) We then use Template Haskell to auto-generate language-specific, strongly-typed datatypes that represent various language constructs at compile-time. This API exports the top-level function `astDeclarationsForLanguage` to auto-generate datatypes at compile-time, which is is invoked by a given language [AST](https://github.com/github/semantic/blob/715971067634f677bff8619add6490e03bb1825e/semantic-python/src/Language/Python/AST.hs) module.
- [**Unmarshal.**](https://github.com/github/semantic/blob/715971067634f677bff8619add6490e03bb1825e/semantic-ast/src/AST/Unmarshal.hs) Unmarshaling is the runtime process of iterating over tree-sitter’s parse trees using its tree cursor API, and producing Haskell ASTs for the relevant nodes. We parse source code from tree-sitter and unmarshal the data we get to build these ASTs generically. This file exports the top-level function `parseByteString`, which takes source code and a language as arguments, and produces an AST.
5. **Generate strongly-typed trees for a given language.** Finally, we create `semantic-[LANGUAGE]` packages (such as [this one](https://github.com/github/semantic/tree/715971067634f677bff8619add6490e03bb1825e/semantic-python) for Python). From here, we can call our CodeGen APIs to generate language-specific, strongly-typed trees via the following process:
1. `Language.[LANGUAGE].AST` calls `astDeclarationsForLanguage`, passing in the relevant language as the argument, and using the `getNodeTypesPath` function to access the tree-sitter generated `node-types.json` file.
2. This triggers the generation of the exhaustive syntax types contained by that language.
3. `Language.[LANGUAGE]` provides the semantic functionality for Python programs, and calls the unmarshal API.
4. Finally, the unmarshaling process takes the source code input, and auto-generates a tree using the syntax nodes generated in step 2.
The remaining document provides more details on generating ASTs, inspecting datatypes, tests, and information on decisions pertaining to relevant APIs.
___
### Table of Contents
- [CodeGen Documentation](#codegen-documentation)
- [Prerequisites](#prerequisites)
- [CodeGen Pipeline](#codegen-pipeline)
- [Table of Contents](#table-of-contents)
- [Generating ASTs](#generating-asts)
- [Inspecting auto-generated datatypes](#inspecting-auto-generated-datatypes)
- [Tests](#tests)
- [Additional notes](#additional-notes)
___
### Generating ASTs
## Generating ASTs
To parse source code and produce ASTs locally:
@ -72,7 +63,9 @@ This generates the following AST:
Right (Module {ann = (Span {start = Pos {line = 0, column = 0}, end = Pos {line = 0, column = 1}},Range {start = 0, end = 1}), extraChildren = [R1 (SimpleStatement {getSimpleStatement = L1 (R1 (R1 (L1 (ExpressionStatement {ann = (Span {start = Pos {line = 0, column = 0}, end = Pos {line = 0, column = 1}},Range {start = 0, end = 1}), extraChildren = L1 (L1 (Expression {getExpression = L1 (L1 (L1 (PrimaryExpression {getPrimaryExpression = R1 (L1 (L1 (L1 (Integer {ann = (Span {start = Pos {line = 0, column = 0}, end = Pos {line = 0, column = 1}},Range {start = 0, end = 1}), text = "1"}))))})))})) :| []}))))})]})
```
### Inspecting auto-generated datatypes
`Unmarshal` defines both generic and non-generic classes. This is because generic behaviors are different than what we get non-generically, and in the case of ` Maybe`, `[]`, and `NonEmpty`, we prefer non-generic behavior. Since `[]` is a sum, the generic behavior for `:+:` would be invoked. The generic `:+:` expects repetitions represented in the parse tree as right-nested singly-linked lists (ex., `(a (b (c (d…))))`), rather than as consecutive sibling nodes (ex., `(a b c ...d)`, which is what our trees have. We want to match the latter.
## Inspecting auto-generated datatypes
Datatypes are derived from a language and its `node-types.json` file using the `GenerateSyntax` API. These datatypes can be viewed in the REPL just as they would for any other datatype, using `:i` after loading the language-specific `AST.hs` module for a given language.
@ -104,7 +97,17 @@ instance Foldable Module
-- Defined at /Users/aymannadeem/github/semantic/semantic-python/src/Language/Python/AST.hs:23:1
```
### Tests
Here is an example that describes the relationship between a Python identifier represented in the tree-sitter generated JSON file, and a datatype generated by Template Haskell based on the provided JSON:
| Type | JSON | TH-generated code |
|----------|--------------|------------|
|Named leaf|<pre>{<br>"type": "identifier",<br>"named": true<br>}|<code>data TreeSitter.Python.AST.Identifier a<br>= TreeSitter.Python.AST.Identifier {TreeSitter.Python.AST.ann :: a,<br>TreeSitter.Python.AST.bytes :: text-1.2.3.1:Data.Text.Internal.Text} -- Defined at TreeSitter/Python/AST.hs:10:1<br>instance Show a => Show (TreeSitter.Python.AST.Identifier a) -- Defined at TreeSitter/Python/AST.hs:10:1<br>instance Ord a => Ord (TreeSitter.Python.AST.Identifier a) -- Defined at TreeSitter/Python/AST.hs:10:1<br>instance Eq a => Eq (TreeSitter.Python.AST.Identifier a) -- Defined at TreeSitter/Python/AST.hs:10:1<br>instance Traversable TreeSitter.Python.AST.Identifier -- Defined at TreeSitter/Python/AST.hs:10:1<br>instance Functor TreeSitter.Python.AST.Identifier -- Defined at TreeSitter/Python/AST.hs:10:1<br>instance Foldable TreeSitter.Python.AST.Identifier -- Defined at TreeSitter/Python/AST.hs:10:1<br>instance Unmarshal TreeSitter.Python.AST.Identifier -- Defined at TreeSitter/Python/AST.hs:10:1<br>instance SymbolMatching TreeSitter.Python.AST.Identifier -- Defined at TreeSitter/Python/AST.hs:10:1|
Annotations are captured by a polymorphic parameter `a` instead of range/span values.
[Examples](https://github.com/github/semantic/blob/715971067634f677bff8619add6490e03bb1825e/semantic-ast/src/AST/Grammar/Examples.hs) contains a set of pre-defined, hand-written datatypes for which Template Haskell is not used. Any datatypes among the node types defined here will be skipped when the splice is run, allowing customization of the representation of parts of the tree. While this gives us flexibility, we encourage that this is used sparingly, as it imposes extra maintenance burden, particularly when the grammar is changed. This may be used to e.g. parse literals into Haskell equivalents (e.g. parsing the textual contents of integer literals into `Integer`s), and may require defining `TS.UnmarshalAnn` or `TS.SymbolMatching` instances for (parts of) the custom datatypes, depending on where and how the datatype occurs in the generated tree, in addition to the usual `Foldable`, `Functor`, etc. instances provided for generated datatypes.
## Tests
As of right now, Hedgehog tests are minimal and only in place for the Python library.
@ -112,8 +115,16 @@ To run tests:
`cabal v2-test semantic-python`
### Additional notes
## Background and Motivation for CodeGen
- [GenerateSyntax](https://github.com/tree-sitter/haskell-tree-sitter/blob/master/tree-sitter/src/TreeSitter/GenerateSyntax.hs) provides a way to pre-define certain datatypes for which Template Haskell is not used. Any datatypes among the node types which have already been defined in the module where the splice is run will be skipped, allowing customization of the representation of parts of the tree. While this gives us flexibility, we encourage that this is used sparingly, as it imposes extra maintenance burden, particularly when the grammar is changed. This may be used to e.g. parse literals into Haskell equivalents (e.g. parsing the textual contents of integer literals into `Integer`s), and may require defining `TS.UnmarshalAnn` or `TS.SymbolMatching` instances for (parts of) the custom datatypes, depending on where and how the datatype occurs in the generated tree, in addition to the usual `Foldable`, `Functor`, etc. instances provided for generated datatypes.
- Annotations are captured by a polymorphic parameter `a`
- [Unmarshal](https://github.com/tree-sitter/haskell-tree-sitter/blob/master/tree-sitter/src/TreeSitter/Unmarshal.hs) defines both generic and non-generic classes. This is because generic behaviors are different than what we get non-generically, and in the case of ` Maybe`, `[]`—we actually preference doing things non-generically. Since `[]` is a sum, the generic behavior for `:+:` would be invoked and expect that we’d have repetitions represented in the parse tree as right-nested singly-linked lists (ex., `(a (b (c (d…))))`) rather than as just consecutive sibling nodes (ex., `(a b c ...d)`, which is what our trees have). We want to match the latter.
CodeGen automates the engineering effort historically required for adding a new language, which included writing a second [assignment](https://github.com/github/semantic/blob/715971067634f677bff8619add6490e03bb1825e/docs/assignment.md) grammar, along with manually defining [data types à la carte](http://www.cs.ru.nl/~W.Swierstra/Publications/DataTypesALaCarte.pdf).
CodeGen addresses the following challenges posed by the old system:
**1. No named child nodes.** Tree-sitter’s syntax nodes didn’t provide us with named child nodes, just ordered-lists. In other words, the children were structured as an ordered list, without any name indicating the role of each child. This didn’t match Semantic’s internal representation of syntax nodes, where each type of node has a specific set of named children. This created concerns which meant more Assignment work was necessary to compensate for this discrepancy. For instance, one concern being the way we represent comments, which could be any arbitrary node attached to any part of the AST. But if we had named child nodes, this would allow us to associate comments relative to their parent nodes (for example, if a comment appeared in an if statement, it could be the first child for that if-statement node). However in the old system, comments as well as heredocs could appear anywhere are a source of errors.
**2. Time and effort.** Our system involves a two-step parsing process, which requires writing two separate language-specific grammars by hand. This is super time-consuming, very developer-intensive, error-prone, and extremely tedious. [Assignment](https://github.com/github/semantic/blob/715971067634f677bff8619add6490e03bb1825e/docs/assignment.md) requires writing a grammar using parser combinators in Haskell that are really close to the tree-sitter grammar specification. The mechanical nature of this work has, for a long time, begged the question of whether we could automate parts of it. Although we’ve open-sourced Semantic, it’s still tough to leverage community support for adding languages with such a grueling process behind it and a brittle system.
**3. Brittle.** Each language's Assignment code was tightly coupled to the language's Tree-sitter grammar, and it could break at runtime if we changed the structure of the grammar, without any compile-time error. This meant tracking ongoing changes in tree-sitter. This was also tedious, manual, and error prone. Bumping grammars meant making changes to assignment to accommodate new tree-structures, like nodes that have changed names or positions, etc.
**4. Evaluation and a la carte sum types.** This also gave us an opportunity to re-think our [à la carte datatypes](http://www.cs.ru.nl/~W.Swierstra/Publications/DataTypesALaCarte.pdf), as well as the evaluation machinery. À la carte syntax types were motivated by a desire to migrate away from a previous representation of syntax in favor of creating a way to better share effort and tooling involved in diffing, and especially in evaluating common fragments of languages: for example, most languages share if statements, functions, while loops, etc. However, the introduction of these syntax types (and the design of the `Evaluatable` typeclass) made it hard for us to make our analysis sensitive to minor linguistic differences, or even to relate different pieces of syntax together. This is because our à la carte syntax is essentially untyped, in that it enforces only a minimal structure on the tree; but any given subterm can be any element of the syntax, and not some limited subset. This means that a number of `Evaluatable` instances have to deal with error conditions that in practice can’t occur. For example, `function`, `method`, and `class` declarations have a term for their name field, and thus have to deal with the possibility that the term doesn’t have a `declaredName` by throwing an error if this arises. 

173
semantic-codeql/src/Language/CodeQL/Tags.hs
View File

@ -4,37 +4,39 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Language.CodeQL.Tags
( ToTags(..)
) where
import AST.Element
import AST.Token
import AST.Traversable1
import Control.Effect.Reader
import Control.Effect.Writer
import Data.Foldable (for_)
import Data.Text (Text)
module Language.CodeQL.Tags
( ToTags (..),
)
where
import AST.Element
import AST.Token
import AST.Traversable1
import Control.Effect.Reader
import Control.Effect.Writer
import Data.Foldable (for_)
import Data.Text (Text)
import qualified Language.CodeQL.AST as CodeQL
import Source.Loc
import Source.Source as Source
import Tags.Tag
import Source.Loc
import Source.Source as Source
import Tags.Tag
import qualified Tags.Tagging.Precise as Tags
class ToTags t where
tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
)
=> t Loc
-> m ()
default tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Traversable1 ToTags t
)
=> t Loc
-> m ()
tags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m
) =>
t Loc ->
m ()
default tags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Traversable1 ToTags t
) =>
t Loc ->
m ()
tags = gtags
instance ToTags (Token sym n) where tags _ = pure ()
@ -43,85 +45,94 @@ instance (ToTags l, ToTags r) => ToTags (l :+: r) where
tags (L1 l) = tags l
tags (R1 r) = tags r
gtags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Traversable1 ToTags t
)
=> t Loc
-> m ()
gtags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Traversable1 ToTags t
) =>
t Loc ->
m ()
gtags = traverse1_ @ToTags (const (pure ())) tags
yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m ()
yieldTag name kind loc range = do
yieldTag name kind loc srcLineRange = do
src <- ask @Source
Tags.yield (Tag name kind loc (Tags.firstLine src range) Nothing)
Tags.yield (Tag name kind loc (Tags.firstLine src srcLineRange) Nothing)
instance ToTags CodeQL.Module where
tags t@CodeQL.Module
{ ann = loc@Loc { byteRange }
, name = CodeQL.ModuleName { extraChildren = CodeQL.SimpleId { text } }
} = yieldTag text Module loc byteRange >> gtags t
tags
t@CodeQL.Module
{ ann = Loc {byteRange},
name = CodeQL.ModuleName {extraChildren = CodeQL.SimpleId {text, ann}}
} = yieldTag text Module ann byteRange >> gtags t
instance ToTags CodeQL.ClasslessPredicate where
tags t@CodeQL.ClasslessPredicate
{ ann = loc@Loc { byteRange }
, name = CodeQL.PredicateName { text }
} = yieldTag text Function loc byteRange >> gtags t
tags
t@CodeQL.ClasslessPredicate
{ ann = Loc {byteRange},
name = CodeQL.PredicateName {text, ann}
} = yieldTag text Function ann byteRange >> gtags t
instance ToTags CodeQL.AritylessPredicateExpr where
tags t@CodeQL.AritylessPredicateExpr
{ ann = loc@Loc { byteRange }
, name = CodeQL.LiteralId { text }
} = yieldTag text Call loc byteRange >> gtags t
tags
t@CodeQL.AritylessPredicateExpr
{ ann = Loc {byteRange},
name = CodeQL.LiteralId {text, ann}
} = yieldTag text Call ann byteRange >> gtags t
instance ToTags CodeQL.Dataclass where
tags t@CodeQL.Dataclass
{ ann = loc@Loc { byteRange }
, name = CodeQL.ClassName { text }
} = yieldTag text Class loc byteRange >> gtags t
tags
t@CodeQL.Dataclass
{ ann = Loc {byteRange},
name = CodeQL.ClassName {text, ann}
} = yieldTag text Class ann byteRange >> gtags t
instance ToTags CodeQL.MemberPredicate where
tags t@CodeQL.MemberPredicate
{ ann = loc@Loc { byteRange }
, name = CodeQL.PredicateName { text }
} = yieldTag text Method loc byteRange >> gtags t
tags
t@CodeQL.MemberPredicate
{ ann = Loc {byteRange},
name = CodeQL.PredicateName {text, ann}
} = yieldTag text Method ann byteRange >> gtags t
instance ToTags CodeQL.Datatype where
tags t@CodeQL.Datatype
{ ann = loc@Loc { byteRange }
, name = CodeQL.ClassName { text }
} = yieldTag text Class loc byteRange >> gtags t
tags
t@CodeQL.Datatype
{ ann = Loc {byteRange},
name = CodeQL.ClassName {text, ann}
} = yieldTag text Class ann byteRange >> gtags t
instance ToTags CodeQL.DatatypeBranch where
tags t@CodeQL.DatatypeBranch
{ ann = loc@Loc { byteRange }
, name = CodeQL.ClassName { text }
} = yieldTag text Class loc byteRange >> gtags t
tags
t@CodeQL.DatatypeBranch
{ ann = Loc {byteRange},
name = CodeQL.ClassName {text, ann}
} = yieldTag text Class ann byteRange >> gtags t
instance ToTags CodeQL.ClasslessPredicateCall where
tags CodeQL.ClasslessPredicateCall
{ extraChildren
} = for_ extraChildren $ \x -> case x of
Prj t@CodeQL.AritylessPredicateExpr {} -> tags t
_ -> pure ()
tags
CodeQL.ClasslessPredicateCall
{ extraChildren
} = for_ extraChildren $ \x -> case x of
Prj t@CodeQL.AritylessPredicateExpr {} -> tags t
_ -> pure ()
instance ToTags CodeQL.QualifiedRhs where
tags t@CodeQL.QualifiedRhs
{ ann = loc@Loc { byteRange }
, name = expr
} = case expr of
Just (Prj CodeQL.PredicateName { text }) -> yieldTag text Call loc byteRange >> gtags t
_ -> gtags t
tags
t@CodeQL.QualifiedRhs
{ ann = Loc {byteRange},
name = expr
} = case expr of
Just (Prj CodeQL.PredicateName {text, ann}) -> yieldTag text Call ann byteRange >> gtags t
_ -> gtags t
instance ToTags CodeQL.TypeExpr where
tags t@CodeQL.TypeExpr
{ ann = loc@Loc { byteRange }
, name = expr
} = case expr of
Just (Prj CodeQL.ClassName { text }) -> yieldTag text Type loc byteRange >> gtags t
_ -> gtags t
tags
t@CodeQL.TypeExpr
{ ann = Loc {byteRange},
name = expr
} = case expr of
Just (Prj CodeQL.ClassName {text, ann}) -> yieldTag text Type ann byteRange >> gtags t
_ -> gtags t
instance ToTags CodeQL.AddExpr
instance ToTags CodeQL.Addop

112
semantic-go/src/Language/Go/Tags.hs
View File

@ -1,66 +1,70 @@
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE DefaultSignatures #-}{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Language.Go.Tags
( ToTags(..)
) where
import AST.Element
import AST.Token
import AST.Traversable1
import Control.Effect.Reader
import Control.Effect.Writer
import Data.Text as Text
module Language.Go.Tags
( ToTags (..),
)
where
import AST.Element
import AST.Token
import AST.Traversable1
import Control.Effect.Reader
import Control.Effect.Writer
import Data.Text as Text
import qualified Language.Go.AST as Go
import Source.Loc
import Source.Source as Source
import Tags.Tag
import Source.Loc
import Source.Source as Source
import Tags.Tag
import qualified Tags.Tagging.Precise as Tags
class ToTags t where
tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
)
=> t Loc
-> m ()
default tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Traversable1 ToTags t
)
=> t Loc
-> m ()
tags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m
) =>
t Loc ->
m ()
default tags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Traversable1 ToTags t
) =>
t Loc ->
m ()
tags = gtags
instance ToTags Go.FunctionDeclaration where
tags t@Go.FunctionDeclaration
{ ann = loc@Loc { byteRange }
, name = Go.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t
tags
t@Go.FunctionDeclaration
{ ann = Loc {byteRange},
name = Go.Identifier {text, ann}
} = yieldTag text Function ann byteRange >> gtags t
instance ToTags Go.MethodDeclaration where
tags t@Go.MethodDeclaration
{ ann = loc@Loc { byteRange }
, name = Go.FieldIdentifier { text }
} = yieldTag text Method loc byteRange >> gtags t
tags
t@Go.MethodDeclaration
{ ann = Loc {byteRange},
name = Go.FieldIdentifier {text, ann}
} = yieldTag text Method ann byteRange >> gtags t
instance ToTags Go.CallExpression where
tags t@Go.CallExpression
{ ann = loc@Loc { byteRange }
, function = Go.Expression expr
} = match expr
tags
t@Go.CallExpression
{ ann = Loc {byteRange},
function = Go.Expression expr
} = match expr
where
match expr = case expr of
Prj Go.SelectorExpression { field = Go.FieldIdentifier { text }} -> yield text
Prj Go.Identifier { text } -> yield text
Prj Go.CallExpression { function = Go.Expression e } -> match e
Prj Go.ParenthesizedExpression { extraChildren = Go.Expression e } -> match e
_ -> gtags t
yield name = yieldTag name Call loc byteRange >> gtags t
Prj Go.SelectorExpression {field = Go.FieldIdentifier {text, ann}} -> yield text ann
Prj Go.Identifier {text, ann} -> yield text ann
Prj Go.CallExpression {function = Go.Expression e} -> match e
Prj Go.ParenthesizedExpression {extraChildren = Go.Expression e} -> match e
_ -> gtags t
yield name loc = yieldTag name Call loc byteRange >> gtags t
instance (ToTags l, ToTags r) => ToTags (l :+: r) where
tags (L1 l) = tags l
@ -68,19 +72,19 @@ instance (ToTags l, ToTags r) => ToTags (l :+: r) where
instance ToTags (Token sym n) where tags _ = pure ()
gtags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Traversable1 ToTags t
)
=> t Loc
-> m ()
gtags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Traversable1 ToTags t
) =>
t Loc ->
m ()
gtags = traverse1_ @ToTags (const (pure ())) tags
yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m ()
yieldTag name kind loc range = do
yieldTag name kind loc srcLineRange = do
src <- ask @Source
Tags.yield (Tag name kind loc (Tags.firstLine src range) Nothing)
Tags.yield (Tag name kind loc (Tags.firstLine src srcLineRange) Nothing)
instance ToTags Go.ArgumentList

142
semantic-java/src/Language/Java/Tags.hs
View File

@ -4,36 +4,39 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Language.Java.Tags
( ToTags(..)
) where
import AST.Token
import AST.Traversable1
import Control.Effect.Reader
import Control.Effect.Writer
import GHC.Generics ((:+:)(..))
module Language.Java.Tags
( ToTags (..),
)
where
import AST.Element
import AST.Token
import AST.Traversable1
import Control.Effect.Reader
import Control.Effect.Writer
import Data.Foldable
import qualified Language.Java.AST as Java
import Source.Loc
import Source.Range
import Source.Source as Source
import Tags.Tag
import Source.Loc
import Source.Range
import Source.Source as Source
import Tags.Tag
import qualified Tags.Tagging.Precise as Tags
class ToTags t where
tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
)
=> t Loc
-> m ()
default tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Traversable1 ToTags t
)
=> t Loc
-> m ()
tags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m
) =>
t Loc ->
m ()
default tags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Traversable1 ToTags t
) =>
t Loc ->
m ()
tags = gtags
instance (ToTags l, ToTags r) => ToTags (l :+: r) where
@ -43,47 +46,74 @@ instance (ToTags l, ToTags r) => ToTags (l :+: r) where
instance ToTags (Token sym n) where tags _ = pure ()
instance ToTags Java.MethodDeclaration where
tags t@Java.MethodDeclaration
{ ann = loc@Loc { byteRange = range }
, name = Java.Identifier { text = name }
, body
} = do
tags
t@Java.MethodDeclaration
{ ann = Loc {byteRange = range},
name = Java.Identifier {text, ann},
body
} = do
src <- ask @Source
let line = Tags.firstLine src range
{ end = case body of
Just Java.Block { ann = Loc Range { end } _ } -> end
Nothing -> end range
}
Tags.yield (Tag name Method loc line Nothing)
let line =
Tags.firstLine
src
range
{ end = case body of
Just Java.Block {ann = Loc Range {end} _} -> end
Nothing -> end range
}
Tags.yield (Tag text Method ann line Nothing)
gtags t
-- TODO: we can coalesce a lot of these instances given proper use of HasField
-- to do the equivalent of type-generic pattern-matching.
instance ToTags Java.ClassDeclaration where
tags t@Java.ClassDeclaration
{ ann = loc@Loc { byteRange = Range { start } }
, name = Java.Identifier { text = name }
, body = Java.ClassBody { ann = Loc Range { start = end } _ }
} = do
tags
t@Java.ClassDeclaration
{ ann = Loc {byteRange = Range {start}},
name = Java.Identifier {text, ann},
body = Java.ClassBody {ann = Loc Range {start = end} _}
} = do
src <- ask @Source
Tags.yield (Tag name Class loc (Tags.firstLine src (Range start end)) Nothing)
Tags.yield (Tag text Class ann (Tags.firstLine src (Range start end)) Nothing)
gtags t
instance ToTags Java.MethodInvocation where
tags t@Java.MethodInvocation
{ ann = loc@Loc { byteRange = range }
, name = Java.Identifier { text = name }
} = do
tags
t@Java.MethodInvocation
{ ann = Loc {byteRange = range},
name = Java.Identifier {text, ann}
} = do
src <- ask @Source
Tags.yield (Tag name Call loc (Tags.firstLine src range) Nothing)
Tags.yield (Tag text Call ann (Tags.firstLine src range) Nothing)
gtags t
instance ToTags Java.InterfaceDeclaration where
tags
t@Java.InterfaceDeclaration
{ ann = Loc {byteRange},
name = Java.Identifier {text, ann}
} = do
src <- ask @Source
Tags.yield (Tag text Interface ann (Tags.firstLine src byteRange) Nothing)
gtags t
gtags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Traversable1 ToTags t
)
=> t Loc
-> m ()
instance ToTags Java.InterfaceTypeList where
tags t@Java.InterfaceTypeList {extraChildren = interfaces} = do
src <- ask @Source
for_ interfaces $ \x -> case x of
Java.Type (Prj (Java.UnannotatedType (Prj (Java.SimpleType (Prj Java.TypeIdentifier {ann = loc@Loc {byteRange = range}, text = name}))))) ->
Tags.yield (Tag name Implementation loc (Tags.firstLine src range) Nothing)
_ -> pure ()
gtags t
gtags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Traversable1 ToTags t
) =>
t Loc ->
m ()
gtags = traverse1_ @ToTags (const (pure ())) tags
instance ToTags Java.AnnotatedType
@ -153,8 +183,8 @@ instance ToTags Java.InferredParameters
instance ToTags Java.InstanceofExpression
instance ToTags Java.IntegralType
instance ToTags Java.InterfaceBody
instance ToTags Java.InterfaceDeclaration
instance ToTags Java.InterfaceTypeList
--instance ToTags Java.InterfaceDeclaration
-- instance ToTags Java.InterfaceTypeList
instance ToTags Java.LabeledStatement
instance ToTags Java.LambdaExpression
instance ToTags Java.Literal

121
semantic-php/src/Language/PHP/Tags.hs
View File

@ -5,34 +5,38 @@
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Language.PHP.Tags (tags) where
import AST.Element
import AST.Token
import AST.Traversable1
import Control.Effect.Reader
import Control.Effect.Writer
import Data.Text (Text)
module Language.PHP.Tags
( tags,
)
where
import AST.Element
import AST.Token
import AST.Traversable1
import Control.Effect.Reader
import Control.Effect.Writer
import Data.Text (Text)
import qualified Language.PHP.AST as PHP
import Source.Loc
import Source.Source as Source
import Tags.Tag
import Source.Loc
import Source.Source as Source
import Tags.Tag
import qualified Tags.Tagging.Precise as Tags
class ToTags t where
tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
)
=> t Loc
-> m ()
default tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Traversable1 ToTags t
)
=> t Loc
-> m ()
tags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m
) =>
t Loc ->
m ()
default tags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Traversable1 ToTags t
) =>
t Loc ->
m ()
tags = gtags
instance ToTags (Token sym n) where tags _ = pure ()
@ -41,55 +45,56 @@ instance (ToTags l, ToTags r) => ToTags (l :+: r) where
tags (L1 l) = tags l
tags (R1 r) = tags r
gtags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Traversable1 ToTags t
)
=> t Loc
-> m ()
gtags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Traversable1 ToTags t
) =>
t Loc ->
m ()
gtags = traverse1_ @ToTags (const (pure ())) tags
yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m ()
yieldTag name kind loc range = do
yieldTag name kind loc srcLineRange = do
src <- ask @Source
Tags.yield (Tag name kind loc (Tags.firstLine src range) Nothing)
Tags.yield (Tag name kind loc (Tags.firstLine src srcLineRange) Nothing)
instance ToTags PHP.FunctionDefinition where
tags t@PHP.FunctionDefinition
{ PHP.ann = loc@Loc { byteRange }
, PHP.name = PHP.Name { text }
} = yieldTag text Method loc byteRange >> gtags t
tags
t@PHP.FunctionDefinition
{ PHP.ann = Loc {byteRange},
PHP.name = PHP.Name {text, ann}
} = yieldTag text Method ann byteRange >> gtags t
instance ToTags PHP.MethodDeclaration where
tags t@PHP.MethodDeclaration
{ PHP.ann = loc@Loc { byteRange }
, PHP.name = PHP.Name { text }
} = yieldTag text Function loc byteRange >> gtags t
tags
t@PHP.MethodDeclaration
{ PHP.ann = Loc {byteRange},
PHP.name = PHP.Name {text, ann}
} = yieldTag text Function ann byteRange >> gtags t
instance ToTags PHP.FunctionCallExpression where
tags t@PHP.FunctionCallExpression
{ PHP.ann = loc@Loc { byteRange }
, PHP.function = func
} = match func
tags
t@PHP.FunctionCallExpression
{ PHP.ann = Loc {byteRange},
PHP.function = func
} = match func
where
yield name = yieldTag name Call loc byteRange >> gtags t
yield name loc = yieldTag name Call loc byteRange >> gtags t
match expr = case expr of
Prj (PHP.VariableName { extraChildren = PHP.Name { text } })
-> yield text *> gtags t
Prj (PHP.QualifiedName { extraChildren = [Prj (PHP.Name { text })] })
-> yield text *> gtags t
_
-> gtags t
Prj PHP.VariableName {extraChildren = PHP.Name {text, ann}} -> yield text ann *> gtags t
Prj PHP.QualifiedName {extraChildren = [Prj PHP.Name {text, ann}]} -> yield text ann *> gtags t
_ -> gtags t
instance ToTags PHP.MemberCallExpression where
tags t@PHP.MemberCallExpression
{ PHP.ann = loc@Loc { byteRange }
, PHP.name = item
} = case item of
Prj (PHP.Name { text }) -> yieldTag text Call loc byteRange >> gtags t
_ -> gtags t
tags
t@PHP.MemberCallExpression
{ PHP.ann = Loc {byteRange},
PHP.name = Prj PHP.Name {text, ann}
} = yieldTag text Call ann byteRange >> gtags t
tags t = gtags t
instance ToTags PHP.AnonymousFunctionCreationExpression

173
semantic-python/src/Language/Python/Tags.hs
View File

@ -5,40 +5,42 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Language.Python.Tags
( ToTags(..)
) where
import AST.Element
import AST.Token
import AST.Traversable1
import Control.Effect.Reader
import Control.Effect.Writer
import Data.Foldable
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (listToMaybe)
import Data.Text as Text
module Language.Python.Tags
( ToTags (..),
)
where
import AST.Element
import AST.Token
import AST.Traversable1
import Control.Effect.Reader
import Control.Effect.Writer
import Data.Foldable
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (listToMaybe)
import Data.Text as Text
import qualified Language.Python.AST as Py
import Source.Loc
import Source.Range
import Source.Source as Source
import Tags.Tag
import Source.Loc
import Source.Range
import Source.Source as Source
import Tags.Tag
import qualified Tags.Tagging.Precise as Tags
class ToTags t where
tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
)
=> t Loc
-> m ()
default tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Traversable1 ToTags t
)
=> t Loc
-> m ()
tags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m
) =>
t Loc ->
m ()
default tags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Traversable1 ToTags t
) =>
t Loc ->
m ()
tags = gtags
instance (ToTags l, ToTags r) => ToTags (l :+: r) where
@ -47,98 +49,105 @@ instance (ToTags l, ToTags r) => ToTags (l :+: r) where
instance ToTags (Token sym n) where tags _ = pure ()
keywordFunctionCall
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Traversable1 ToTags t
)
=> t Loc -> Loc -> Range -> Text -> m ()
keywordFunctionCall ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Traversable1 ToTags t
) =>
t Loc ->
Loc ->
Range ->
Text ->
m ()
keywordFunctionCall t loc range name = yieldTag name Function loc range Nothing >> gtags t
instance ToTags Py.String where
tags Py.String { extraChildren } = for_ extraChildren $ \ x -> case x of
Prj t@Py.Interpolation { } -> tags t
_ -> pure ()
tags Py.String {extraChildren} = for_ extraChildren $ \x -> case x of
Prj t@Py.Interpolation {} -> tags t
_ -> pure ()
instance ToTags Py.Interpolation where
tags Py.Interpolation { extraChildren } = for_ extraChildren $ \ x -> case x of
tags Py.Interpolation {extraChildren} = for_ extraChildren $ \x -> case x of
Prj (Py.Expression expr) -> tags expr
_ -> pure ()
_ -> pure ()
instance ToTags Py.AssertStatement where
tags t@Py.AssertStatement { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "assert"
tags t@Py.AssertStatement {ann = loc@Loc {byteRange}} = keywordFunctionCall t loc byteRange "assert"
instance ToTags Py.Await where
tags t@Py.Await { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "await"
tags t@Py.Await {ann = loc@Loc {byteRange}} = keywordFunctionCall t loc byteRange "await"
instance ToTags Py.DeleteStatement where
tags t@Py.DeleteStatement { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "del"
tags t@Py.DeleteStatement {ann = loc@Loc {byteRange}} = keywordFunctionCall t loc byteRange "del"
instance ToTags Py.ExecStatement where
tags t@Py.ExecStatement { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "exec"
tags t@Py.ExecStatement {ann = loc@Loc {byteRange}} = keywordFunctionCall t loc byteRange "exec"
instance ToTags Py.GlobalStatement where
tags t@Py.GlobalStatement { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "global"
tags t@Py.GlobalStatement {ann = loc@Loc {byteRange}} = keywordFunctionCall t loc byteRange "global"
instance ToTags Py.NonlocalStatement where
tags t@Py.NonlocalStatement { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "nonlocal"
tags t@Py.NonlocalStatement {ann = loc@Loc {byteRange}} = keywordFunctionCall t loc byteRange "nonlocal"
instance ToTags Py.PrintStatement where
tags t@Py.PrintStatement { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "print"
tags t@Py.PrintStatement {ann = loc@Loc {byteRange}} = keywordFunctionCall t loc byteRange "print"
instance ToTags Py.FunctionDefinition where
tags t@Py.FunctionDefinition
{ ann = loc@Loc { byteRange = Range { start } }
, name = Py.Identifier { text = name }
, body = Py.Block { ann = Loc Range { start = end } _, extraChildren }
} = do
tags
t@Py.FunctionDefinition
{ ann = Loc {byteRange = Range {start}},
name = Py.Identifier {text, ann},
body = Py.Block {ann = Loc Range {start = end} _, extraChildren}
} = do
src <- ask @Source
let docs = listToMaybe extraChildren >>= docComment src
yieldTag name Function loc (Range start end) docs >> gtags t
yieldTag text Function ann (Range start end) docs >> gtags t
instance ToTags Py.ClassDefinition where
tags t@Py.ClassDefinition
{ ann = loc@Loc { byteRange = Range { start } }
, name = Py.Identifier { text = name }
, body = Py.Block { ann = Loc Range { start = end } _, extraChildren }
} = do
tags
t@Py.ClassDefinition
{ ann = Loc {byteRange = Range {start}},
name = Py.Identifier {text, ann},
body = Py.Block {ann = Loc Range {start = end} _, extraChildren}
} = do
src <- ask @Source
let docs = listToMaybe extraChildren >>= docComment src
yieldTag name Class loc (Range start end) docs >> gtags t
yieldTag text Class ann (Range start end) docs >> gtags t
instance ToTags Py.Call where
tags t@Py.Call
{ ann = loc@Loc { byteRange = range }
, function = Py.PrimaryExpression expr
} = match expr
where
match expr = case expr of
(Prj Py.Attribute { attribute = Py.Identifier _ name }) -> yield name
(Prj (Py.Identifier _ name)) -> yield name
(Prj Py.Call { function = Py.PrimaryExpression expr' }) -> match expr' -- Nested call expression like this in Python represent creating an instance of a class and calling it: e.g. AClass()()
(Prj (Py.ParenthesizedExpression _ (Prj (Py.Expression (Prj (Py.PrimaryExpression expr')))))) -> match expr' -- Parenthesized expressions
_ -> gtags t
yield name = yieldTag name Call loc range Nothing >> gtags t
tags
t@Py.Call
{ ann = Loc {byteRange},
function = Py.PrimaryExpression expr
} = match expr
where
match expr = case expr of
Prj Py.Attribute {attribute = Py.Identifier {text, ann}} -> yield text ann
Prj Py.Identifier {text, ann} -> yield text ann
Prj Py.Call {function = Py.PrimaryExpression expr'} -> match expr' -- Nested call expression like this in Python represent creating an instance of a class and calling it: e.g. AClass()()
Prj (Py.ParenthesizedExpression _ (Prj (Py.Expression (Prj (Py.PrimaryExpression expr'))))) -> match expr' -- Parenthesized expressions
_ -> gtags t
yield name loc = yieldTag name Call loc byteRange Nothing >> gtags t
yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> Maybe Text -> m ()
yieldTag name kind loc range docs = do
yieldTag name kind loc srcLineRange docs = do
src <- ask @Source
Tags.yield (Tag name kind loc (Tags.firstLine src range) docs)
Tags.yield (Tag name kind loc (Tags.firstLine src srcLineRange) docs)
docComment :: Source -> (Py.CompoundStatement :+: Py.SimpleStatement) Loc -> Maybe Text
docComment src (R1 (Py.SimpleStatement (Prj Py.ExpressionStatement { extraChildren = L1 (Prj (Py.Expression (Prj (Py.PrimaryExpression (Prj Py.String { ann }))))) :|_ }))) = Just (toText (slice src (byteRange ann)))
docComment src (R1 (Py.SimpleStatement (Prj Py.ExpressionStatement {extraChildren = L1 (Prj (Py.Expression (Prj (Py.PrimaryExpression (Prj Py.String {ann}))))) :| _}))) = Just (toText (slice src (byteRange ann)))
docComment _ _ = Nothing
gtags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Traversable1 ToTags t
)
=> t Loc
-> m ()
gtags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Traversable1 ToTags t
) =>
t Loc ->
m ()
gtags = traverse1_ @ToTags (const (pure ())) tags
instance ToTags Py.AliasedImport
instance ToTags Py.ArgumentList
-- instance ToTags Py.AssertStatement

437
semantic-ruby/src/Language/Ruby/Tags.hs
View File

@ -5,45 +5,48 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# HLINT ignore "Reduce duplication" #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
module Language.Ruby.Tags
( ToTags(..)
) where
import AST.Element
import AST.Token
import AST.Traversable1
{-# HLINT ignore "Reduce duplication" #-}
module Language.Ruby.Tags
( ToTags (..),
)
where
import AST.Element
import AST.Token
import AST.Traversable1
import qualified AST.Unmarshal as TS
import Control.Effect.Reader
import Control.Effect.State
import Control.Effect.Writer
import Control.Monad
import Data.Foldable
import Data.Text as Text
import Control.Effect.Reader
import Control.Effect.State
import Control.Effect.Writer
import Control.Monad
import Data.Foldable
import Data.Text as Text
import qualified Language.Ruby.AST as Rb
import Source.Loc
import Source.Range as Range
import Source.Source as Source
import Tags.Tag
import Source.Loc
import Source.Range as Range
import Source.Source as Source
import Tags.Tag
import qualified Tags.Tagging.Precise as Tags
class ToTags t where
tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Has (State [Text]) sig m
)
=> t Loc
-> m ()
default tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Has (State [Text]) sig m
, Traversable1 ToTags t
)
=> t Loc
-> m ()
tags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Has (State [Text]) sig m
) =>
t Loc ->
m ()
default tags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Has (State [Text]) sig m,
Traversable1 ToTags t
) =>
t Loc ->
m ()
tags = gtags
instance ToTags (Token sym n) where tags _ = pure ()
@ -58,94 +61,101 @@ instance (ToTags l, ToTags r) => ToTags (l :+: r) where
-- current tags output.
nameBlacklist :: [Text]
nameBlacklist =
[ "alias"
, "load"
, "require_relative"
, "require"
, "super"
, "undef"
, "__FILE__"
, "__LINE__"
, "lambda"
[ "alias",
"load",
"require_relative",
"require",
"super",
"undef",
"__FILE__",
"__LINE__",
"lambda"
]
yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m ()
yieldTag name Call _ _ | name `elem` nameBlacklist = pure ()
yieldTag name kind loc range = do
yieldTag name kind loc srcLineRange = do
src <- ask @Source
Tags.yield (Tag name kind loc (Tags.firstLine src range) Nothing)
Tags.yield (Tag name kind loc (Tags.firstLine src srcLineRange) Nothing)
instance ToTags Rb.Class where
tags t@Rb.Class
{ ann = loc@Loc { byteRange = Range { start } }
, name = expr
, extraChildren
} = enterScope True $ case expr of
Prj Rb.Constant { text } -> yield text
Prj Rb.ScopeResolution { name = Prj Rb.Constant { text } } -> yield text
Prj Rb.ScopeResolution { name = Prj Rb.Identifier { text } } -> yield text
_ -> gtags t
where
range' = case extraChildren of
Prj Rb.Superclass { ann = Loc { byteRange = Range { end }}} : _ -> Range start end
_ -> Range start (getEnd expr)
getEnd = Range.end . byteRange . TS.gann
yield name = yieldTag name Class loc range' >> gtags t
tags
t@Rb.Class
{ ann = Loc {byteRange = Range {start}},
name = expr,
extraChildren
} = enterScope True $ case expr of
Prj Rb.Constant {text, ann} -> yield text ann
Prj Rb.ScopeResolution {name = Prj Rb.Constant {text, ann}} -> yield text ann
Prj Rb.ScopeResolution {name = Prj Rb.Identifier {text, ann}} -> yield text ann
_ -> gtags t
where
range' = case extraChildren of
Prj Rb.Superclass {ann = Loc {byteRange = Range {end}}} : _ -> Range start end
_ -> Range start (getEnd expr)
getEnd = Range.end . byteRange . TS.gann
yield name loc = yieldTag name Class loc range' >> gtags t
instance ToTags Rb.SingletonClass where
tags t@Rb.SingletonClass
{ ann = loc@Loc { byteRange = range@Range { start } }
, value = Rb.Arg expr
, extraChildren
} = enterScope True $ case expr of
Prj (Rb.Primary (Prj (Rb.Lhs (Prj (Rb.Variable (Prj Rb.Constant { text })))))) -> yield text
Prj (Rb.Primary (Prj (Rb.Lhs (Prj Rb.ScopeResolution { name = Prj Rb.Constant { text } })))) -> yield text
Prj (Rb.Primary (Prj (Rb.Lhs (Prj Rb.ScopeResolution { name = Prj Rb.Identifier { text } })))) -> yield text
_ -> gtags t
where
range' = case extraChildren of
x : _ -> Range start (getStart x)
_ -> range
getStart = Range.start . byteRange . TS.gann
yield name = yieldTag name Class loc range' >> gtags t
tags
t@Rb.SingletonClass
{ ann = Loc {byteRange = range@Range {start}},
value = Rb.Arg expr,
extraChildren
} = enterScope True $ case expr of
Prj (Rb.Primary (Prj (Rb.Lhs (Prj (Rb.Variable (Prj Rb.Constant {text, ann})))))) -> yield text ann
Prj (Rb.Primary (Prj (Rb.Lhs (Prj Rb.ScopeResolution {name = Prj Rb.Constant {text, ann}})))) -> yield text ann
Prj (Rb.Primary (Prj (Rb.Lhs (Prj Rb.ScopeResolution {name = Prj Rb.Identifier {text, ann}})))) -> yield text ann
_ -> gtags t
where
range' = case extraChildren of
x : _ -> Range start (getStart x)
_ -> range
getStart = Range.start . byteRange . TS.gann
yield name loc = yieldTag name Class loc range' >> gtags t
instance ToTags Rb.Module where
tags t@Rb.Module
{ ann = loc@Loc { byteRange = Range { start } }
, name = expr
, extraChildren
} = enterScope True $ case expr of
Prj Rb.Constant { text = name } -> yield name
Prj Rb.ScopeResolution { name = Prj Rb.Constant { text = name } } -> yield name
Prj Rb.ScopeResolution { name = Prj Rb.Identifier { text = name } } -> yield name
_ -> gtags t
where
range' = case extraChildren of
x : _ -> Range start (getStart x)
_ -> Range start (getEnd expr)
getEnd = Range.end . byteRange . TS.gann
getStart = Range.start . byteRange . TS.gann
yield name = yieldTag name Module loc range' >> gtags t
tags
t@Rb.Module
{ ann = Loc {byteRange = Range {start}},
name = expr,
extraChildren
} = enterScope True $ case expr of
Prj Rb.Constant {text, ann} -> yield text ann
Prj Rb.ScopeResolution {name = Prj Rb.Constant {text, ann}} -> yield text ann
Prj Rb.ScopeResolution {name = Prj Rb.Identifier {text, ann}} -> yield text ann
_ -> gtags t
where
range' = case extraChildren of
x : _ -> Range start (getStart x)
_ -> Range start (getEnd expr)
getEnd = Range.end . byteRange . TS.gann
getStart = Range.start . byteRange . TS.gann
yield name loc = yieldTag name Module loc range' >> gtags t
yieldMethodNameTag
:: ( Has (State [Text]) sig m
, Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Traversable1 ToTags t
) => t Loc -> Loc -> Range -> Rb.MethodName Loc -> m ()
yieldMethodNameTag t loc range (Rb.MethodName expr) = enterScope True $ case expr of
Prj Rb.Identifier { text = name } -> yield name
Prj Rb.Constant { text = name } -> yield name
yieldMethodNameTag ::
( Has (State [Text]) sig m,
Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Traversable1 ToTags t
) =>
t Loc ->
Range ->
Rb.MethodName Loc ->
m ()
yieldMethodNameTag t range (Rb.MethodName expr) = enterScope True $ case expr of
Prj Rb.Identifier {text, ann} -> yield text ann
Prj Rb.Constant {text, ann} -> yield text ann
-- Prj Rb.ClassVariable { text = name } -> yield name
Prj Rb.Operator { text = name } -> yield name
Prj Rb.Operator {text, ann} -> yield text ann
-- Prj Rb.GlobalVariable { text = name } -> yield name
-- Prj Rb.InstanceVariable { text = name } -> yield name
Prj Rb.Setter { extraChildren = Rb.Identifier { text = name } } -> yield (name <> "=") -- NB: Matches existing tags output, TODO: Remove this.
-- TODO: Should we report symbol method names as tags?
-- Prj Rb.Symbol { extraChildren = [Prj Rb.EscapeSequence { text = name }] } -> yield name
_ -> gtags t
Prj Rb.Setter {extraChildren = Rb.Identifier {text, ann}} -> yield (text <> "=") ann-- NB: Matches existing tags output, TODO: Remove this.
-- TODO: Should we report symbol method names as tags?
-- Prj Rb.Symbol { extraChildren = [Prj Rb.EscapeSequence { text = name }] } -> yield name
_ -> gtags t
where
yield name = yieldTag name Method loc range >> gtags t
yield name loc = yieldTag name Method loc range >> gtags t
enterScope :: (Has (State [Text]) sig m) => Bool -> m () -> m ()
enterScope createNew m = do
@ -155,28 +165,30 @@ enterScope createNew m = do
put locals
instance ToTags Rb.Method where
tags t@Rb.Method
{ ann = loc@Loc { byteRange = Range { start } }
, name
, parameters
} = yieldMethodNameTag t loc range' name
where
range' = case parameters of
Just Rb.MethodParameters { ann = Loc { byteRange = Range { end } }} -> Range start end
_ -> Range start (getEnd name)
getEnd = Range.end . byteRange . TS.gann
tags
t@Rb.Method
{ ann = Loc {byteRange = Range {start}},
name,
parameters
} = yieldMethodNameTag t range' name
where
range' = case parameters of
Just Rb.MethodParameters {ann = Loc {byteRange = Range {end}}} -> Range start end
_ -> Range start (getEnd name)
getEnd = Range.end . byteRange . TS.gann
instance ToTags Rb.SingletonMethod where
tags t@Rb.SingletonMethod
{ ann = loc@Loc { byteRange = Range { start } }
, name
, parameters
} = yieldMethodNameTag t loc range' name
where
range' = case parameters of
Just Rb.MethodParameters { ann = Loc { byteRange = Range { end } }} -> Range start end
_ -> Range start (getEnd name)
getEnd = Range.end . byteRange . TS.gann
tags
t@Rb.SingletonMethod
{ ann = Loc {byteRange = Range {start}},
name,
parameters
} = yieldMethodNameTag t range' name
where
range' = case parameters of
Just Rb.MethodParameters {ann = Loc {byteRange = Range {end}}} -> Range start end
_ -> Range start (getEnd name)
getEnd = Range.end . byteRange . TS.gann
instance ToTags Rb.Block where
tags = enterScope False . gtags
@ -185,54 +197,54 @@ instance ToTags Rb.DoBlock where
tags = enterScope False . gtags
instance ToTags Rb.Lambda where
tags Rb.Lambda { body, parameters } = enterScope False $ do
tags Rb.Lambda {body, parameters} = enterScope False $ do
maybe (pure ()) tags parameters
tags body
instance ToTags Rb.If where
tags Rb.If { condition, consequence, alternative } = do
tags Rb.If {condition, consequence, alternative} = do
tags condition
maybe (pure ()) tags consequence
maybe (pure ()) tags alternative
instance ToTags Rb.Elsif where
tags Rb.Elsif { condition, consequence, alternative } = do
tags Rb.Elsif {condition, consequence, alternative} = do
tags condition
maybe (pure ()) tags consequence
maybe (pure ()) tags alternative
instance ToTags Rb.Unless where
tags Rb.Unless { condition, consequence, alternative } = do
tags Rb.Unless {condition, consequence, alternative} = do
tags condition
maybe (pure ()) tags consequence
maybe (pure ()) tags alternative
instance ToTags Rb.While where
tags Rb.While { condition, body } = tags condition >> tags body
tags Rb.While {condition, body} = tags condition >> tags body
instance ToTags Rb.Until where
tags Rb.Until { condition, body } = tags condition >> tags body
tags Rb.Until {condition, body} = tags condition >> tags body
instance ToTags Rb.Regex where
tags Rb.Regex { } = pure ()
tags Rb.Regex {} = pure ()
instance ToTags Rb.Subshell where
tags Rb.Subshell { } = pure ()
tags Rb.Subshell {} = pure ()
-- TODO: Line of source produced here could be better.
instance ToTags Rb.Lhs where
tags t@(Rb.Lhs expr) = case expr of
-- NOTE: Calls do not look for locals
Prj Rb.Call { ann = loc@Loc { byteRange }, method } -> case method of
Prj Rb.Identifier { text } -> yieldCall text loc byteRange
Prj Rb.Constant { text } -> yieldCall text loc byteRange
Prj Rb.Operator { text } -> yieldCall text loc byteRange
_ -> gtags t
Prj Rb.Call {ann = Loc {byteRange}, method} -> case method of
Prj Rb.Identifier {text, ann} -> yieldCall text ann byteRange
Prj Rb.Constant {text, ann} -> yieldCall text ann byteRange
Prj Rb.Operator {text, ann} -> yieldCall text ann byteRange
_ -> gtags t
-- These do check for locals before yielding a call tag
Prj (Rb.Variable (Prj Rb.Identifier { ann = loc@Loc { byteRange }, text })) -> yield text Call loc byteRange
Prj Rb.ScopeResolution { ann = loc@Loc { byteRange }, name = Prj Rb.Identifier { text } } -> yield text Call loc byteRange
-- TODO: These would be great to track, but doesn't match current a la carte tags output
-- Prj (Rb.Variable (Prj Rb.Constant { ann = loc@Loc { byteRange }, text })) -> yield text Constant loc byteRange
-- Prj Rb.ScopeResolution { ann = loc@Loc { byteRange }, name = Prj Rb.Constant { text } } -> yield text Constant loc byteRange
Prj (Rb.Variable (Prj Rb.Identifier {ann = loc@Loc {byteRange}, text})) -> yield text Call loc byteRange
Prj Rb.ScopeResolution {ann = loc@Loc {byteRange}, name = Prj Rb.Identifier {text}} -> yield text Call loc byteRange
Prj (Rb.Variable (Prj Rb.Constant { ann = loc@Loc { byteRange }, text })) -> yield text Call loc byteRange -- TODO: Should yield Constant
Prj Rb.ScopeResolution { ann = loc@Loc { byteRange }, name = Prj Rb.Constant { text } } -> yield text Call loc byteRange -- TODO: Should yield Constant
_ -> gtags t
where
yieldCall name loc range = yieldTag name Call loc range >> gtags t
@ -241,105 +253,114 @@ instance ToTags Rb.Lhs where
unless (name `elem` locals) $ yieldTag name kind loc range
gtags t
-- TODO: Line of source produced here could be better.
instance ToTags Rb.MethodCall where
tags t@Rb.MethodCall
{ ann = loc@Loc { byteRange = byteRange@Range {} }
, method = expr
} = case expr of
Prj (Rb.Variable (Prj Rb.Identifier { text = name })) -> yield name Call
Prj (Rb.Variable (Prj Rb.Constant { text = name })) -> yield name Call -- TODO: Should yield Constant
Prj Rb.ScopeResolution { name = Prj Rb.Identifier { text } } -> yield text Call
Prj Rb.ScopeResolution { name = Prj Rb.Constant { text } } -> yield text Call -- TODO: Should yield Constant
Prj Rb.Call { method } -> case method of
Prj Rb.Identifier { text } -> yield text Call
Prj Rb.Constant { text } -> yield text Call
Prj Rb.Operator { text } -> yield text Call
_ -> gtags t
tags
t@Rb.MethodCall
{ ann = Loc {byteRange = byteRange@Range {}},
method = expr
} = case expr of
Prj (Rb.Variable (Prj Rb.Identifier {text, ann})) -> yield text Call ann
Prj (Rb.Variable (Prj Rb.Constant {text, ann})) -> yield text Call ann -- TODO: Should yield Constant
Prj Rb.ScopeResolution {name = Prj Rb.Identifier {text, ann}} -> yield text Call ann
Prj Rb.ScopeResolution {name = Prj Rb.Constant {text, ann}} -> yield text Call ann -- TODO: Should yield Constant
Prj Rb.Call {method} -> case method of
Prj Rb.Identifier {text, ann} -> yield text Call ann
Prj Rb.Constant {text, ann} -> yield text Call ann
Prj Rb.Operator {text, ann} -> yield text Call ann
_ -> gtags t
_ -> gtags t
where
yield name kind = yieldTag name kind loc byteRange >> gtags t
where
yield name kind loc = yieldTag name kind loc byteRange >> gtags t
instance ToTags Rb.Alias where
tags t@Rb.Alias
{ alias = Rb.MethodName aliasExpr
, name = Rb.MethodName nameExpr
} = do
tags
t@Rb.Alias
{ alias = Rb.MethodName aliasExpr,
name = Rb.MethodName nameExpr,
ann = Loc {byteRange}
} = do
case aliasExpr of
Prj Rb.Identifier { ann = loc@Loc { byteRange}, text } -> yieldTag text Function loc byteRange
_ -> tags aliasExpr
Prj Rb.Identifier {ann, text} -> yieldTag text Function ann byteRange
_ -> tags aliasExpr
case nameExpr of
Prj Rb.Identifier { ann = loc@Loc { byteRange}, text } -> yieldTag text Call loc byteRange
_ -> tags nameExpr
Prj Rb.Identifier {ann, text} -> yieldTag text Call ann byteRange
_ -> tags nameExpr
gtags t
instance ToTags Rb.Undef where
tags t@Rb.Undef
{ extraChildren
} = for_ extraChildren $ \(Rb.MethodName expr) -> do
tags
t@Rb.Undef
{ extraChildren,
ann = Loc {byteRange}
} = for_ extraChildren $ \(Rb.MethodName expr) -> do
case expr of
Prj Rb.Identifier { ann = loc@Loc { byteRange }, text } -> yieldTag text Call loc byteRange
_ -> tags expr
Prj Rb.Identifier {ann, text} -> yieldTag text Call ann byteRange
_ -> tags expr
gtags t
introduceLocals
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Has (State [Text]) sig m
)
=> [((Rb.BlockParameter :+: Rb.DestructuredParameter :+: Rb.HashSplatParameter) :+:
((Rb.Identifier :+: Rb.KeywordParameter) :+: (Rb.OptionalParameter :+: Rb.SplatParameter)))
Loc ]
-> m ()
introduceLocals ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Has (State [Text]) sig m
) =>
[ ( (Rb.BlockParameter :+: Rb.DestructuredParameter :+: Rb.HashSplatParameter)
:+: ((Rb.Identifier :+: Rb.KeywordParameter) :+: (Rb.OptionalParameter :+: Rb.SplatParameter))
)
Loc
] ->
m ()
introduceLocals params = for_ params $ \param -> case param of
Prj Rb.BlockParameter { name = Rb.Identifier { text = lvar } } -> modify (lvar :)
Prj Rb.DestructuredParameter { extraChildren } -> introduceLocals extraChildren
Prj Rb.HashSplatParameter { name = Just Rb.Identifier { text = lvar } } -> modify (lvar :)
Prj Rb.Identifier { text = lvar } -> modify (lvar :)
Prj Rb.KeywordParameter { name = Rb.Identifier { text = lvar }} -> modify (lvar :)
Prj Rb.OptionalParameter { name = Rb.Identifier { text = lvar }} -> modify (lvar :)
Prj Rb.SplatParameter { name = Just Rb.Identifier { text = lvar } } -> modify (lvar :)
_ -> pure ()
Prj Rb.BlockParameter {name = Rb.Identifier {text = lvar}} -> modify (lvar :)
Prj Rb.DestructuredParameter {extraChildren} -> introduceLocals extraChildren
Prj Rb.HashSplatParameter {name = Just Rb.Identifier {text = lvar}} -> modify (lvar :)
Prj Rb.Identifier {text = lvar} -> modify (lvar :)
Prj Rb.KeywordParameter {name = Rb.Identifier {text = lvar}} -> modify (lvar :)
Prj Rb.OptionalParameter {name = Rb.Identifier {text = lvar}} -> modify (lvar :)
Prj Rb.SplatParameter {name = Just Rb.Identifier {text = lvar}} -> modify (lvar :)
_ -> pure ()
instance ToTags Rb.MethodParameters where
tags t@Rb.MethodParameters{ extraChildren } = introduceLocals extraChildren >> gtags t
tags t@Rb.MethodParameters {extraChildren} = introduceLocals extraChildren >> gtags t
instance ToTags Rb.LambdaParameters where
tags t@Rb.LambdaParameters{ extraChildren } = introduceLocals extraChildren >> gtags t
tags t@Rb.LambdaParameters {extraChildren} = introduceLocals extraChildren >> gtags t
instance ToTags Rb.BlockParameters where
tags t@Rb.BlockParameters{ extraChildren } = introduceLocals extraChildren >> gtags t
tags t@Rb.BlockParameters {extraChildren} = introduceLocals extraChildren >> gtags t
instance ToTags Rb.Assignment where
tags t@Rb.Assignment{ left } = do
tags t@Rb.Assignment {left} = do
case left of
Prj (Rb.Lhs (Prj (Rb.Variable (Prj Rb.Identifier { text })))) -> modify (text :)
Prj Rb.LeftAssignmentList { extraChildren } -> introduceLhsLocals extraChildren
_ -> pure ()
Prj (Rb.Lhs (Prj (Rb.Variable (Prj Rb.Identifier {text})))) -> modify (text :)
Prj Rb.LeftAssignmentList {extraChildren} -> introduceLhsLocals extraChildren
_ -> pure ()
gtags t
where
introduceLhsLocals xs = for_ xs $ \x -> case x of
Prj (Rb.Lhs (Prj (Rb.Variable (Prj Rb.Identifier { text })))) -> modify (text :)
Prj Rb.DestructuredLeftAssignment { extraChildren } -> introduceLhsLocals extraChildren
Prj Rb.RestAssignment { extraChildren = Just (Rb.Lhs (Prj (Rb.Variable (Prj Rb.Identifier { text })))) } -> modify (text :)
Prj (Rb.Lhs (Prj (Rb.Variable (Prj Rb.Identifier {text})))) -> modify (text :)
Prj Rb.DestructuredLeftAssignment {extraChildren} -> introduceLhsLocals extraChildren
Prj Rb.RestAssignment {extraChildren = Just (Rb.Lhs (Prj (Rb.Variable (Prj Rb.Identifier {text}))))} -> modify (text :)
_ -> pure ()
instance ToTags Rb.OperatorAssignment where
tags t@Rb.OperatorAssignment{ left } = do
tags t@Rb.OperatorAssignment {left} = do
case left of
Prj (Rb.Lhs (Prj (Rb.Variable (Prj Rb.Identifier { text })))) -> modify (text :)
_ -> pure ()
Prj (Rb.Lhs (Prj (Rb.Variable (Prj Rb.Identifier {text})))) -> modify (text :)
_ -> pure ()
gtags t
gtags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Has (State [Text]) sig m
, Traversable1 ToTags t
)
=> t Loc
-> m ()
gtags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Has (State [Text]) sig m,
Traversable1 ToTags t
) =>
t Loc ->
m ()
gtags = traverse1_ @ToTags (const (pure ())) tags
-- instance ToTags Rb.Alias
instance ToTags Rb.Arg
instance ToTags Rb.ArgumentList

6
semantic-tags/src/Tags/Tag.hs
View File

@ -23,7 +23,11 @@ data Kind
| Module
-- References
| Call
-- Types
| Type
-- Just as Call is to Class and Function, Implementation is to Interface.
-- This suggests that perhaps we should have an Instantiation kind that
-- we use for Class.
| Interface
| Implementation
-- Constant -- TODO: New kind for constant references
deriving (Bounded, Enum, Eq, Show)

204
semantic-tsx/src/Language/TSX/Tags.hs
View File

@ -5,152 +5,116 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Language.TSX.Tags
( ToTags(..)
) where
import AST.Element
import AST.Token
import AST.Traversable1
import Control.Effect.Reader
import Control.Effect.Writer
import Data.Foldable
import Data.Text as Text
module Language.TSX.Tags
( ToTags (..),
)
where
import AST.Element
import AST.Token
import AST.Traversable1
import Control.Effect.Reader
import Control.Effect.Writer
import Data.Foldable
import Data.Text as Text
import qualified Language.TSX.AST as Tsx
import Source.Loc
import Source.Source as Source
import Tags.Tag
import Source.Loc
import Source.Source as Source
import Tags.Tag
import qualified Tags.Tagging.Precise as Tags
class ToTags t where
tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
)
=> t Loc
-> m ()
default tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Traversable1 ToTags t
)
=> t Loc
-> m ()
tags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m
) =>
t Loc ->
m ()
default tags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Traversable1 ToTags t
) =>
t Loc ->
m ()
tags = gtags
instance ToTags Tsx.Function where
tags t@Tsx.Function
{ ann = loc@Loc { byteRange }
, name = Just Tsx.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t
tags t@Tsx.Function {ann = Loc {byteRange}, name = Just Tsx.Identifier {text, ann}} =
yieldTag text Function ann byteRange >> gtags t
tags t = gtags t
instance ToTags Tsx.FunctionSignature where
tags t@Tsx.FunctionSignature
{ ann = loc@Loc { byteRange }
, name = Tsx.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t
tags t@Tsx.FunctionSignature {ann = Loc {byteRange}, name = Tsx.Identifier {text, ann}} =
yieldTag text Function ann byteRange >> gtags t
instance ToTags Tsx.FunctionDeclaration where
tags t@Tsx.FunctionDeclaration
{ ann = loc@Loc { byteRange }
, name = Tsx.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t
tags t@Tsx.FunctionDeclaration {ann = Loc {byteRange}, name = Tsx.Identifier {text, ann}} =
yieldTag text Function ann byteRange >> gtags t
instance ToTags Tsx.MethodDefinition where
tags t@Tsx.MethodDefinition
{ ann = loc@Loc { byteRange }
, name
} = case name of
Prj Tsx.PropertyIdentifier { text } -> yield text
-- TODO: There are more here
_ -> gtags t
where
yield name = yieldTag name Method loc byteRange >> gtags t
tags t@Tsx.MethodDefinition {ann = Loc {byteRange}, name} = case name of
Prj Tsx.PropertyIdentifier {text, ann} -> yieldTag text Method ann byteRange >> gtags t
_ -> gtags t
instance ToTags Tsx.Pair where
tags t@Tsx.Pair
{ ann = loc@Loc { byteRange }
, key
, value = Tsx.Expression expr
} = case (key, expr) of
(Prj Tsx.PropertyIdentifier { text }, Prj Tsx.Function{}) -> yield text
(Prj Tsx.PropertyIdentifier { text }, Prj Tsx.ArrowFunction{}) -> yield text
_ -> gtags t
tags t@Tsx.Pair {ann = Loc {byteRange}, key, value = Tsx.Expression expr} = case (key, expr) of
(Prj Tsx.PropertyIdentifier {text, ann}, Prj Tsx.Function {}) -> yield text ann
(Prj Tsx.PropertyIdentifier {text, ann}, Prj Tsx.ArrowFunction {}) -> yield text ann
_ -> gtags t
where
yield text = yieldTag text Function loc byteRange >> gtags t
yield text loc = yieldTag text Function loc byteRange >> gtags t
instance ToTags Tsx.ClassDeclaration where
tags t@Tsx.ClassDeclaration
{ ann = loc@Loc { byteRange }
, name = Tsx.TypeIdentifier { text }
} = yieldTag text Class loc byteRange >> gtags t
tags t@Tsx.ClassDeclaration {ann = Loc {byteRange}, name = Tsx.TypeIdentifier {text, ann}} =
yieldTag text Class ann byteRange >> gtags t
instance ToTags Tsx.CallExpression where
tags t@Tsx.CallExpression
{ ann = loc@Loc { byteRange }
, function = Tsx.Expression expr
} = match expr
tags t@Tsx.CallExpression {ann = Loc {byteRange}, function = Tsx.Expression expr} = match expr
where
match expr = case expr of
Prj Tsx.Identifier { text } -> yield text
Prj Tsx.NewExpression { constructor = Prj Tsx.Identifier { text } } -> yield text
Prj Tsx.CallExpression { function = Tsx.Expression expr } -> match expr
Prj Tsx.MemberExpression { property = Tsx.PropertyIdentifier { text } } -> yield text
Prj Tsx.Function { name = Just Tsx.Identifier { text }} -> yield text
Prj Tsx.ParenthesizedExpression { extraChildren } -> for_ extraChildren $ \ x -> case x of
Prj Tsx.Identifier {text, ann} -> yield text ann
Prj Tsx.NewExpression {constructor = Prj Tsx.Identifier {text, ann}} -> yield text ann
Prj Tsx.CallExpression {function = Tsx.Expression expr} -> match expr
Prj Tsx.MemberExpression {property = Tsx.PropertyIdentifier {text, ann}} -> yield text ann
Prj Tsx.Function {name = Just Tsx.Identifier {text, ann}} -> yield text ann
Prj Tsx.ParenthesizedExpression {extraChildren} -> for_ extraChildren $ \x -> case x of
Prj (Tsx.Expression expr) -> match expr
_ -> tags x
_ -> tags x
_ -> gtags t
yield name = yieldTag name Call loc byteRange >> gtags t
yield name loc = yieldTag name Call loc byteRange >> gtags t
instance ToTags Tsx.Class where
tags t@Tsx.Class
{ ann = loc@Loc { byteRange }
, name = Just Tsx.TypeIdentifier { text }
} = yieldTag text Class loc byteRange >> gtags t
tags t@Tsx.Class {ann = Loc {byteRange}, name = Just Tsx.TypeIdentifier {text, ann}} =
yieldTag text Class ann byteRange >> gtags t
tags t = gtags t
instance ToTags Tsx.Module where
tags t@Tsx.Module
{ ann = loc@Loc { byteRange }
, name
} = match name
where
match expr = case expr of
Prj Tsx.Identifier { text } -> yield text
-- TODO: Handle NestedIdentifiers and Strings
-- Prj Tsx.NestedIdentifier { extraChildren } -> match
_ -> gtags t
yield text = yieldTag text Module loc byteRange >> gtags t
tags t@Tsx.Module {ann = Loc {byteRange}, name} = case name of
Prj Tsx.Identifier {text, ann} -> yieldTag text Module ann byteRange >> gtags t
_ -> gtags t
instance ToTags Tsx.VariableDeclarator where
tags t@Tsx.VariableDeclarator
{ ann = loc@Loc { byteRange }
, name
, value = Just (Tsx.Expression expr)
} = case (expr, name) of
(Prj Tsx.Function{}, Prj Tsx.Identifier { text }) -> yield text
(Prj Tsx.ArrowFunction{}, Prj Tsx.Identifier { text }) -> yield text
_ -> gtags t
tags t@Tsx.VariableDeclarator {ann = Loc {byteRange}, name, value = Just (Tsx.Expression expr)} =
case (expr, name) of
(Prj Tsx.Function {}, Prj Tsx.Identifier {text, ann}) -> yield text ann
(Prj Tsx.ArrowFunction {}, Prj Tsx.Identifier {text, ann}) -> yield text ann
_ -> gtags t
where
yield text = yieldTag text Function loc byteRange >> gtags t
yield text loc = yieldTag text Function loc byteRange >> gtags t
tags t = gtags t
instance ToTags Tsx.AssignmentExpression where
tags t@Tsx.AssignmentExpression
{ ann = loc@Loc { byteRange }
, left
, right = (Tsx.Expression expr)
} = case (left, expr) of
(Prj Tsx.Identifier { text }, Prj Tsx.Function{}) -> yield text
(Prj Tsx.Identifier { text }, Prj Tsx.ArrowFunction{}) -> yield text
(Prj Tsx.MemberExpression { property = Tsx.PropertyIdentifier { text } }, Prj Tsx.Function{}) -> yield text
(Prj Tsx.MemberExpression { property = Tsx.PropertyIdentifier { text } }, Prj Tsx.ArrowFunction{}) -> yield text
_ -> gtags t
tags t@Tsx.AssignmentExpression {ann = Loc {byteRange}, left, right = (Tsx.Expression expr)} =
case (left, expr) of
(Prj Tsx.Identifier {text, ann}, Prj Tsx.Function {}) -> yield text ann
(Prj Tsx.Identifier {text, ann}, Prj Tsx.ArrowFunction {}) -> yield text ann
(Prj Tsx.MemberExpression {property = Tsx.PropertyIdentifier {text, ann}}, Prj Tsx.Function {}) -> yield text ann
(Prj Tsx.MemberExpression {property = Tsx.PropertyIdentifier {text, ann}}, Prj Tsx.ArrowFunction {}) -> yield text ann
_ -> gtags t
where
yield text = yieldTag text Function loc byteRange >> gtags t
yield text loc = yieldTag text Function loc byteRange >> gtags t
instance (ToTags l, ToTags r) => ToTags (l :+: r) where
tags (L1 l) = tags l
@ -158,29 +122,28 @@ instance (ToTags l, ToTags r) => ToTags (l :+: r) where
instance ToTags (Token sym n) where tags _ = pure ()
gtags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Traversable1 ToTags t
)
=> t Loc
-> m ()
gtags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Traversable1 ToTags t
) =>
t Loc ->
m ()
gtags = traverse1_ @ToTags (const (pure ())) tags
-- These are all valid, but point to built-in functions (e.g. require) that a la
-- carte doesn't display and since we have nothing to link to yet (can't
-- jump-to-def), we hide them from the current tags output.
nameBlacklist :: [Text]
nameBlacklist =
[ "require"
]
nameBlacklist = ["require"]
yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m ()
yieldTag name Call _ _ | name `elem` nameBlacklist = pure ()
yieldTag name kind loc range = do
yieldTag name kind loc srcLineRange = do
src <- ask @Source
Tags.yield (Tag name kind loc (Tags.firstLine src range) Nothing)
Tags.yield (Tag name kind loc (Tags.firstLine src srcLineRange) Nothing)
{- ORMOLU_DISABLE -}
instance ToTags Tsx.AbstractClassDeclaration
instance ToTags Tsx.AbstractMethodSignature
instance ToTags Tsx.AccessibilityModifier
@ -339,3 +302,4 @@ instance ToTags Tsx.VariableDeclaration
instance ToTags Tsx.WhileStatement
instance ToTags Tsx.WithStatement
instance ToTags Tsx.YieldExpression
{- ORMOLU_ENABLE -}

205
semantic-typescript/src/Language/TypeScript/Tags.hs
View File

@ -5,145 +5,116 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Language.TypeScript.Tags
( ToTags(..)
) where
import AST.Element
import AST.Token
import AST.Traversable1
import Control.Effect.Reader
import Control.Effect.Writer
import Data.Foldable
import Data.Text as Text
module Language.TypeScript.Tags
( ToTags (..),
)
where
import AST.Element
import AST.Token
import AST.Traversable1
import Control.Effect.Reader
import Control.Effect.Writer
import Data.Foldable
import Data.Text as Text
import qualified Language.TypeScript.AST as Ts
import Source.Loc
import Source.Source as Source
import Tags.Tag
import Source.Loc
import Source.Source as Source
import Tags.Tag
import qualified Tags.Tagging.Precise as Tags
class ToTags t where
tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
)
=> t Loc
-> m ()
default tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Traversable1 ToTags t
)
=> t Loc
-> m ()
tags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m
) =>
t Loc ->
m ()
default tags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Traversable1 ToTags t
) =>
t Loc ->
m ()
tags = gtags
instance ToTags Ts.Function where
tags t@Ts.Function
{ ann = loc@Loc { byteRange }
, name = Just Ts.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t
tags t@Ts.Function {ann = Loc {byteRange}, name = Just Ts.Identifier {text, ann}} =
yieldTag text Function ann byteRange >> gtags t
tags t = gtags t
instance ToTags Ts.FunctionSignature where
tags t@Ts.FunctionSignature
{ ann = loc@Loc { byteRange }
, name = Ts.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t
tags t@Ts.FunctionSignature {ann = Loc {byteRange}, name = Ts.Identifier {text, ann}} =
yieldTag text Function ann byteRange >> gtags t
instance ToTags Ts.FunctionDeclaration where
tags t@Ts.FunctionDeclaration
{ ann = loc@Loc { byteRange }
, name = Ts.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t
tags t@Ts.FunctionDeclaration {ann = Loc {byteRange}, name = Ts.Identifier {text, ann}} =
yieldTag text Function ann byteRange >> gtags t
instance ToTags Ts.MethodDefinition where
tags t@Ts.MethodDefinition
{ ann = loc@Loc { byteRange }
, name
} = case name of
Prj Ts.PropertyIdentifier { text } -> yield text
-- TODO: There are more here
_ -> gtags t
where
yield name = yieldTag name Method loc byteRange >> gtags t
tags t@Ts.MethodDefinition {ann = Loc {byteRange}, name} = case name of
Prj Ts.PropertyIdentifier {text, ann} -> yieldTag text Method ann byteRange >> gtags t
_ -> gtags t
instance ToTags Ts.Pair where
tags t@Ts.Pair
{ ann = loc@Loc { byteRange }
, key
, value = Ts.Expression expr
} = case (key, expr) of
(Prj Ts.PropertyIdentifier { text }, Prj Ts.Function{}) -> yield text
(Prj Ts.PropertyIdentifier { text }, Prj Ts.ArrowFunction{}) -> yield text
_ -> gtags t
tags t@Ts.Pair {ann = Loc {byteRange}, key, value = Ts.Expression expr} = case (key, expr) of
(Prj Ts.PropertyIdentifier {text, ann}, Prj Ts.Function {}) -> yield text ann
(Prj Ts.PropertyIdentifier {text, ann}, Prj Ts.ArrowFunction {}) -> yield text ann
_ -> gtags t
where
yield text = yieldTag text Function loc byteRange >> gtags t
yield text loc = yieldTag text Function loc byteRange >> gtags t
instance ToTags Ts.ClassDeclaration where
tags t@Ts.ClassDeclaration
{ ann = loc@Loc { byteRange }
, name = Ts.TypeIdentifier { text }
} = yieldTag text Class loc byteRange >> gtags t
tags t@Ts.ClassDeclaration {ann = Loc {byteRange}, name = Ts.TypeIdentifier {text, ann}} =
yieldTag text Class ann byteRange >> gtags t
instance ToTags Ts.CallExpression where
tags t@Ts.CallExpression
{ ann = loc@Loc { byteRange }
, function = Ts.Expression expr
} = match expr
tags t@Ts.CallExpression {ann = Loc {byteRange}, function = Ts.Expression expr} = match expr
where
match expr = case expr of
Prj Ts.Identifier { text } -> yield text
Prj Ts.NewExpression { constructor = Prj Ts.Identifier { text } } -> yield text
Prj Ts.CallExpression { function = Ts.Expression expr } -> match expr
Prj Ts.MemberExpression { property = Ts.PropertyIdentifier { text } } -> yield text
Prj Ts.Function { name = Just Ts.Identifier { text }} -> yield text
Prj Ts.ParenthesizedExpression { extraChildren } -> for_ extraChildren $ \ x -> case x of
Prj Ts.Identifier {text, ann} -> yield text ann
Prj Ts.NewExpression {constructor = Prj Ts.Identifier {text, ann}} -> yield text ann
Prj Ts.CallExpression {function = Ts.Expression expr} -> match expr
Prj Ts.MemberExpression {property = Ts.PropertyIdentifier {text, ann}} -> yield text ann
Prj Ts.Function {name = Just Ts.Identifier {text, ann}} -> yield text ann
Prj Ts.ParenthesizedExpression {extraChildren} -> for_ extraChildren $ \x -> case x of
Prj (Ts.Expression expr) -> match expr
_ -> tags x
_ -> tags x
_ -> gtags t
yield name = yieldTag name Call loc byteRange >> gtags t
yield name loc = yieldTag name Call loc byteRange >> gtags t
instance ToTags Ts.Class where
tags t@Ts.Class {ann = Loc {byteRange}, name = Just Ts.TypeIdentifier {text, ann}} =
yieldTag text Class ann byteRange >> gtags t
tags t = gtags t
instance ToTags Ts.Module where
tags t@Ts.Module
{ ann = loc@Loc { byteRange }
, name
} = match name
where
match expr = case expr of
Prj Ts.Identifier { text } -> yield text
-- TODO: Handle NestedIdentifiers and Strings
-- Prj Ts.NestedIdentifier { extraChildren } -> match
_ -> gtags t
yield text = yieldTag text Module loc byteRange >> gtags t
tags t@Ts.Module {ann = Loc {byteRange}, name} = case name of
Prj Ts.Identifier {text, ann} -> yieldTag text Module ann byteRange >> gtags t
_ -> gtags t
instance ToTags Ts.VariableDeclarator where
tags t@Ts.VariableDeclarator
{ ann = loc@Loc { byteRange }
, name
, value = Just (Ts.Expression expr)
} = case (expr, name) of
(Prj Ts.Function{}, Prj Ts.Identifier { text }) -> yield text
(Prj Ts.ArrowFunction{}, Prj Ts.Identifier { text }) -> yield text
_ -> gtags t
tags t@Ts.VariableDeclarator {ann = Loc {byteRange}, name, value = Just (Ts.Expression expr)} =
case (expr, name) of
(Prj Ts.Function {}, Prj Ts.Identifier {text, ann}) -> yield text ann
(Prj Ts.ArrowFunction {}, Prj Ts.Identifier {text, ann}) -> yield text ann
_ -> gtags t
where
yield text = yieldTag text Function loc byteRange >> gtags t
yield text loc = yieldTag text Function loc byteRange >> gtags t
tags t = gtags t
instance ToTags Ts.AssignmentExpression where
tags t@Ts.AssignmentExpression
{ ann = loc@Loc { byteRange }
, left
, right = (Ts.Expression expr)
} = case (left, expr) of
(Prj Ts.Identifier { text }, Prj Ts.Function{}) -> yield text
(Prj Ts.Identifier { text }, Prj Ts.ArrowFunction{}) -> yield text
(Prj Ts.MemberExpression { property = Ts.PropertyIdentifier { text } }, Prj Ts.Function{}) -> yield text
(Prj Ts.MemberExpression { property = Ts.PropertyIdentifier { text } }, Prj Ts.ArrowFunction{}) -> yield text
_ -> gtags t
tags t@Ts.AssignmentExpression {ann = Loc {byteRange}, left, right = (Ts.Expression expr)} =
case (left, expr) of
(Prj Ts.Identifier {text, ann}, Prj Ts.Function {}) -> yield text ann
(Prj Ts.Identifier {text, ann}, Prj Ts.ArrowFunction {}) -> yield text ann
(Prj Ts.MemberExpression {property = Ts.PropertyIdentifier {text, ann}}, Prj Ts.Function {}) -> yield text ann
(Prj Ts.MemberExpression {property = Ts.PropertyIdentifier {text, ann}}, Prj Ts.ArrowFunction {}) -> yield text ann
_ -> gtags t
where
yield text = yieldTag text Function loc byteRange >> gtags t
yield text loc = yieldTag text Function loc byteRange >> gtags t
instance (ToTags l, ToTags r) => ToTags (l :+: r) where
tags (L1 l) = tags l
@ -151,29 +122,28 @@ instance (ToTags l, ToTags r) => ToTags (l :+: r) where
instance ToTags (Token sym n) where tags _ = pure ()
gtags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Traversable1 ToTags t
)
=> t Loc
-> m ()
gtags ::
( Has (Reader Source) sig m,
Has (Writer Tags.Tags) sig m,
Traversable1 ToTags t
) =>
t Loc ->
m ()
gtags = traverse1_ @ToTags (const (pure ())) tags
-- These are all valid, but point to built-in functions (e.g. require) that a la
-- carte doesn't display and since we have nothing to link to yet (can't
-- jump-to-def), we hide them from the current tags output.
nameBlacklist :: [Text]
nameBlacklist =
[ "require"
]
nameBlacklist = ["require"]
yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m ()
yieldTag name Call _ _ | name `elem` nameBlacklist = pure ()
yieldTag name kind loc range = do
yieldTag name kind loc srcLineRange = do
src <- ask @Source
Tags.yield (Tag name kind loc (Tags.firstLine src range) Nothing)
Tags.yield (Tag name kind loc (Tags.firstLine src srcLineRange) Nothing)
{- ORMOLU_DISABLE -}
instance ToTags Ts.AbstractClassDeclaration
instance ToTags Ts.AbstractMethodSignature
instance ToTags Ts.AccessibilityModifier
@ -193,7 +163,7 @@ instance ToTags Ts.BreakStatement
-- instance ToTags Ts.CallExpression
instance ToTags Ts.CallSignature
instance ToTags Ts.CatchClause
instance ToTags Ts.Class
-- instance ToTags Ts.Class
instance ToTags Ts.ClassBody
-- instance ToTags Ts.ClassDeclaration
instance ToTags Ts.ClassHeritage
@ -333,3 +303,4 @@ instance ToTags Ts.VariableDeclaration
instance ToTags Ts.WhileStatement
instance ToTags Ts.WithStatement
instance ToTags Ts.YieldExpression
{- ORMOLU_ENABLE -}

2
test/Semantic/CLI/Spec.hs
View File

@ -47,7 +47,7 @@ testForDiffFixture (diffRenderer, runDiff, files, expected) =
testForParseFixture :: (String, [Blob] -> ParseC TaskC Builder, [File Language], Path.RelFile) -> TestTree
testForParseFixture (format, runParse, files, expected) =
goldenVsStringDiff
("diff fixture renders to " <> format)
("parse fixture renders to " <> format)
renderDiff
(Path.toString expected)
(fmap toLazyByteString . runTaskOrDie $ readBlobs (FilesFromPaths files) >>= runParse)

50
test/Tags/Spec.hs
View File

@ -14,80 +14,80 @@ spec = do
describe "go" $ do
it "produces tags for functions with docs (TODO)" $
parseTestFile [Function] (Path.relFile "test/fixtures/go/tags/simple_functions.go") `shouldReturn`
[ Tag "TestFromBits" Function (Loc (Range 51 92) (Span (Pos 6 1) (Pos 8 2))) "func TestFromBits(t *testing.T) {" Nothing
, Tag "Hi" Function (Loc (Range 94 107) (Span (Pos 10 1) (Pos 11 2))) "func Hi() {" Nothing ]
[ Tag "TestFromBits" Function (Loc (Range 56 68) (Span (Pos 6 6) (Pos 6 18))) "func TestFromBits(t *testing.T) {" Nothing
, Tag "Hi" Function (Loc (Range 99 101) (Span (Pos 10 6) (Pos 10 8))) "func Hi() {" Nothing ]
it "produces tags for methods" $
parseTestFile [Method] (Path.relFile "test/fixtures/go/tags/method.go") `shouldReturn`
[ Tag "CheckAuth" Method (Loc (Range 19 118) (Span (Pos 3 1) (Pos 3 100))) "func (c *apiClient) CheckAuth(req *http.Request, user, repo string) (*authenticatedActor, error) {}" Nothing]
[ Tag "CheckAuth" Method (Loc (Range 39 48) (Span (Pos 3 21) (Pos 3 30))) "func (c *apiClient) CheckAuth(req *http.Request, user, repo string) (*authenticatedActor, error) {}" Nothing]
it "produces tags for calls" $
parseTestFile [Call] (Path.relFile "test/fixtures/go/tags/simple_functions.go") `shouldReturn`
[ Tag "Hi" Call (Loc (Range 86 90) (Span (Pos 7 2) (Pos 7 6))) "Hi()" Nothing]
[ Tag "Hi" Call (Loc (Range 86 88) (Span (Pos 7 2) (Pos 7 4))) "Hi()" Nothing]
describe "javascript and typescript" $ do
it "produces tags for functions with docs (TODO)" $
parseTestFile [Function] (Path.relFile "test/fixtures/javascript/tags/simple_function_with_docs.js") `shouldReturn`
[ Tag "myFunction" Function (Loc (Range 22 59) (Span (Pos 2 1) (Pos 4 2))) "function myFunction() {" Nothing ]
[ Tag "myFunction" Function (Loc (Range 31 41) (Span (Pos 2 10) (Pos 2 20))) "function myFunction() {" Nothing ]
it "produces tags for classes" $
parseTestFile [Class] (Path.relFile "test/fixtures/typescript/tags/class.ts") `shouldReturn`
[ Tag "FooBar" Class (Loc (Range 0 15) (Span (Pos 1 1) (Pos 1 16))) "class FooBar {}" Nothing ]
[ Tag "FooBar" Class (Loc (Range 6 12) (Span (Pos 1 7) (Pos 1 13))) "class FooBar {}" Nothing ]
it "produces tags for modules" $
parseTestFile [Tags.Module] (Path.relFile "test/fixtures/typescript/tags/module.ts") `shouldReturn`
[ Tag "APromise" Tags.Module (Loc (Range 0 19) (Span (Pos 1 1) (Pos 1 20))) "module APromise { }" Nothing ]
[ Tag "APromise" Tags.Module (Loc (Range 7 15) (Span (Pos 1 8) (Pos 1 16))) "module APromise { }" Nothing ]
describe "python" $ do
it "produces tags for functions" $
parseTestFile [Function] (Path.relFile "test/fixtures/python/tags/simple_functions.py") `shouldReturn`
[ Tag "Foo" Function (Loc (Range 0 68) (Span (Pos 1 1) (Pos 5 17))) "def Foo(x):" Nothing
, Tag "Bar" Function (Loc (Range 70 136) (Span (Pos 7 1) (Pos 11 13))) "def Bar():" Nothing
, Tag "local" Function (Loc (Range 85 114) (Span (Pos 8 5) (Pos 9 17))) "def local():" Nothing
[ Tag "Foo" Function (Loc (Range 4 7) (Span (Pos 1 5) (Pos 1 8))) "def Foo(x):" Nothing
, Tag "Bar" Function (Loc (Range 74 77) (Span (Pos 7 5) (Pos 7 8))) "def Bar():" Nothing
, Tag "local" Function (Loc (Range 89 94) (Span (Pos 8 9) (Pos 8 14))) "def local():" Nothing
]
it "produces tags for functions with docs" $
parseTestFile [Function] (Path.relFile "test/fixtures/python/tags/simple_function_with_docs.py") `shouldReturn`
[ Tag "Foo" Function (Loc (Range 0 59) (Span (Pos 1 1) (Pos 3 13))) "def Foo(x):" (Just "\"\"\"This is the foo function\"\"\"") ]
[ Tag "Foo" Function (Loc (Range 4 7) (Span (Pos 1 5) (Pos 1 8))) "def Foo(x):" (Just "\"\"\"This is the foo function\"\"\"") ]
it "produces tags for classes" $
parseTestFile [Class, Function] (Path.relFile "test/fixtures/python/tags/class.py") `shouldReturn`
[ Tag "Foo" Class (Loc (Range 0 95) (Span (Pos 1 1) (Pos 5 17))) "class Foo:" (Just "\"\"\"The Foo class\"\"\"")
, Tag "f" Function (Loc (Range 39 95) (Span (Pos 3 5) (Pos 5 17))) "def f(self):" (Just "\"\"\"The f method\"\"\"")
[ Tag "Foo" Class (Loc (Range 6 9) (Span (Pos 1 7) (Pos 1 10))) "class Foo:" (Just "\"\"\"The Foo class\"\"\"")
, Tag "f" Function (Loc (Range 43 44) (Span (Pos 3 9) (Pos 3 10))) "def f(self):" (Just "\"\"\"The f method\"\"\"")
]
it "produces tags for multi-line functions" $
parseTestFile [Function] (Path.relFile "test/fixtures/python/tags/multiline.py") `shouldReturn`
[ Tag "Foo" Function (Loc (Range 0 29) (Span (Pos 1 1) (Pos 3 13))) "def Foo(x," Nothing ]
[ Tag "Foo" Function (Loc (Range 4 7) (Span (Pos 1 5) (Pos 1 8))) "def Foo(x," Nothing ]
describe "ruby" $ do
it "produces tags for methods" $
parseTestFile [Method] (Path.relFile "test/fixtures/ruby/tags/simple_method.rb") `shouldReturn`
[ Tag "foo" Method (Loc (Range 0 31) (Span (Pos 1 1) (Pos 4 4))) "def foo" Nothing ]
[ Tag "foo" Method (Loc (Range 4 7) (Span (Pos 1 5) (Pos 1 8))) "def foo" Nothing ]
it "produces tags for sends" $
parseTestFile [Call] (Path.relFile "test/fixtures/ruby/tags/simple_method.rb") `shouldReturn`
[ Tag "puts" Call (Loc (Range 10 19) (Span (Pos 2 3) (Pos 2 12))) "puts \"hi\"" Nothing
, Tag "bar" Call (Loc (Range 22 27) (Span (Pos 3 3) (Pos 3 8))) "a.bar" Nothing
[ Tag "puts" Call (Loc (Range 10 14) (Span (Pos 2 3) (Pos 2 7))) "puts \"hi\"" Nothing
, Tag "bar" Call (Loc (Range 24 27) (Span (Pos 3 5) (Pos 3 8))) "a.bar" Nothing
, Tag "a" Call (Loc (Range 22 23) (Span (Pos 3 3) (Pos 3 4))) "a" Nothing
]
it "produces tags for methods with docs (TODO)" $
parseTestFile [Method] (Path.relFile "test/fixtures/ruby/tags/simple_method_with_docs.rb") `shouldReturn`
[ Tag "foo" Method (Loc (Range 14 25) (Span (Pos 2 1) (Pos 3 4))) "def foo" Nothing ]
[ Tag "foo" Method (Loc (Range 18 21) (Span (Pos 2 5) (Pos 2 8))) "def foo" Nothing ]
it "correctly tags files containing multibyte UTF-8 characters (TODO)" $
parseTestFile [Method] (Path.relFile "test/fixtures/ruby/tags/unicode_identifiers.rb") `shouldReturn`
[ Tag "日本語" Method (Loc (Range 16 43) (Span (Pos 2 1) (Pos 4 4))) "def 日本語" Nothing]
[ Tag "日本語" Method (Loc (Range 20 29) (Span (Pos 2 5) (Pos 2 14))) "def 日本語" Nothing]
it "produces tags for methods and classes with docs (TODO)" $
parseTestFile [Class, Method, Tags.Module] (Path.relFile "test/fixtures/ruby/tags/class_module.rb") `shouldReturn`
[ Tag "Foo" Tags.Module (Loc (Range 14 118) (Span (Pos 2 1 ) (Pos 12 4))) "module Foo" Nothing
, Tag "Bar" Class (Loc (Range 44 114) (Span (Pos 5 3 ) (Pos 11 6))) "class Bar" Nothing
, Tag "baz" Method (Loc (Range 77 108) (Span (Pos 8 5 ) (Pos 10 8))) "def baz(a)" Nothing
, Tag "C" Class (Loc (Range 120 188) (Span (Pos 14 1) (Pos 20 4))) "class A::B::C" Nothing
, Tag "foo" Method (Loc (Range 136 163) (Span (Pos 15 3) (Pos 17 6))) "def foo" Nothing
, Tag "foo" Method (Loc (Range 166 184) (Span (Pos 18 3) (Pos 19 6))) "def self.foo" Nothing
[ Tag "Foo" Tags.Module (Loc (Range 21 24) (Span (Pos 2 8) (Pos 2 11))) "module Foo" Nothing
, Tag "Bar" Class (Loc (Range 50 53) (Span (Pos 5 9) (Pos 5 12))) "class Bar" Nothing
, Tag "baz" Method (Loc (Range 81 84) (Span (Pos 8 9) (Pos 8 12))) "def baz(a)" Nothing
, Tag "C" Class (Loc (Range 132 133) (Span (Pos 14 13) (Pos 14 14))) "class A::B::C" Nothing
, Tag "foo" Method (Loc (Range 140 143) (Span (Pos 15 7) (Pos 15 10))) "def foo" Nothing
, Tag "foo" Method (Loc (Range 175 178) (Span (Pos 18 12) (Pos 18 15))) "def self.foo" Nothing
]
parseTestFile :: Foldable t => t Tags.Kind -> Path.RelFile -> IO [Tag]

2
test/fixtures/cli/parse-tree.symbols.json vendored
View File

@ -1 +1 @@
{"files":[{"path":"test/fixtures/ruby/corpus/method-declaration.A.rb","language":"Ruby","symbols":[{"symbol":"foo","kind":"Method","line":"def foo","span":{"start":{"line":1,"column":1},"end":{"line":2,"column":4}}}]}]}
{"files":[{"path":"test/fixtures/ruby/corpus/method-declaration.A.rb","language":"Ruby","symbols":[{"symbol":"foo","kind":"Method","line":"def foo","span":{"start":{"line":1,"column":5},"end":{"line":1,"column":8}}}]}]}

2
test/fixtures/cli/parse-tree.symbols.protobuf.bin vendored
View File

@ -2,4 +2,4 @@
_
1test/fixtures/ruby/corpus/method-declaration.A.rbRuby$
fooMethoddef foo"