github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-08 16:39:47 +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

89
docs/codegen.md
View File

@ -1,45 +1,36 @@
@ -1,216 +0,0 @@
# CodeGen Documentation # 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 ## Table of Contents
To get started, first make sure your language has:
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
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).
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|
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) - [CodeGen Pipeline](#codegen-pipeline)
- [Table of Contents](#table-of-contents)
- [Generating ASTs](#generating-asts) - [Generating ASTs](#generating-asts)
- [Inspecting auto-generated datatypes](#inspecting-auto-generated-datatypes) - [Inspecting auto-generated datatypes](#inspecting-auto-generated-datatypes)
- [Tests](#tests) - [Tests](#tests)
- [Additional notes](#additional-notes) - [Additional notes](#additional-notes)
___
### Generating ASTs ## CodeGen Pipeline
The following diagram outlines the entire language support pipeline.
![image](https://user-images.githubusercontent.com/875834/80392707-801e9980-887d-11ea-9c95-e004bbe04be0.png)
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.
## Generating ASTs
To parse source code and produce ASTs locally: 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"}))))})))})) :| []}))))})]}) 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. 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 -- 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. 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` `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. 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).
- 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 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. 

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

@ -4,9 +4,11 @@
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Language.CodeQL.Tags module Language.CodeQL.Tags
( ToTags(..) ( ToTags (..),
) where )
where
import AST.Element import AST.Element
import AST.Token import AST.Token
@ -22,19 +24,19 @@ import Tags.Tag
import qualified Tags.Tagging.Precise as Tags import qualified Tags.Tagging.Precise as Tags
class ToTags t where class ToTags t where
tags tags ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m
) ) =>
=> t Loc t Loc ->
-> m () m ()
default tags default tags ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m,
, Traversable1 ToTags t Traversable1 ToTags t
) ) =>
=> t Loc t Loc ->
-> m () m ()
tags = gtags tags = gtags
instance ToTags (Token sym n) where tags _ = pure () instance ToTags (Token sym n) where tags _ = pure ()
@ -43,84 +45,93 @@ instance (ToTags l, ToTags r) => ToTags (l :+: r) where
tags (L1 l) = tags l tags (L1 l) = tags l
tags (R1 r) = tags r tags (R1 r) = tags r
gtags gtags ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m,
, Traversable1 ToTags t Traversable1 ToTags t
) ) =>
=> t Loc t Loc ->
-> m () m ()
gtags = traverse1_ @ToTags (const (pure ())) tags gtags = traverse1_ @ToTags (const (pure ())) tags
yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m () 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 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 instance ToTags CodeQL.Module where
tags t@CodeQL.Module tags
{ ann = loc@Loc { byteRange } t@CodeQL.Module
, name = CodeQL.ModuleName { extraChildren = CodeQL.SimpleId { text } } { ann = Loc {byteRange},
} = yieldTag text Module loc byteRange >> gtags t name = CodeQL.ModuleName {extraChildren = CodeQL.SimpleId {text, ann}}
} = yieldTag text Module ann byteRange >> gtags t
instance ToTags CodeQL.ClasslessPredicate where instance ToTags CodeQL.ClasslessPredicate where
tags t@CodeQL.ClasslessPredicate tags
{ ann = loc@Loc { byteRange } t@CodeQL.ClasslessPredicate
, name = CodeQL.PredicateName { text } { ann = Loc {byteRange},
} = yieldTag text Function loc byteRange >> gtags t name = CodeQL.PredicateName {text, ann}
} = yieldTag text Function ann byteRange >> gtags t
instance ToTags CodeQL.AritylessPredicateExpr where instance ToTags CodeQL.AritylessPredicateExpr where
tags t@CodeQL.AritylessPredicateExpr tags
{ ann = loc@Loc { byteRange } t@CodeQL.AritylessPredicateExpr
, name = CodeQL.LiteralId { text } { ann = Loc {byteRange},
} = yieldTag text Call loc byteRange >> gtags t name = CodeQL.LiteralId {text, ann}
} = yieldTag text Call ann byteRange >> gtags t
instance ToTags CodeQL.Dataclass where instance ToTags CodeQL.Dataclass where
tags t@CodeQL.Dataclass tags
{ ann = loc@Loc { byteRange } t@CodeQL.Dataclass
, name = CodeQL.ClassName { text } { ann = Loc {byteRange},
} = yieldTag text Class loc byteRange >> gtags t name = CodeQL.ClassName {text, ann}
} = yieldTag text Class ann byteRange >> gtags t
instance ToTags CodeQL.MemberPredicate where instance ToTags CodeQL.MemberPredicate where
tags t@CodeQL.MemberPredicate tags
{ ann = loc@Loc { byteRange } t@CodeQL.MemberPredicate
, name = CodeQL.PredicateName { text } { ann = Loc {byteRange},
} = yieldTag text Method loc byteRange >> gtags t name = CodeQL.PredicateName {text, ann}
} = yieldTag text Method ann byteRange >> gtags t
instance ToTags CodeQL.Datatype where instance ToTags CodeQL.Datatype where
tags t@CodeQL.Datatype tags
{ ann = loc@Loc { byteRange } t@CodeQL.Datatype
, name = CodeQL.ClassName { text } { ann = Loc {byteRange},
} = yieldTag text Class loc byteRange >> gtags t name = CodeQL.ClassName {text, ann}
} = yieldTag text Class ann byteRange >> gtags t
instance ToTags CodeQL.DatatypeBranch where instance ToTags CodeQL.DatatypeBranch where
tags t@CodeQL.DatatypeBranch tags
{ ann = loc@Loc { byteRange } t@CodeQL.DatatypeBranch
, name = CodeQL.ClassName { text } { ann = Loc {byteRange},
} = yieldTag text Class loc byteRange >> gtags t name = CodeQL.ClassName {text, ann}
} = yieldTag text Class ann byteRange >> gtags t
instance ToTags CodeQL.ClasslessPredicateCall where instance ToTags CodeQL.ClasslessPredicateCall where
tags CodeQL.ClasslessPredicateCall tags
CodeQL.ClasslessPredicateCall
{ extraChildren { extraChildren
} = for_ extraChildren $ \x -> case x of } = for_ extraChildren $ \x -> case x of
Prj t@CodeQL.AritylessPredicateExpr {} -> tags t Prj t@CodeQL.AritylessPredicateExpr {} -> tags t
_ -> pure () _ -> pure ()
instance ToTags CodeQL.QualifiedRhs where instance ToTags CodeQL.QualifiedRhs where
tags t@CodeQL.QualifiedRhs tags
{ ann = loc@Loc { byteRange } t@CodeQL.QualifiedRhs
, name = expr { ann = Loc {byteRange},
name = expr
} = case expr of } = case expr of
Just (Prj CodeQL.PredicateName { text }) -> yieldTag text Call loc byteRange >> gtags t Just (Prj CodeQL.PredicateName {text, ann}) -> yieldTag text Call ann byteRange >> gtags t
_ -> gtags t _ -> gtags t
instance ToTags CodeQL.TypeExpr where instance ToTags CodeQL.TypeExpr where
tags t@CodeQL.TypeExpr tags
{ ann = loc@Loc { byteRange } t@CodeQL.TypeExpr
, name = expr { ann = Loc {byteRange},
name = expr
} = case expr of } = case expr of
Just (Prj CodeQL.ClassName { text }) -> yieldTag text Type loc byteRange >> gtags t Just (Prj CodeQL.ClassName {text, ann}) -> yieldTag text Type ann byteRange >> gtags t
_ -> gtags t _ -> gtags t
instance ToTags CodeQL.AddExpr instance ToTags CodeQL.AddExpr

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

@ -1,12 +1,13 @@
{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DefaultSignatures #-}{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Language.Go.Tags module Language.Go.Tags
( ToTags(..) ( ToTags (..),
) where )
where
import AST.Element import AST.Element
import AST.Token import AST.Token
@ -21,46 +22,49 @@ import Tags.Tag
import qualified Tags.Tagging.Precise as Tags import qualified Tags.Tagging.Precise as Tags
class ToTags t where class ToTags t where
tags tags ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m
) ) =>
=> t Loc t Loc ->
-> m () m ()
default tags default tags ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m,
, Traversable1 ToTags t Traversable1 ToTags t
) ) =>
=> t Loc t Loc ->
-> m () m ()
tags = gtags tags = gtags
instance ToTags Go.FunctionDeclaration where instance ToTags Go.FunctionDeclaration where
tags t@Go.FunctionDeclaration tags
{ ann = loc@Loc { byteRange } t@Go.FunctionDeclaration
, name = Go.Identifier { text } { ann = Loc {byteRange},
} = yieldTag text Function loc byteRange >> gtags t name = Go.Identifier {text, ann}
} = yieldTag text Function ann byteRange >> gtags t
instance ToTags Go.MethodDeclaration where instance ToTags Go.MethodDeclaration where
tags t@Go.MethodDeclaration tags
{ ann = loc@Loc { byteRange } t@Go.MethodDeclaration
, name = Go.FieldIdentifier { text } { ann = Loc {byteRange},
} = yieldTag text Method loc byteRange >> gtags t name = Go.FieldIdentifier {text, ann}
} = yieldTag text Method ann byteRange >> gtags t
instance ToTags Go.CallExpression where instance ToTags Go.CallExpression where
tags t@Go.CallExpression tags
{ ann = loc@Loc { byteRange } t@Go.CallExpression
, function = Go.Expression expr { ann = Loc {byteRange},
function = Go.Expression expr
} = match expr } = match expr
where where
match expr = case expr of match expr = case expr of
Prj Go.SelectorExpression { field = Go.FieldIdentifier { text }} -> yield text Prj Go.SelectorExpression {field = Go.FieldIdentifier {text, ann}} -> yield text ann
Prj Go.Identifier { text } -> yield text Prj Go.Identifier {text, ann} -> yield text ann
Prj Go.CallExpression {function = Go.Expression e} -> match e Prj Go.CallExpression {function = Go.Expression e} -> match e
Prj Go.ParenthesizedExpression {extraChildren = Go.Expression e} -> match e Prj Go.ParenthesizedExpression {extraChildren = Go.Expression e} -> match e
_ -> gtags t _ -> gtags t
yield name = yieldTag name Call loc byteRange >> gtags t yield name loc = yieldTag name Call loc byteRange >> gtags t
instance (ToTags l, ToTags r) => ToTags (l :+: r) where instance (ToTags l, ToTags r) => ToTags (l :+: r) where
tags (L1 l) = tags l 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 () instance ToTags (Token sym n) where tags _ = pure ()
gtags gtags ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m,
, Traversable1 ToTags t Traversable1 ToTags t
) ) =>
=> t Loc t Loc ->
-> m () m ()
gtags = traverse1_ @ToTags (const (pure ())) tags gtags = traverse1_ @ToTags (const (pure ())) tags
yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m () 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 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 instance ToTags Go.ArgumentList

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

@ -4,15 +4,18 @@
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Language.Java.Tags
( ToTags(..)
) where
module Language.Java.Tags
( ToTags (..),
)
where
import AST.Element
import AST.Token import AST.Token
import AST.Traversable1 import AST.Traversable1
import Control.Effect.Reader import Control.Effect.Reader
import Control.Effect.Writer import Control.Effect.Writer
import GHC.Generics ((:+:)(..)) import Data.Foldable
import qualified Language.Java.AST as Java import qualified Language.Java.AST as Java
import Source.Loc import Source.Loc
import Source.Range import Source.Range
@ -21,19 +24,19 @@ import Tags.Tag
import qualified Tags.Tagging.Precise as Tags import qualified Tags.Tagging.Precise as Tags
class ToTags t where class ToTags t where
tags tags ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m
) ) =>
=> t Loc t Loc ->
-> m () m ()
default tags default tags ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m,
, Traversable1 ToTags t Traversable1 ToTags t
) ) =>
=> t Loc t Loc ->
-> m () m ()
tags = gtags tags = gtags
instance (ToTags l, ToTags r) => ToTags (l :+: r) where 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 (Token sym n) where tags _ = pure ()
instance ToTags Java.MethodDeclaration where instance ToTags Java.MethodDeclaration where
tags t@Java.MethodDeclaration tags
{ ann = loc@Loc { byteRange = range } t@Java.MethodDeclaration
, name = Java.Identifier { text = name } { ann = Loc {byteRange = range},
, body name = Java.Identifier {text, ann},
body
} = do } = do
src <- ask @Source src <- ask @Source
let line = Tags.firstLine src range let line =
Tags.firstLine
src
range
{ end = case body of { end = case body of
Just Java.Block {ann = Loc Range {end} _} -> end Just Java.Block {ann = Loc Range {end} _} -> end
Nothing -> end range Nothing -> end range
} }
Tags.yield (Tag name Method loc line Nothing) Tags.yield (Tag text Method ann line Nothing)
gtags t 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 instance ToTags Java.ClassDeclaration where
tags t@Java.ClassDeclaration tags
{ ann = loc@Loc { byteRange = Range { start } } t@Java.ClassDeclaration
, name = Java.Identifier { text = name } { ann = Loc {byteRange = Range {start}},
, body = Java.ClassBody { ann = Loc Range { start = end } _ } name = Java.Identifier {text, ann},
body = Java.ClassBody {ann = Loc Range {start = end} _}
} = do } = do
src <- ask @Source 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 gtags t
instance ToTags Java.MethodInvocation where instance ToTags Java.MethodInvocation where
tags t@Java.MethodInvocation tags
{ ann = loc@Loc { byteRange = range } t@Java.MethodInvocation
, name = Java.Identifier { text = name } { ann = Loc {byteRange = range},
name = Java.Identifier {text, ann}
} = do } = do
src <- ask @Source 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 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 instance ToTags Java.InterfaceTypeList where
:: ( Has (Reader Source) sig m tags t@Java.InterfaceTypeList {extraChildren = interfaces} = do
, Has (Writer Tags.Tags) sig m src <- ask @Source
, Traversable1 ToTags t for_ interfaces $ \x -> case x of
) Java.Type (Prj (Java.UnannotatedType (Prj (Java.SimpleType (Prj Java.TypeIdentifier {ann = loc@Loc {byteRange = range}, text = name}))))) ->
=> t Loc Tags.yield (Tag name Implementation loc (Tags.firstLine src range) Nothing)
-> m () _ -> 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 gtags = traverse1_ @ToTags (const (pure ())) tags
instance ToTags Java.AnnotatedType instance ToTags Java.AnnotatedType
@ -153,8 +183,8 @@ instance ToTags Java.InferredParameters
instance ToTags Java.InstanceofExpression instance ToTags Java.InstanceofExpression
instance ToTags Java.IntegralType instance ToTags Java.IntegralType
instance ToTags Java.InterfaceBody instance ToTags Java.InterfaceBody
instance ToTags Java.InterfaceDeclaration --instance ToTags Java.InterfaceDeclaration
instance ToTags Java.InterfaceTypeList -- instance ToTags Java.InterfaceTypeList
instance ToTags Java.LabeledStatement instance ToTags Java.LabeledStatement
instance ToTags Java.LambdaExpression instance ToTags Java.LambdaExpression
instance ToTags Java.Literal instance ToTags Java.Literal

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

@ -5,7 +5,11 @@
{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Language.PHP.Tags (tags) where
module Language.PHP.Tags
( tags,
)
where
import AST.Element import AST.Element
import AST.Token import AST.Token
@ -20,19 +24,19 @@ import Tags.Tag
import qualified Tags.Tagging.Precise as Tags import qualified Tags.Tagging.Precise as Tags
class ToTags t where class ToTags t where
tags tags ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m
) ) =>
=> t Loc t Loc ->
-> m () m ()
default tags default tags ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m,
, Traversable1 ToTags t Traversable1 ToTags t
) ) =>
=> t Loc t Loc ->
-> m () m ()
tags = gtags tags = gtags
instance ToTags (Token sym n) where tags _ = pure () 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 (L1 l) = tags l
tags (R1 r) = tags r tags (R1 r) = tags r
gtags gtags ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m,
, Traversable1 ToTags t Traversable1 ToTags t
) ) =>
=> t Loc t Loc ->
-> m () m ()
gtags = traverse1_ @ToTags (const (pure ())) tags gtags = traverse1_ @ToTags (const (pure ())) tags
yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m () 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 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 instance ToTags PHP.FunctionDefinition where
tags t@PHP.FunctionDefinition tags
{ PHP.ann = loc@Loc { byteRange } t@PHP.FunctionDefinition
, PHP.name = PHP.Name { text } { PHP.ann = Loc {byteRange},
} = yieldTag text Method loc byteRange >> gtags t PHP.name = PHP.Name {text, ann}
} = yieldTag text Method ann byteRange >> gtags t
instance ToTags PHP.MethodDeclaration where instance ToTags PHP.MethodDeclaration where
tags t@PHP.MethodDeclaration tags
{ PHP.ann = loc@Loc { byteRange } t@PHP.MethodDeclaration
, PHP.name = PHP.Name { text } { PHP.ann = Loc {byteRange},
} = yieldTag text Function loc byteRange >> gtags t PHP.name = PHP.Name {text, ann}
} = yieldTag text Function ann byteRange >> gtags t
instance ToTags PHP.FunctionCallExpression where instance ToTags PHP.FunctionCallExpression where
tags t@PHP.FunctionCallExpression tags
{ PHP.ann = loc@Loc { byteRange } t@PHP.FunctionCallExpression
, PHP.function = func { PHP.ann = Loc {byteRange},
PHP.function = func
} = match func } = match func
where 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 match expr = case expr of
Prj (PHP.VariableName { extraChildren = PHP.Name { text } }) Prj PHP.VariableName {extraChildren = PHP.Name {text, ann}} -> yield text ann *> gtags t
-> yield text *> gtags t Prj PHP.QualifiedName {extraChildren = [Prj PHP.Name {text, ann}]} -> yield text ann *> gtags t
Prj (PHP.QualifiedName { extraChildren = [Prj (PHP.Name { text })] }) _ -> gtags t
-> yield text *> gtags t
_
-> gtags t
instance ToTags PHP.MemberCallExpression where instance ToTags PHP.MemberCallExpression where
tags t@PHP.MemberCallExpression tags
{ PHP.ann = loc@Loc { byteRange } t@PHP.MemberCallExpression
, PHP.name = item { PHP.ann = Loc {byteRange},
} = case item of PHP.name = Prj PHP.Name {text, ann}
Prj (PHP.Name { text }) -> yieldTag text Call loc byteRange >> gtags t } = yieldTag text Call ann byteRange >> gtags t
_ -> gtags t tags t = gtags t
instance ToTags PHP.AnonymousFunctionCreationExpression instance ToTags PHP.AnonymousFunctionCreationExpression

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

@ -5,9 +5,11 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Language.Python.Tags module Language.Python.Tags
( ToTags(..) ( ToTags (..),
) where )
where
import AST.Element import AST.Element
import AST.Token import AST.Token
@ -26,19 +28,19 @@ import Tags.Tag
import qualified Tags.Tagging.Precise as Tags import qualified Tags.Tagging.Precise as Tags
class ToTags t where class ToTags t where
tags tags ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m
) ) =>
=> t Loc t Loc ->
-> m () m ()
default tags default tags ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m,
, Traversable1 ToTags t Traversable1 ToTags t
) ) =>
=> t Loc t Loc ->
-> m () m ()
tags = gtags tags = gtags
instance (ToTags l, ToTags r) => ToTags (l :+: r) where instance (ToTags l, ToTags r) => ToTags (l :+: r) where
@ -47,12 +49,16 @@ instance (ToTags l, ToTags r) => ToTags (l :+: r) where
instance ToTags (Token sym n) where tags _ = pure () instance ToTags (Token sym n) where tags _ = pure ()
keywordFunctionCall keywordFunctionCall ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m,
, Traversable1 ToTags t Traversable1 ToTags t
) ) =>
=> t Loc -> Loc -> Range -> Text -> m () t Loc ->
Loc ->
Range ->
Text ->
m ()
keywordFunctionCall t loc range name = yieldTag name Function loc range Nothing >> gtags t keywordFunctionCall t loc range name = yieldTag name Function loc range Nothing >> gtags t
instance ToTags Py.String where instance ToTags Py.String where
@ -87,58 +93,61 @@ 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 instance ToTags Py.FunctionDefinition where
tags t@Py.FunctionDefinition tags
{ ann = loc@Loc { byteRange = Range { start } } t@Py.FunctionDefinition
, name = Py.Identifier { text = name } { ann = Loc {byteRange = Range {start}},
, body = Py.Block { ann = Loc Range { start = end } _, extraChildren } name = Py.Identifier {text, ann},
body = Py.Block {ann = Loc Range {start = end} _, extraChildren}
} = do } = do
src <- ask @Source src <- ask @Source
let docs = listToMaybe extraChildren >>= docComment src 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 instance ToTags Py.ClassDefinition where
tags t@Py.ClassDefinition tags
{ ann = loc@Loc { byteRange = Range { start } } t@Py.ClassDefinition
, name = Py.Identifier { text = name } { ann = Loc {byteRange = Range {start}},
, body = Py.Block { ann = Loc Range { start = end } _, extraChildren } name = Py.Identifier {text, ann},
body = Py.Block {ann = Loc Range {start = end} _, extraChildren}
} = do } = do
src <- ask @Source src <- ask @Source
let docs = listToMaybe extraChildren >>= docComment src 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 instance ToTags Py.Call where
tags t@Py.Call tags
{ ann = loc@Loc { byteRange = range } t@Py.Call
, function = Py.PrimaryExpression expr { ann = Loc {byteRange},
function = Py.PrimaryExpression expr
} = match expr } = match expr
where where
match expr = case expr of match expr = case expr of
(Prj Py.Attribute { attribute = Py.Identifier _ name }) -> yield name Prj Py.Attribute {attribute = Py.Identifier {text, ann}} -> yield text ann
(Prj (Py.Identifier _ name)) -> yield name 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.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 Prj (Py.ParenthesizedExpression _ (Prj (Py.Expression (Prj (Py.PrimaryExpression expr'))))) -> match expr' -- Parenthesized expressions
_ -> gtags t _ -> gtags t
yield name = yieldTag name Call loc range Nothing >> 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 :: (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 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 :: 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 docComment _ _ = Nothing
gtags ::
gtags ( Has (Reader Source) sig m,
:: ( Has (Reader Source) sig m Has (Writer Tags.Tags) sig m,
, Has (Writer Tags.Tags) sig m Traversable1 ToTags t
, Traversable1 ToTags t ) =>
) t Loc ->
=> t Loc m ()
-> m ()
gtags = traverse1_ @ToTags (const (pure ())) tags gtags = traverse1_ @ToTags (const (pure ())) tags
instance ToTags Py.AliasedImport instance ToTags Py.AliasedImport
instance ToTags Py.ArgumentList instance ToTags Py.ArgumentList
-- instance ToTags Py.AssertStatement -- instance ToTags Py.AssertStatement

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

@ -5,11 +5,14 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# HLINT ignore "Reduce duplication" #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Reduce duplication" #-}
module Language.Ruby.Tags module Language.Ruby.Tags
( ToTags(..) ( ToTags (..),
) where )
where
import AST.Element import AST.Element
import AST.Token import AST.Token
@ -29,21 +32,21 @@ import Tags.Tag
import qualified Tags.Tagging.Precise as Tags import qualified Tags.Tagging.Precise as Tags
class ToTags t where class ToTags t where
tags tags ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m,
, Has (State [Text]) sig m Has (State [Text]) sig m
) ) =>
=> t Loc t Loc ->
-> m () m ()
default tags default tags ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m,
, Has (State [Text]) sig m Has (State [Text]) sig m,
, Traversable1 ToTags t Traversable1 ToTags t
) ) =>
=> t Loc t Loc ->
-> m () m ()
tags = gtags tags = gtags
instance ToTags (Token sym n) where tags _ = pure () instance ToTags (Token sym n) where tags _ = pure ()
@ -58,66 +61,69 @@ instance (ToTags l, ToTags r) => ToTags (l :+: r) where
-- current tags output. -- current tags output.
nameBlacklist :: [Text] nameBlacklist :: [Text]
nameBlacklist = nameBlacklist =
[ "alias" [ "alias",
, "load" "load",
, "require_relative" "require_relative",
, "require" "require",
, "super" "super",
, "undef" "undef",
, "__FILE__" "__FILE__",
, "__LINE__" "__LINE__",
, "lambda" "lambda"
] ]
yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m () 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 Call _ _ | name `elem` nameBlacklist = pure ()
yieldTag name kind loc range = do yieldTag name kind loc srcLineRange = do
src <- ask @Source 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 instance ToTags Rb.Class where
tags t@Rb.Class tags
{ ann = loc@Loc { byteRange = Range { start } } t@Rb.Class
, name = expr { ann = Loc {byteRange = Range {start}},
, extraChildren name = expr,
extraChildren
} = enterScope True $ case expr of } = enterScope True $ case expr of
Prj Rb.Constant { text } -> yield text Prj Rb.Constant {text, ann} -> yield text ann
Prj Rb.ScopeResolution { name = Prj Rb.Constant { text } } -> yield text Prj Rb.ScopeResolution {name = Prj Rb.Constant {text, ann}} -> yield text ann
Prj Rb.ScopeResolution { name = Prj Rb.Identifier { text } } -> yield text Prj Rb.ScopeResolution {name = Prj Rb.Identifier {text, ann}} -> yield text ann
_ -> gtags t _ -> gtags t
where where
range' = case extraChildren of range' = case extraChildren of
Prj Rb.Superclass {ann = Loc {byteRange = Range {end}}} : _ -> Range start end Prj Rb.Superclass {ann = Loc {byteRange = Range {end}}} : _ -> Range start end
_ -> Range start (getEnd expr) _ -> Range start (getEnd expr)
getEnd = Range.end . byteRange . TS.gann getEnd = Range.end . byteRange . TS.gann
yield name = yieldTag name Class loc range' >> gtags t yield name loc = yieldTag name Class loc range' >> gtags t
instance ToTags Rb.SingletonClass where instance ToTags Rb.SingletonClass where
tags t@Rb.SingletonClass tags
{ ann = loc@Loc { byteRange = range@Range { start } } t@Rb.SingletonClass
, value = Rb.Arg expr { ann = Loc {byteRange = range@Range {start}},
, extraChildren value = Rb.Arg expr,
extraChildren
} = enterScope True $ case expr of } = 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.Variable (Prj Rb.Constant {text, ann})))))) -> yield text ann
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.Constant {text, ann}})))) -> yield text ann
Prj (Rb.Primary (Prj (Rb.Lhs (Prj Rb.ScopeResolution { name = Prj Rb.Identifier { text } })))) -> yield text Prj (Rb.Primary (Prj (Rb.Lhs (Prj Rb.ScopeResolution {name = Prj Rb.Identifier {text, ann}})))) -> yield text ann
_ -> gtags t _ -> gtags t
where where
range' = case extraChildren of range' = case extraChildren of
x : _ -> Range start (getStart x) x : _ -> Range start (getStart x)
_ -> range _ -> range
getStart = Range.start . byteRange . TS.gann getStart = Range.start . byteRange . TS.gann
yield name = yieldTag name Class loc range' >> gtags t yield name loc = yieldTag name Class loc range' >> gtags t
instance ToTags Rb.Module where instance ToTags Rb.Module where
tags t@Rb.Module tags
{ ann = loc@Loc { byteRange = Range { start } } t@Rb.Module
, name = expr { ann = Loc {byteRange = Range {start}},
, extraChildren name = expr,
extraChildren
} = enterScope True $ case expr of } = enterScope True $ case expr of
Prj Rb.Constant { text = name } -> yield name Prj Rb.Constant {text, ann} -> yield text ann
Prj Rb.ScopeResolution { name = Prj Rb.Constant { text = name } } -> yield name Prj Rb.ScopeResolution {name = Prj Rb.Constant {text, ann}} -> yield text ann
Prj Rb.ScopeResolution { name = Prj Rb.Identifier { text = name } } -> yield name Prj Rb.ScopeResolution {name = Prj Rb.Identifier {text, ann}} -> yield text ann
_ -> gtags t _ -> gtags t
where where
range' = case extraChildren of range' = case extraChildren of
@ -125,27 +131,31 @@ instance ToTags Rb.Module where
_ -> Range start (getEnd expr) _ -> Range start (getEnd expr)
getEnd = Range.end . byteRange . TS.gann getEnd = Range.end . byteRange . TS.gann
getStart = Range.start . byteRange . TS.gann getStart = Range.start . byteRange . TS.gann
yield name = yieldTag name Module loc range' >> gtags t yield name loc = yieldTag name Module loc range' >> gtags t
yieldMethodNameTag yieldMethodNameTag ::
:: ( Has (State [Text]) sig m ( Has (State [Text]) sig m,
, Has (Reader Source) sig m Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m,
, Traversable1 ToTags t Traversable1 ToTags t
) => t Loc -> Loc -> Range -> Rb.MethodName Loc -> m () ) =>
yieldMethodNameTag t loc range (Rb.MethodName expr) = enterScope True $ case expr of t Loc ->
Prj Rb.Identifier { text = name } -> yield name Range ->
Prj Rb.Constant { text = name } -> yield name 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.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.GlobalVariable { text = name } -> yield name
-- Prj Rb.InstanceVariable { 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. 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? -- TODO: Should we report symbol method names as tags?
-- Prj Rb.Symbol { extraChildren = [Prj Rb.EscapeSequence { text = name }] } -> yield name -- Prj Rb.Symbol { extraChildren = [Prj Rb.EscapeSequence { text = name }] } -> yield name
_ -> gtags t _ -> gtags t
where 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 :: (Has (State [Text]) sig m) => Bool -> m () -> m ()
enterScope createNew m = do enterScope createNew m = do
@ -155,11 +165,12 @@ enterScope createNew m = do
put locals put locals
instance ToTags Rb.Method where instance ToTags Rb.Method where
tags t@Rb.Method tags
{ ann = loc@Loc { byteRange = Range { start } } t@Rb.Method
, name { ann = Loc {byteRange = Range {start}},
, parameters name,
} = yieldMethodNameTag t loc range' name parameters
} = yieldMethodNameTag t range' name
where where
range' = case parameters of range' = case parameters of
Just Rb.MethodParameters {ann = Loc {byteRange = Range {end}}} -> Range start end Just Rb.MethodParameters {ann = Loc {byteRange = Range {end}}} -> Range start end
@ -167,11 +178,12 @@ instance ToTags Rb.Method where
getEnd = Range.end . byteRange . TS.gann getEnd = Range.end . byteRange . TS.gann
instance ToTags Rb.SingletonMethod where instance ToTags Rb.SingletonMethod where
tags t@Rb.SingletonMethod tags
{ ann = loc@Loc { byteRange = Range { start } } t@Rb.SingletonMethod
, name { ann = Loc {byteRange = Range {start}},
, parameters name,
} = yieldMethodNameTag t loc range' name parameters
} = yieldMethodNameTag t range' name
where where
range' = case parameters of range' = case parameters of
Just Rb.MethodParameters {ann = Loc {byteRange = Range {end}}} -> Range start end Just Rb.MethodParameters {ann = Loc {byteRange = Range {end}}} -> Range start end
@ -219,20 +231,20 @@ instance ToTags Rb.Regex where
instance ToTags Rb.Subshell where 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 instance ToTags Rb.Lhs where
tags t@(Rb.Lhs expr) = case expr of tags t@(Rb.Lhs expr) = case expr of
-- NOTE: Calls do not look for locals -- NOTE: Calls do not look for locals
Prj Rb.Call { ann = loc@Loc { byteRange }, method } -> case method of Prj Rb.Call {ann = Loc {byteRange}, method} -> case method of
Prj Rb.Identifier { text } -> yieldCall text loc byteRange Prj Rb.Identifier {text, ann} -> yieldCall text ann byteRange
Prj Rb.Constant { text } -> yieldCall text loc byteRange Prj Rb.Constant {text, ann} -> yieldCall text ann byteRange
Prj Rb.Operator { text } -> yieldCall text loc byteRange Prj Rb.Operator {text, ann} -> yieldCall text ann byteRange
_ -> gtags t _ -> gtags t
-- These do check for locals before yielding a call tag -- 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.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.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 Call loc byteRange -- TODO: Should yield Constant
-- 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 Call loc byteRange -- TODO: Should yield Constant
-- Prj Rb.ScopeResolution { ann = loc@Loc { byteRange }, name = Prj Rb.Constant { text } } -> yield text Constant loc byteRange
_ -> gtags t _ -> gtags t
where where
yieldCall name loc range = yieldTag name Call loc range >> gtags t yieldCall name loc range = yieldTag name Call loc range >> gtags t
@ -241,55 +253,63 @@ instance ToTags Rb.Lhs where
unless (name `elem` locals) $ yieldTag name kind loc range unless (name `elem` locals) $ yieldTag name kind loc range
gtags t gtags t
-- TODO: Line of source produced here could be better.
instance ToTags Rb.MethodCall where instance ToTags Rb.MethodCall where
tags t@Rb.MethodCall tags
{ ann = loc@Loc { byteRange = byteRange@Range {} } t@Rb.MethodCall
, method = expr { ann = Loc {byteRange = byteRange@Range {}},
method = expr
} = case expr of } = case expr of
Prj (Rb.Variable (Prj Rb.Identifier { text = name })) -> yield name Call Prj (Rb.Variable (Prj Rb.Identifier {text, ann})) -> yield text Call ann
Prj (Rb.Variable (Prj Rb.Constant { text = name })) -> yield name Call -- TODO: Should yield Constant Prj (Rb.Variable (Prj Rb.Constant {text, ann})) -> yield text Call ann -- TODO: Should yield Constant
Prj Rb.ScopeResolution { name = Prj Rb.Identifier { text } } -> yield text Call Prj Rb.ScopeResolution {name = Prj Rb.Identifier {text, ann}} -> yield text Call ann
Prj Rb.ScopeResolution { name = Prj Rb.Constant { text } } -> yield text Call -- TODO: Should yield Constant 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.Call {method} -> case method of
Prj Rb.Identifier { text } -> yield text Call Prj Rb.Identifier {text, ann} -> yield text Call ann
Prj Rb.Constant { text } -> yield text Call Prj Rb.Constant {text, ann} -> yield text Call ann
Prj Rb.Operator { text } -> yield text Call Prj Rb.Operator {text, ann} -> yield text Call ann
_ -> gtags t _ -> gtags t
_ -> gtags t _ -> gtags t
where where
yield name kind = yieldTag name kind loc byteRange >> gtags t yield name kind loc = yieldTag name kind loc byteRange >> gtags t
instance ToTags Rb.Alias where instance ToTags Rb.Alias where
tags t@Rb.Alias tags
{ alias = Rb.MethodName aliasExpr t@Rb.Alias
, name = Rb.MethodName nameExpr { alias = Rb.MethodName aliasExpr,
name = Rb.MethodName nameExpr,
ann = Loc {byteRange}
} = do } = do
case aliasExpr of case aliasExpr of
Prj Rb.Identifier { ann = loc@Loc { byteRange}, text } -> yieldTag text Function loc byteRange Prj Rb.Identifier {ann, text} -> yieldTag text Function ann byteRange
_ -> tags aliasExpr _ -> tags aliasExpr
case nameExpr of case nameExpr of
Prj Rb.Identifier { ann = loc@Loc { byteRange}, text } -> yieldTag text Call loc byteRange Prj Rb.Identifier {ann, text} -> yieldTag text Call ann byteRange
_ -> tags nameExpr _ -> tags nameExpr
gtags t gtags t
instance ToTags Rb.Undef where instance ToTags Rb.Undef where
tags t@Rb.Undef tags
{ extraChildren t@Rb.Undef
{ extraChildren,
ann = Loc {byteRange}
} = for_ extraChildren $ \(Rb.MethodName expr) -> do } = for_ extraChildren $ \(Rb.MethodName expr) -> do
case expr of case expr of
Prj Rb.Identifier { ann = loc@Loc { byteRange }, text } -> yieldTag text Call loc byteRange Prj Rb.Identifier {ann, text} -> yieldTag text Call ann byteRange
_ -> tags expr _ -> tags expr
gtags t gtags t
introduceLocals introduceLocals ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m,
, Has (State [Text]) sig m Has (State [Text]) sig m
) =>
[ ( (Rb.BlockParameter :+: Rb.DestructuredParameter :+: Rb.HashSplatParameter)
:+: ((Rb.Identifier :+: Rb.KeywordParameter) :+: (Rb.OptionalParameter :+: Rb.SplatParameter))
) )
=> [((Rb.BlockParameter :+: Rb.DestructuredParameter :+: Rb.HashSplatParameter) :+: Loc
((Rb.Identifier :+: Rb.KeywordParameter) :+: (Rb.OptionalParameter :+: Rb.SplatParameter))) ] ->
Loc ] m ()
-> m ()
introduceLocals params = for_ params $ \param -> case param of introduceLocals params = for_ params $ \param -> case param of
Prj Rb.BlockParameter {name = Rb.Identifier {text = lvar}} -> modify (lvar :) Prj Rb.BlockParameter {name = Rb.Identifier {text = lvar}} -> modify (lvar :)
Prj Rb.DestructuredParameter {extraChildren} -> introduceLocals extraChildren Prj Rb.DestructuredParameter {extraChildren} -> introduceLocals extraChildren
@ -330,16 +350,17 @@ instance ToTags Rb.OperatorAssignment where
_ -> pure () _ -> pure ()
gtags t gtags t
gtags gtags ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m,
, Has (State [Text]) sig m Has (State [Text]) sig m,
, Traversable1 ToTags t Traversable1 ToTags t
) ) =>
=> t Loc t Loc ->
-> m () m ()
gtags = traverse1_ @ToTags (const (pure ())) tags gtags = traverse1_ @ToTags (const (pure ())) tags
-- instance ToTags Rb.Alias -- instance ToTags Rb.Alias
instance ToTags Rb.Arg instance ToTags Rb.Arg
instance ToTags Rb.ArgumentList instance ToTags Rb.ArgumentList

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

@ -23,7 +23,11 @@ data Kind
| Module | Module
-- References -- References
| Call | Call
-- Types
| Type | 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 -- Constant -- TODO: New kind for constant references
deriving (Bounded, Enum, Eq, Show) deriving (Bounded, Enum, Eq, Show)

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

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

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

@ -5,9 +5,11 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Language.TypeScript.Tags module Language.TypeScript.Tags
( ToTags(..) ( ToTags (..),
) where )
where
import AST.Element import AST.Element
import AST.Token import AST.Token
@ -23,127 +25,96 @@ import Tags.Tag
import qualified Tags.Tagging.Precise as Tags import qualified Tags.Tagging.Precise as Tags
class ToTags t where class ToTags t where
tags tags ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m
) ) =>
=> t Loc t Loc ->
-> m () m ()
default tags default tags ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m,
, Traversable1 ToTags t Traversable1 ToTags t
) ) =>
=> t Loc t Loc ->
-> m () m ()
tags = gtags tags = gtags
instance ToTags Ts.Function where instance ToTags Ts.Function where
tags t@Ts.Function tags t@Ts.Function {ann = Loc {byteRange}, name = Just Ts.Identifier {text, ann}} =
{ ann = loc@Loc { byteRange } yieldTag text Function ann byteRange >> gtags t
, name = Just Ts.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t
tags t = gtags t tags t = gtags t
instance ToTags Ts.FunctionSignature where instance ToTags Ts.FunctionSignature where
tags t@Ts.FunctionSignature tags t@Ts.FunctionSignature {ann = Loc {byteRange}, name = Ts.Identifier {text, ann}} =
{ ann = loc@Loc { byteRange } yieldTag text Function ann byteRange >> gtags t
, name = Ts.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t
instance ToTags Ts.FunctionDeclaration where instance ToTags Ts.FunctionDeclaration where
tags t@Ts.FunctionDeclaration tags t@Ts.FunctionDeclaration {ann = Loc {byteRange}, name = Ts.Identifier {text, ann}} =
{ ann = loc@Loc { byteRange } yieldTag text Function ann byteRange >> gtags t
, name = Ts.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t
instance ToTags Ts.MethodDefinition where instance ToTags Ts.MethodDefinition where
tags t@Ts.MethodDefinition tags t@Ts.MethodDefinition {ann = Loc {byteRange}, name} = case name of
{ ann = loc@Loc { byteRange } Prj Ts.PropertyIdentifier {text, ann} -> yieldTag text Method ann byteRange >> gtags t
, name
} = case name of
Prj Ts.PropertyIdentifier { text } -> yield text
-- TODO: There are more here
_ -> gtags t _ -> gtags t
where
yield name = yieldTag name Method loc byteRange >> gtags t
instance ToTags Ts.Pair where instance ToTags Ts.Pair where
tags t@Ts.Pair tags t@Ts.Pair {ann = Loc {byteRange}, key, value = Ts.Expression expr} = case (key, expr) of
{ ann = loc@Loc { byteRange } (Prj Ts.PropertyIdentifier {text, ann}, Prj Ts.Function {}) -> yield text ann
, key (Prj Ts.PropertyIdentifier {text, ann}, Prj Ts.ArrowFunction {}) -> yield text ann
, 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 _ -> gtags t
where 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 instance ToTags Ts.ClassDeclaration where
tags t@Ts.ClassDeclaration tags t@Ts.ClassDeclaration {ann = Loc {byteRange}, name = Ts.TypeIdentifier {text, ann}} =
{ ann = loc@Loc { byteRange } yieldTag text Class ann byteRange >> gtags t
, name = Ts.TypeIdentifier { text }
} = yieldTag text Class loc byteRange >> gtags t
instance ToTags Ts.CallExpression where instance ToTags Ts.CallExpression where
tags t@Ts.CallExpression tags t@Ts.CallExpression {ann = Loc {byteRange}, function = Ts.Expression expr} = match expr
{ ann = loc@Loc { byteRange }
, function = Ts.Expression expr
} = match expr
where where
match expr = case expr of match expr = case expr of
Prj Ts.Identifier { text } -> yield text Prj Ts.Identifier {text, ann} -> yield text ann
Prj Ts.NewExpression { constructor = Prj Ts.Identifier { text } } -> yield text Prj Ts.NewExpression {constructor = Prj Ts.Identifier {text, ann}} -> yield text ann
Prj Ts.CallExpression {function = Ts.Expression expr} -> match expr Prj Ts.CallExpression {function = Ts.Expression expr} -> match expr
Prj Ts.MemberExpression { property = Ts.PropertyIdentifier { text } } -> yield text Prj Ts.MemberExpression {property = Ts.PropertyIdentifier {text, ann}} -> yield text ann
Prj Ts.Function { name = Just Ts.Identifier { text }} -> yield text Prj Ts.Function {name = Just Ts.Identifier {text, ann}} -> yield text ann
Prj Ts.ParenthesizedExpression {extraChildren} -> for_ extraChildren $ \x -> case x of Prj Ts.ParenthesizedExpression {extraChildren} -> for_ extraChildren $ \x -> case x of
Prj (Ts.Expression expr) -> match expr Prj (Ts.Expression expr) -> match expr
_ -> tags x _ -> tags x
_ -> gtags t _ -> 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 instance ToTags Ts.Module where
tags t@Ts.Module tags t@Ts.Module {ann = Loc {byteRange}, name} = case name of
{ ann = loc@Loc { byteRange } Prj Ts.Identifier {text, ann} -> yieldTag text Module ann byteRange >> gtags t
, 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 _ -> gtags t
yield text = yieldTag text Module loc byteRange >> gtags t
instance ToTags Ts.VariableDeclarator where instance ToTags Ts.VariableDeclarator where
tags t@Ts.VariableDeclarator tags t@Ts.VariableDeclarator {ann = Loc {byteRange}, name, value = Just (Ts.Expression expr)} =
{ ann = loc@Loc { byteRange } case (expr, name) of
, name (Prj Ts.Function {}, Prj Ts.Identifier {text, ann}) -> yield text ann
, value = Just (Ts.Expression expr) (Prj Ts.ArrowFunction {}, Prj Ts.Identifier {text, ann}) -> yield text ann
} = case (expr, name) of
(Prj Ts.Function{}, Prj Ts.Identifier { text }) -> yield text
(Prj Ts.ArrowFunction{}, Prj Ts.Identifier { text }) -> yield text
_ -> gtags t _ -> gtags t
where where
yield text = yieldTag text Function loc byteRange >> gtags t yield text loc = yieldTag text Function loc byteRange >> gtags t
tags t = gtags t tags t = gtags t
instance ToTags Ts.AssignmentExpression where instance ToTags Ts.AssignmentExpression where
tags t@Ts.AssignmentExpression tags t@Ts.AssignmentExpression {ann = Loc {byteRange}, left, right = (Ts.Expression expr)} =
{ ann = loc@Loc { byteRange } case (left, expr) of
, left (Prj Ts.Identifier {text, ann}, Prj Ts.Function {}) -> yield text ann
, right = (Ts.Expression expr) (Prj Ts.Identifier {text, ann}, Prj Ts.ArrowFunction {}) -> yield text ann
} = case (left, expr) of (Prj Ts.MemberExpression {property = Ts.PropertyIdentifier {text, ann}}, Prj Ts.Function {}) -> yield text ann
(Prj Ts.Identifier { text }, Prj Ts.Function{}) -> yield text (Prj Ts.MemberExpression {property = Ts.PropertyIdentifier {text, ann}}, Prj Ts.ArrowFunction {}) -> yield text ann
(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 _ -> gtags t
where 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 instance (ToTags l, ToTags r) => ToTags (l :+: r) where
tags (L1 l) = tags l 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 () instance ToTags (Token sym n) where tags _ = pure ()
gtags gtags ::
:: ( Has (Reader Source) sig m ( Has (Reader Source) sig m,
, Has (Writer Tags.Tags) sig m Has (Writer Tags.Tags) sig m,
, Traversable1 ToTags t Traversable1 ToTags t
) ) =>
=> t Loc t Loc ->
-> m () m ()
gtags = traverse1_ @ToTags (const (pure ())) tags gtags = traverse1_ @ToTags (const (pure ())) tags
-- These are all valid, but point to built-in functions (e.g. require) that a la -- 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 -- 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. -- jump-to-def), we hide them from the current tags output.
nameBlacklist :: [Text] nameBlacklist :: [Text]
nameBlacklist = nameBlacklist = ["require"]
[ "require"
]
yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m () 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 Call _ _ | name `elem` nameBlacklist = pure ()
yieldTag name kind loc range = do yieldTag name kind loc srcLineRange = do
src <- ask @Source 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.AbstractClassDeclaration
instance ToTags Ts.AbstractMethodSignature instance ToTags Ts.AbstractMethodSignature
instance ToTags Ts.AccessibilityModifier instance ToTags Ts.AccessibilityModifier
@ -193,7 +163,7 @@ instance ToTags Ts.BreakStatement
-- instance ToTags Ts.CallExpression -- instance ToTags Ts.CallExpression
instance ToTags Ts.CallSignature instance ToTags Ts.CallSignature
instance ToTags Ts.CatchClause instance ToTags Ts.CatchClause
instance ToTags Ts.Class -- instance ToTags Ts.Class
instance ToTags Ts.ClassBody instance ToTags Ts.ClassBody
-- instance ToTags Ts.ClassDeclaration -- instance ToTags Ts.ClassDeclaration
instance ToTags Ts.ClassHeritage instance ToTags Ts.ClassHeritage
@ -333,3 +303,4 @@ instance ToTags Ts.VariableDeclaration
instance ToTags Ts.WhileStatement instance ToTags Ts.WhileStatement
instance ToTags Ts.WithStatement instance ToTags Ts.WithStatement
instance ToTags Ts.YieldExpression 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 :: (String, [Blob] -> ParseC TaskC Builder, [File Language], Path.RelFile) -> TestTree
testForParseFixture (format, runParse, files, expected) = testForParseFixture (format, runParse, files, expected) =
goldenVsStringDiff goldenVsStringDiff
("diff fixture renders to " <> format) ("parse fixture renders to " <> format)
renderDiff renderDiff
(Path.toString expected) (Path.toString expected)
(fmap toLazyByteString . runTaskOrDie $ readBlobs (FilesFromPaths files) >>= runParse) (fmap toLazyByteString . runTaskOrDie $ readBlobs (FilesFromPaths files) >>= runParse)

50
test/Tags/Spec.hs
View File

@ -14,80 +14,80 @@ spec = do
describe "go" $ do describe "go" $ do
it "produces tags for functions with docs (TODO)" $ it "produces tags for functions with docs (TODO)" $
parseTestFile [Function] (Path.relFile "test/fixtures/go/tags/simple_functions.go") `shouldReturn` 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 "TestFromBits" Function (Loc (Range 56 68) (Span (Pos 6 6) (Pos 6 18))) "func TestFromBits(t *testing.T) {" Nothing
, Tag "Hi" Function (Loc (Range 94 107) (Span (Pos 10 1) (Pos 11 2))) "func Hi() {" Nothing ] , Tag "Hi" Function (Loc (Range 99 101) (Span (Pos 10 6) (Pos 10 8))) "func Hi() {" Nothing ]
it "produces tags for methods" $ it "produces tags for methods" $
parseTestFile [Method] (Path.relFile "test/fixtures/go/tags/method.go") `shouldReturn` 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" $ it "produces tags for calls" $
parseTestFile [Call] (Path.relFile "test/fixtures/go/tags/simple_functions.go") `shouldReturn` 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 describe "javascript and typescript" $ do
it "produces tags for functions with docs (TODO)" $ it "produces tags for functions with docs (TODO)" $
parseTestFile [Function] (Path.relFile "test/fixtures/javascript/tags/simple_function_with_docs.js") `shouldReturn` 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" $ it "produces tags for classes" $
parseTestFile [Class] (Path.relFile "test/fixtures/typescript/tags/class.ts") `shouldReturn` 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" $ it "produces tags for modules" $
parseTestFile [Tags.Module] (Path.relFile "test/fixtures/typescript/tags/module.ts") `shouldReturn` 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 describe "python" $ do
it "produces tags for functions" $ it "produces tags for functions" $
parseTestFile [Function] (Path.relFile "test/fixtures/python/tags/simple_functions.py") `shouldReturn` 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 "Foo" Function (Loc (Range 4 7) (Span (Pos 1 5) (Pos 1 8))) "def Foo(x):" Nothing
, Tag "Bar" Function (Loc (Range 70 136) (Span (Pos 7 1) (Pos 11 13))) "def Bar():" Nothing , Tag "Bar" Function (Loc (Range 74 77) (Span (Pos 7 5) (Pos 7 8))) "def Bar():" Nothing
, Tag "local" Function (Loc (Range 85 114) (Span (Pos 8 5) (Pos 9 17))) "def local():" 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" $ it "produces tags for functions with docs" $
parseTestFile [Function] (Path.relFile "test/fixtures/python/tags/simple_function_with_docs.py") `shouldReturn` 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" $ it "produces tags for classes" $
parseTestFile [Class, Function] (Path.relFile "test/fixtures/python/tags/class.py") `shouldReturn` 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 "Foo" Class (Loc (Range 6 9) (Span (Pos 1 7) (Pos 1 10))) "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 "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" $ it "produces tags for multi-line functions" $
parseTestFile [Function] (Path.relFile "test/fixtures/python/tags/multiline.py") `shouldReturn` 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 describe "ruby" $ do
it "produces tags for methods" $ it "produces tags for methods" $
parseTestFile [Method] (Path.relFile "test/fixtures/ruby/tags/simple_method.rb") `shouldReturn` 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" $ it "produces tags for sends" $
parseTestFile [Call] (Path.relFile "test/fixtures/ruby/tags/simple_method.rb") `shouldReturn` 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 "puts" Call (Loc (Range 10 14) (Span (Pos 2 3) (Pos 2 7))) "puts \"hi\"" Nothing
, Tag "bar" Call (Loc (Range 22 27) (Span (Pos 3 3) (Pos 3 8))) "a.bar" 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 , Tag "a" Call (Loc (Range 22 23) (Span (Pos 3 3) (Pos 3 4))) "a" Nothing
] ]
it "produces tags for methods with docs (TODO)" $ it "produces tags for methods with docs (TODO)" $
parseTestFile [Method] (Path.relFile "test/fixtures/ruby/tags/simple_method_with_docs.rb") `shouldReturn` 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)" $ it "correctly tags files containing multibyte UTF-8 characters (TODO)" $
parseTestFile [Method] (Path.relFile "test/fixtures/ruby/tags/unicode_identifiers.rb") `shouldReturn` 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)" $ 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` 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 "Foo" Tags.Module (Loc (Range 21 24) (Span (Pos 2 8) (Pos 2 11))) "module Foo" Nothing
, Tag "Bar" Class (Loc (Range 44 114) (Span (Pos 5 3 ) (Pos 11 6))) "class Bar" Nothing , Tag "Bar" Class (Loc (Range 50 53) (Span (Pos 5 9) (Pos 5 12))) "class Bar" Nothing
, Tag "baz" Method (Loc (Range 77 108) (Span (Pos 8 5 ) (Pos 10 8))) "def baz(a)" Nothing , Tag "baz" Method (Loc (Range 81 84) (Span (Pos 8 9) (Pos 8 12))) "def baz(a)" Nothing
, Tag "C" Class (Loc (Range 120 188) (Span (Pos 14 1) (Pos 20 4))) "class A::B::C" 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 136 163) (Span (Pos 15 3) (Pos 17 6))) "def foo" Nothing , Tag "foo" Method (Loc (Range 140 143) (Span (Pos 15 7) (Pos 15 10))) "def foo" Nothing
, Tag "foo" Method (Loc (Range 166 184) (Span (Pos 18 3) (Pos 19 6))) "def self.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] 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$ 1test/fixtures/ruby/corpus/method-declaration.A.rbRuby$
fooMethoddef foo" fooMethoddef foo"