github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-27 03:09:48 +03:00
Code Issues Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/master' into semantic-scope-graph

Browse Source
This commit is contained in:
Patrick Thomson 2020-01-17 11:24:07 -05:00
commit 37e1c1095b
47 changed files with 1463 additions and 586 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
.github/workflows/haskell.yml vendored
View File

@ -42,8 +42,8 @@ jobs:
- name: Install dependencies
run: |
cabal v2-update
cabal v2-configure --disable-optimization --enable-benchmarks --enable-tests --write-ghc-environment-files=always -j2
cabal v2-build all --only-dependencies
cabal v2-configure --project-file=cabal.project.ci --disable-optimization --enable-benchmarks --enable-tests --write-ghc-environment-files=always -j2
cabal v2-build --project-file=cabal.project.ci all --only-dependencies
- name: hlint
run: |
@ -52,10 +52,10 @@ jobs:
- name: Build & test
run: |
cabal v2-build
cabal v2-run semantic:test
cabal v2-run semantic-core:test
cabal v2-run semantic-python:test:compiling
cabal v2-run semantic-python:test:graphing
cd semantic-source; cabal v2-run semantic-source:test; cd ..
cd semantic-source; cabal v2-run semantic-source:doctest -- src; cd ..
cabal v2-build --project-file=cabal.project.ci
cabal v2-run --project-file=cabal.project.ci semantic:test
cabal v2-run --project-file=cabal.project.ci semantic-core:test
cabal v2-run --project-file=cabal.project.ci semantic-python:test:compiling
cabal v2-run --project-file=cabal.project.ci semantic-python:test:graphing
cd semantic-source; cabal v2-run --project-file=cabal.project.ci semantic-source:test; cd ..
cd semantic-source; cabal v2-run --project-file=cabal.project.ci semantic-source:doctest -- src; cd ..

40
cabal.project
View File

@ -1,3 +1,6 @@
-- ATTENTION: care must be taken to keep this file in sync with cabal.project.ci. If you add a package here, add it there (and add a package stanza with ghc-options to enable errors in CI at the bottom of that file).
-- Local packages
packages: .
semantic-analysis
semantic-ast
@ -12,41 +15,8 @@ packages: .
semantic-tags
semantic-scope-graph
jobs: $ncpus
package semantic
ghc-options: -Werror
package semantic-analysis
ghc-options: -Werror
package semantic-core
ghc-options: -Werror
package semantic-go
ghc-options: -Werror
package semantic-java
ghc-options: -Werror
package semantic-json
ghc-options: -Werror
package semantic-python
ghc-options: -Werror
package semantic-ruby
ghc-options: -Werror
package semantic-tags
ghc-options: -Werror
package semantic-scope-graph
ghc-options: -Werror
package semantic-ast
ghc-options: -Werror
-- Packages brought in from other repos instead of hackage
-- ATTENTION: remember to update cabal.project.ci when bumping SHAs here!
source-repository-package
type: git
location: https://github.com/tclem/proto-lens-jsonpb

70
cabal.project.ci Normal file
View File

@ -0,0 +1,70 @@
-- ATTENTION: care must be taken to keep this file in sync with cabal.project. If you add a package here, add it there (and add a package stanza with ghc-options to enable errors in CI at the bottom of this file).
-- Local packages
packages: .
semantic-analysis
semantic-ast
semantic-core
semantic-go
semantic-java
semantic-json
semantic-python
semantic-ruby
semantic-tsx
semantic-typescript
semantic-tags
-- Packages brought in from other repos instead of hackage
-- ATTENTION: remember to update cabal.project when bumping SHAs here!
source-repository-package
type: git
location: https://github.com/tclem/proto-lens-jsonpb
tag: 5d40444be689bef1e12cbe38da0261283775ec64
source-repository-package
type: git
location: https://github.com/antitypical/fused-syntax.git
tag: d11e14581217590a5c67f79cbaeee35ac8acee6a
source-repository-package
type: git
location: https://github.com/fused-effects/fused-effects-readline.git
tag: 7a96949c77c73c6e5975c8d6171ffb63eb76b467
-- Treat warnings as errors for CI builds
package semantic
ghc-options: -Werror
package semantic-analysis
ghc-options: -Werror
package semantic-ast
ghc-options: -Werror
package semantic-core
ghc-options: -Werror
package semantic-go
ghc-options: -Werror
package semantic-java
ghc-options: -Werror
package semantic-json
ghc-options: -Werror
package semantic-python
ghc-options: -Werror
package semantic-ruby
ghc-options: -Werror
package semantic-tags
ghc-options: -Werror
package semantic-tsx
ghc-options: -Werror
package semantic-typescript
ghc-options: -Werror

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

@ -1,17 +1,9 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Language.Go.Tags
( ToTags(..)
) where
@ -26,6 +18,7 @@ import Source.Source as Source
import Tags.Tag
import qualified Tags.Tagging.Precise as Tags
import qualified TreeSitter.Go.AST as Go
import TreeSitter.Token
class ToTags t where
tags
@ -34,58 +27,47 @@ class ToTags t where
)
=> t Loc
-> m ()
instance (ToTagsBy strategy t, strategy ~ ToTagsInstance t) => ToTags t where
tags = tags' @strategy
class ToTagsBy (strategy :: Strategy) t where
tags'
default tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Generic1 t
, Tags.GTraversable1 ToTags (Rep1 t)
)
=> t Loc
-> m ()
tags = gtags
data Strategy = Generic | Custom
type family ToTagsInstance t :: Strategy where
ToTagsInstance (_ :+: _) = 'Custom
ToTagsInstance Go.FunctionDeclaration = 'Custom
ToTagsInstance Go.MethodDeclaration = 'Custom
ToTagsInstance Go.CallExpression = 'Custom
ToTagsInstance _ = 'Generic
instance ToTagsBy 'Custom Go.FunctionDeclaration where
tags' t@Go.FunctionDeclaration
instance ToTags Go.FunctionDeclaration where
tags t@Go.FunctionDeclaration
{ ann = loc@Loc { byteRange }
, name = Go.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t
instance ToTagsBy 'Custom Go.MethodDeclaration where
tags' t@Go.MethodDeclaration
instance ToTags Go.MethodDeclaration where
tags t@Go.MethodDeclaration
{ ann = loc@Loc { byteRange }
, name = Go.FieldIdentifier { text }
} = yieldTag text Function loc byteRange >> gtags t
instance ToTagsBy 'Custom Go.CallExpression where
tags' t@Go.CallExpression
instance ToTags Go.CallExpression where
tags t@Go.CallExpression
{ ann = loc@Loc { byteRange }
, function = Go.Expression expr
} = match expr
where
match expr = case expr of
Prj Go.SelectorExpression { field = Go.FieldIdentifier { text }} -> yield text
Prj Go.Identifier { text } -> yield text
Prj Go.CallExpression { function = Go.Expression e } -> match e
Prj Go.SelectorExpression { field = Go.FieldIdentifier { text }} -> yield text
Prj Go.Identifier { text } -> yield text
Prj Go.CallExpression { function = Go.Expression e } -> match e
Prj Go.ParenthesizedExpression { extraChildren = Go.Expression e } -> match e
_ -> gtags t
_ -> gtags t
yield name = yieldTag name Call loc byteRange >> gtags t
instance (ToTags l, ToTags r) => ToTagsBy 'Custom (l :+: r) where
tags' (L1 l) = tags l
tags' (R1 r) = tags r
instance (ToTags l, ToTags r) => ToTags (l :+: r) where
tags (L1 l) = tags l
tags (R1 r) = tags r
instance ToTags (Token sym n) where tags _ = pure ()
gtags
:: ( Has (Reader Source) sig m
@ -97,11 +79,108 @@ gtags
-> m ()
gtags = Tags.traverse1_ @ToTags (const (pure ())) tags . Tags.Generics
instance (Generic1 t, Tags.GTraversable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
tags' = gtags
yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m ()
yieldTag name kind loc range = do
src <- ask @Source
let sliced = slice src range
Tags.yield (Tag name kind loc (Tags.firstLine sliced) Nothing)
instance ToTags Go.ArgumentList
instance ToTags Go.ArrayType
instance ToTags Go.AssignmentStatement
instance ToTags Go.BinaryExpression
instance ToTags Go.BlankIdentifier
instance ToTags Go.Block
instance ToTags Go.BreakStatement
-- instance ToTags Go.CallExpression
instance ToTags Go.ChannelType
instance ToTags Go.CommunicationCase
instance ToTags Go.CompositeLiteral
instance ToTags Go.ConstDeclaration
instance ToTags Go.ConstSpec
instance ToTags Go.ContinueStatement
instance ToTags Go.DecStatement
instance ToTags Go.DefaultCase
instance ToTags Go.DeferStatement
instance ToTags Go.Dot
instance ToTags Go.Element
instance ToTags Go.EmptyStatement
instance ToTags Go.EscapeSequence
instance ToTags Go.Expression
instance ToTags Go.ExpressionCase
instance ToTags Go.ExpressionList
instance ToTags Go.ExpressionSwitchStatement
instance ToTags Go.FallthroughStatement
instance ToTags Go.False
instance ToTags Go.FieldDeclaration
instance ToTags Go.FieldDeclarationList
instance ToTags Go.FieldIdentifier
instance ToTags Go.FloatLiteral
instance ToTags Go.ForClause
instance ToTags Go.ForStatement
instance ToTags Go.FuncLiteral
-- instance ToTags Go.FunctionDeclaration
instance ToTags Go.FunctionType
instance ToTags Go.GoStatement
instance ToTags Go.GotoStatement
instance ToTags Go.Identifier
instance ToTags Go.IfStatement
instance ToTags Go.ImaginaryLiteral
instance ToTags Go.ImplicitLengthArrayType
instance ToTags Go.ImportDeclaration
instance ToTags Go.ImportSpec
instance ToTags Go.ImportSpecList
instance ToTags Go.IncStatement
instance ToTags Go.IndexExpression
instance ToTags Go.IntLiteral
instance ToTags Go.InterfaceType
instance ToTags Go.InterpretedStringLiteral
instance ToTags Go.KeyedElement
instance ToTags Go.LabelName
instance ToTags Go.LabeledStatement
instance ToTags Go.LiteralValue
instance ToTags Go.MapType
-- instance ToTags Go.MethodDeclaration
instance ToTags Go.MethodSpec
instance ToTags Go.MethodSpecList
instance ToTags Go.Nil
instance ToTags Go.PackageClause
instance ToTags Go.PackageIdentifier
instance ToTags Go.ParameterDeclaration
instance ToTags Go.ParameterList
instance ToTags Go.ParenthesizedExpression
instance ToTags Go.ParenthesizedType
instance ToTags Go.PointerType
instance ToTags Go.QualifiedType
instance ToTags Go.RangeClause
instance ToTags Go.RawStringLiteral
instance ToTags Go.ReceiveStatement
instance ToTags Go.ReturnStatement
instance ToTags Go.RuneLiteral
instance ToTags Go.SelectStatement
instance ToTags Go.SelectorExpression
instance ToTags Go.SendStatement
instance ToTags Go.ShortVarDeclaration
instance ToTags Go.SimpleStatement
instance ToTags Go.SimpleType
instance ToTags Go.SliceExpression
instance ToTags Go.SliceType
instance ToTags Go.SourceFile
instance ToTags Go.Statement
instance ToTags Go.StructType
instance ToTags Go.True
instance ToTags Go.Type
instance ToTags Go.TypeAlias
instance ToTags Go.TypeAssertionExpression
instance ToTags Go.TypeCase
instance ToTags Go.TypeConversionExpression
instance ToTags Go.TypeDeclaration
instance ToTags Go.TypeIdentifier
instance ToTags Go.TypeSpec
instance ToTags Go.TypeSwitchStatement
instance ToTags Go.UnaryExpression
instance ToTags Go.VarDeclaration
instance ToTags Go.VarSpec
instance ToTags Go.VariadicArgument
instance ToTags Go.VariadicParameterDeclaration

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

@ -1,4 +1,9 @@
{-# LANGUAGE AllowAmbiguousTypes, DataKinds, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Language.Java.Tags
( ToTags(..)
) where
@ -12,6 +17,7 @@ import Source.Source as Source
import Tags.Tag
import qualified Tags.Tagging.Precise as Tags
import qualified TreeSitter.Java.AST as Java
import TreeSitter.Token
class ToTags t where
tags
@ -20,36 +26,24 @@ class ToTags t where
)
=> t Loc
-> m ()
instance (ToTagsBy strategy t, strategy ~ ToTagsInstance t) => ToTags t where
tags = tags' @strategy
class ToTagsBy (strategy :: Strategy) t where
tags'
default tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Generic1 t
, Tags.GTraversable1 ToTags (Rep1 t)
)
=> t Loc
-> m ()
tags = gtags
instance (ToTags l, ToTags r) => ToTags (l :+: r) where
tags (L1 l) = tags l
tags (R1 r) = tags r
data Strategy = Generic | Custom
instance ToTags (Token sym n) where tags _ = pure ()
type family ToTagsInstance t :: Strategy where
ToTagsInstance (_ :+: _) = 'Custom
ToTagsInstance Java.MethodDeclaration = 'Custom
ToTagsInstance Java.MethodInvocation = 'Custom
ToTagsInstance Java.ClassDeclaration = 'Custom
ToTagsInstance _ = 'Generic
instance (ToTags l, ToTags r) => ToTagsBy 'Custom (l :+: r) where
tags' (L1 l) = tags l
tags' (R1 r) = tags r
instance ToTagsBy 'Custom Java.MethodDeclaration where
tags' t@Java.MethodDeclaration
instance ToTags Java.MethodDeclaration where
tags t@Java.MethodDeclaration
{ ann = loc@Loc { byteRange = range }
, name = Java.Identifier { text = name }
, body
@ -63,8 +57,8 @@ instance ToTagsBy 'Custom Java.MethodDeclaration where
Tags.yield (Tag name Method loc (Tags.firstLine sliced) Nothing)
gtags t
instance ToTagsBy 'Custom Java.ClassDeclaration where
tags' t@Java.ClassDeclaration
instance ToTags Java.ClassDeclaration where
tags t@Java.ClassDeclaration
{ ann = loc@Loc { byteRange = Range { start } }
, name = Java.Identifier { text = name }
, body = Java.ClassBody { ann = Loc Range { start = end } _ }
@ -74,8 +68,8 @@ instance ToTagsBy 'Custom Java.ClassDeclaration where
Tags.yield (Tag name Class loc (Tags.firstLine sliced) Nothing)
gtags t
instance ToTagsBy 'Custom Java.MethodInvocation where
tags' t@Java.MethodInvocation
instance ToTags Java.MethodInvocation where
tags t@Java.MethodInvocation
{ ann = loc@Loc { byteRange = range }
, name = Java.Identifier { text = name }
} = do
@ -95,5 +89,131 @@ gtags
-> m ()
gtags = Tags.traverse1_ @ToTags (const (pure ())) tags . Tags.Generics
instance (Generic1 t, Tags.GTraversable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
tags' = gtags
instance ToTags Java.AnnotatedType
instance ToTags Java.Annotation
instance ToTags Java.AnnotationArgumentList
instance ToTags Java.AnnotationTypeBody
instance ToTags Java.AnnotationTypeDeclaration
instance ToTags Java.AnnotationTypeElementDeclaration
instance ToTags Java.ArgumentList
instance ToTags Java.ArrayAccess
instance ToTags Java.ArrayCreationExpression
instance ToTags Java.ArrayInitializer
instance ToTags Java.ArrayType
instance ToTags Java.AssertStatement
instance ToTags Java.AssignmentExpression
instance ToTags Java.Asterisk
instance ToTags Java.BinaryExpression
instance ToTags Java.BinaryIntegerLiteral
instance ToTags Java.Block
instance ToTags Java.BooleanType
instance ToTags Java.BreakStatement
instance ToTags Java.CastExpression
instance ToTags Java.CatchClause
instance ToTags Java.CatchFormalParameter
instance ToTags Java.CatchType
instance ToTags Java.CharacterLiteral
instance ToTags Java.ClassBody
-- instance ToTags Java.ClassDeclaration
instance ToTags Java.ClassLiteral
instance ToTags Java.ConstantDeclaration
instance ToTags Java.ConstructorBody
instance ToTags Java.ConstructorDeclaration
instance ToTags Java.ContinueStatement
instance ToTags Java.DecimalFloatingPointLiteral
instance ToTags Java.DecimalIntegerLiteral
instance ToTags Java.Declaration
instance ToTags Java.Dimensions
instance ToTags Java.DimensionsExpr
instance ToTags Java.DoStatement
instance ToTags Java.ElementValueArrayInitializer
instance ToTags Java.ElementValuePair
instance ToTags Java.EnhancedForStatement
instance ToTags Java.EnumBody
instance ToTags Java.EnumBodyDeclarations
instance ToTags Java.EnumConstant
instance ToTags Java.EnumDeclaration
instance ToTags Java.ExplicitConstructorInvocation
instance ToTags Java.Expression
instance ToTags Java.ExpressionStatement
instance ToTags Java.ExtendsInterfaces
instance ToTags Java.False
instance ToTags Java.FieldAccess
instance ToTags Java.FieldDeclaration
instance ToTags Java.FinallyClause
instance ToTags Java.FloatingPointType
instance ToTags Java.ForInit
instance ToTags Java.ForStatement
instance ToTags Java.FormalParameter
instance ToTags Java.FormalParameters
instance ToTags Java.GenericType
instance ToTags Java.HexFloatingPointLiteral
instance ToTags Java.HexIntegerLiteral
instance ToTags Java.Identifier
instance ToTags Java.IfStatement
instance ToTags Java.ImportDeclaration
instance ToTags Java.InferredParameters
instance ToTags Java.InstanceofExpression
instance ToTags Java.IntegralType
instance ToTags Java.InterfaceBody
instance ToTags Java.InterfaceDeclaration
instance ToTags Java.InterfaceTypeList
instance ToTags Java.LabeledStatement
instance ToTags Java.LambdaExpression
instance ToTags Java.Literal
instance ToTags Java.LocalVariableDeclaration
instance ToTags Java.LocalVariableDeclarationStatement
instance ToTags Java.MarkerAnnotation
-- instance ToTags Java.MethodDeclaration
-- instance ToTags Java.MethodInvocation
instance ToTags Java.MethodReference
instance ToTags Java.Modifiers
instance ToTags Java.ModuleDeclaration
instance ToTags Java.ModuleDirective
instance ToTags Java.ModuleName
instance ToTags Java.NullLiteral
instance ToTags Java.ObjectCreationExpression
instance ToTags Java.OctalIntegerLiteral
instance ToTags Java.PackageDeclaration
instance ToTags Java.ParenthesizedExpression
instance ToTags Java.Primary
instance ToTags Java.Program
instance ToTags Java.ReceiverParameter
instance ToTags Java.RequiresModifier
instance ToTags Java.Resource
instance ToTags Java.ResourceSpecification
instance ToTags Java.ReturnStatement
instance ToTags Java.ScopedIdentifier
instance ToTags Java.ScopedTypeIdentifier
instance ToTags Java.SimpleType
instance ToTags Java.SpreadParameter
instance ToTags Java.Statement
instance ToTags Java.StaticInitializer
instance ToTags Java.StringLiteral
instance ToTags Java.Super
instance ToTags Java.SuperInterfaces
instance ToTags Java.Superclass
instance ToTags Java.SwitchBlock
instance ToTags Java.SwitchLabel
instance ToTags Java.SwitchStatement
instance ToTags Java.SynchronizedStatement
instance ToTags Java.TernaryExpression
instance ToTags Java.This
instance ToTags Java.ThrowStatement
instance ToTags Java.Throws
instance ToTags Java.True
instance ToTags Java.TryStatement
instance ToTags Java.TryWithResourcesStatement
instance ToTags Java.Type
instance ToTags Java.TypeArguments
instance ToTags Java.TypeBound
instance ToTags Java.TypeIdentifier
instance ToTags Java.TypeParameter
instance ToTags Java.TypeParameters
instance ToTags Java.UnannotatedType
instance ToTags Java.UnaryExpression
instance ToTags Java.UpdateExpression
instance ToTags Java.VariableDeclarator
instance ToTags Java.VoidType
instance ToTags Java.WhileStatement
instance ToTags Java.Wildcard

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

@ -1,17 +1,10 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Language.Python.Tags
( ToTags(..)
) where
@ -19,8 +12,8 @@ module Language.Python.Tags
import AST.Element
import Control.Effect.Reader
import Control.Effect.Writer
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (listToMaybe)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Text as Text
import GHC.Generics
import Source.Loc
@ -29,6 +22,7 @@ import Source.Source as Source
import Tags.Tag
import qualified Tags.Tagging.Precise as Tags
import qualified TreeSitter.Python.AST as Py
import TreeSitter.Token
class ToTags t where
tags
@ -37,43 +31,21 @@ class ToTags t where
)
=> t Loc
-> m ()
instance (ToTagsBy strategy t, strategy ~ ToTagsInstance t) => ToTags t where
tags = tags' @strategy
class ToTagsBy (strategy :: Strategy) t where
tags'
default tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Generic1 t
, Tags.GTraversable1 ToTags (Rep1 t)
)
=> t Loc
-> m ()
tags = gtags
instance (ToTags l, ToTags r) => ToTags (l :+: r) where
tags (L1 l) = tags l
tags (R1 r) = tags r
data Strategy = Generic | Custom
type family ToTagsInstance t :: Strategy where
ToTagsInstance (_ :+: _) = 'Custom
ToTagsInstance Py.FunctionDefinition = 'Custom
ToTagsInstance Py.ClassDefinition = 'Custom
ToTagsInstance Py.Call = 'Custom
-- These built-in functions all get handled as calls
ToTagsInstance Py.AssertStatement = 'Custom
ToTagsInstance Py.Await = 'Custom
ToTagsInstance Py.DeleteStatement = 'Custom
ToTagsInstance Py.ExecStatement = 'Custom
ToTagsInstance Py.GlobalStatement = 'Custom
ToTagsInstance Py.NonlocalStatement = 'Custom
ToTagsInstance Py.PrintStatement = 'Custom
ToTagsInstance _ = 'Generic
instance (ToTags l, ToTags r) => ToTagsBy 'Custom (l :+: r) where
tags' (L1 l) = tags l
tags' (R1 r) = tags r
instance ToTags (Token sym n) where tags _ = pure ()
keywordFunctionCall
:: ( Has (Reader Source) sig m
@ -82,75 +54,71 @@ keywordFunctionCall
, Tags.GTraversable1 ToTags (Rep1 t)
)
=> t Loc -> Loc -> Range -> Text -> m ()
keywordFunctionCall t loc range name = do
src <- ask @Source
let sliced = slice src range
Tags.yield (Tag name Function loc (Tags.firstLine sliced) Nothing)
gtags t
keywordFunctionCall t loc range name = yieldTag name Function loc range Nothing >> gtags t
instance ToTagsBy 'Custom Py.AssertStatement where
tags' t@Py.AssertStatement { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "assert"
instance ToTags Py.Interpolation where
tags Py.Interpolation { } = pure ()
instance ToTagsBy 'Custom Py.Await where
tags' t@Py.Await { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "await"
instance ToTags Py.AssertStatement where
tags t@Py.AssertStatement { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "assert"
instance ToTagsBy 'Custom Py.DeleteStatement where
tags' t@Py.DeleteStatement { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "del"
instance ToTags Py.Await where
tags t@Py.Await { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "await"
instance ToTagsBy 'Custom Py.ExecStatement where
tags' t@Py.ExecStatement { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "exec"
instance ToTags Py.DeleteStatement where
tags t@Py.DeleteStatement { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "del"
instance ToTagsBy 'Custom Py.GlobalStatement where
tags' t@Py.GlobalStatement { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "global"
instance ToTags Py.ExecStatement where
tags t@Py.ExecStatement { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "exec"
instance ToTagsBy 'Custom Py.NonlocalStatement where
tags' t@Py.NonlocalStatement { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "nonlocal"
instance ToTags Py.GlobalStatement where
tags t@Py.GlobalStatement { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "global"
instance ToTagsBy 'Custom Py.PrintStatement where
tags' t@Py.PrintStatement { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "print"
instance ToTags Py.NonlocalStatement where
tags t@Py.NonlocalStatement { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "nonlocal"
instance ToTagsBy 'Custom Py.FunctionDefinition where
tags' t@Py.FunctionDefinition
instance ToTags Py.PrintStatement where
tags t@Py.PrintStatement { ann = loc@Loc { byteRange } } = keywordFunctionCall t loc byteRange "print"
instance ToTags Py.FunctionDefinition where
tags t@Py.FunctionDefinition
{ ann = loc@Loc { byteRange = Range { start } }
, name = Py.Identifier { text = name }
, body = Py.Block { ann = Loc Range { start = end } _, extraChildren }
} = do
src <- ask @Source
let docs = listToMaybe extraChildren >>= docComment src
sliced = slice src (Range start end)
Tags.yield (Tag name Function loc (Tags.firstLine sliced) docs)
gtags t
yieldTag name Function loc (Range start end) docs >> gtags t
instance ToTagsBy 'Custom Py.ClassDefinition where
tags' t@Py.ClassDefinition
instance ToTags Py.ClassDefinition where
tags t@Py.ClassDefinition
{ ann = loc@Loc { byteRange = Range { start } }
, name = Py.Identifier { text = name }
, body = Py.Block { ann = Loc Range { start = end } _, extraChildren }
} = do
src <- ask @Source
let docs = listToMaybe extraChildren >>= docComment src
sliced = slice src (Range start end)
Tags.yield (Tag name Class loc (Tags.firstLine sliced) docs)
gtags t
yieldTag name Class loc (Range start end) docs >> gtags t
instance ToTagsBy 'Custom Py.Call where
tags' t@Py.Call
instance ToTags Py.Call where
tags t@Py.Call
{ ann = loc@Loc { byteRange = range }
, function = Py.PrimaryExpression expr
} = match expr
where
match expr = case expr of
(Prj Py.Attribute { attribute = Py.Identifier _ name }) -> yield name
(Prj (Py.Identifier _ name)) -> yield name
(Prj Py.Call { function = Py.PrimaryExpression expr' }) -> match expr' -- Nested call expression like this in Python represent creating an instance of a class and calling it: e.g. AClass()()
(Prj (Py.ParenthesizedExpression _ (Prj (Py.Expression (Prj (Py.PrimaryExpression expr')))))) -> match expr' -- Parenthesized expressions
_ -> gtags t
yield name = do
src <- ask @Source
let sliced = slice src range
Tags.yield (Tag name Call loc (Tags.firstLine sliced) Nothing)
gtags t
where
match expr = case expr of
(Prj Py.Attribute { attribute = Py.Identifier _ name }) -> yield name
(Prj (Py.Identifier _ name)) -> yield name
(Prj Py.Call { function = Py.PrimaryExpression expr' }) -> match expr' -- Nested call expression like this in Python represent creating an instance of a class and calling it: e.g. AClass()()
(Prj (Py.ParenthesizedExpression _ (Prj (Py.Expression (Prj (Py.PrimaryExpression expr')))))) -> match expr' -- Parenthesized expressions
_ -> gtags t
yield name = yieldTag name Call loc range Nothing >> gtags t
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
src <- ask @Source
let sliced = Tags.firstLine (slice src range)
Tags.yield (Tag name kind loc sliced docs)
docComment :: Source -> (Py.CompoundStatement :+: Py.SimpleStatement) Loc -> Maybe Text
docComment src (R1 (Py.SimpleStatement (Prj Py.ExpressionStatement { extraChildren = L1 (Prj (Py.Expression (Prj (Py.PrimaryExpression (Prj Py.String { ann }))))) :|_ }))) = Just (toText (slice src (byteRange ann)))
@ -167,5 +135,99 @@ gtags
-> m ()
gtags = Tags.traverse1_ @ToTags (const (pure ())) tags . Tags.Generics
instance (Generic1 t, Tags.GTraversable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
tags' = gtags
instance ToTags Py.AliasedImport
instance ToTags Py.ArgumentList
-- instance ToTags Py.AssertStatement
instance ToTags Py.Assignment
instance ToTags Py.Attribute
instance ToTags Py.AugmentedAssignment
-- instance ToTags Py.Await
instance ToTags Py.BinaryOperator
instance ToTags Py.Block
instance ToTags Py.BooleanOperator
instance ToTags Py.BreakStatement
-- instance ToTags Py.Call
instance ToTags Py.Chevron
-- instance ToTags Py.ClassDefinition
instance ToTags Py.ComparisonOperator
instance ToTags Py.CompoundStatement
instance ToTags Py.ConcatenatedString
instance ToTags Py.ConditionalExpression
instance ToTags Py.ContinueStatement
instance ToTags Py.DecoratedDefinition
instance ToTags Py.Decorator
instance ToTags Py.DefaultParameter
-- instance ToTags Py.DeleteStatement
instance ToTags Py.Dictionary
instance ToTags Py.DictionaryComprehension
instance ToTags Py.DictionarySplat
instance ToTags Py.DottedName
instance ToTags Py.ElifClause
instance ToTags Py.Ellipsis
instance ToTags Py.ElseClause
instance ToTags Py.EscapeSequence
instance ToTags Py.ExceptClause
-- instance ToTags Py.ExecStatement
instance ToTags Py.Expression
instance ToTags Py.ExpressionList
instance ToTags Py.ExpressionStatement
instance ToTags Py.False
instance ToTags Py.FinallyClause
instance ToTags Py.Float
instance ToTags Py.ForInClause
instance ToTags Py.ForStatement
instance ToTags Py.FormatExpression
instance ToTags Py.FormatSpecifier
-- instance ToTags Py.FunctionDefinition
instance ToTags Py.FutureImportStatement
instance ToTags Py.GeneratorExpression
-- instance ToTags Py.GlobalStatement
instance ToTags Py.Identifier
instance ToTags Py.IfClause
instance ToTags Py.IfStatement
instance ToTags Py.ImportFromStatement
instance ToTags Py.ImportPrefix
instance ToTags Py.ImportStatement
instance ToTags Py.Integer
-- instance ToTags Py.Interpolation
instance ToTags Py.KeywordArgument
instance ToTags Py.Lambda
instance ToTags Py.LambdaParameters
instance ToTags Py.List
instance ToTags Py.ListComprehension
instance ToTags Py.ListSplat
instance ToTags Py.Module
instance ToTags Py.NamedExpression
instance ToTags Py.None
-- instance ToTags Py.NonlocalStatement
instance ToTags Py.NotOperator
instance ToTags Py.Pair
instance ToTags Py.Parameter
instance ToTags Py.Parameters
instance ToTags Py.ParenthesizedExpression
instance ToTags Py.PassStatement
instance ToTags Py.PrimaryExpression
-- instance ToTags Py.PrintStatement
instance ToTags Py.RaiseStatement
instance ToTags Py.RelativeImport
instance ToTags Py.ReturnStatement
instance ToTags Py.Set
instance ToTags Py.SetComprehension
instance ToTags Py.SimpleStatement
instance ToTags Py.Slice
instance ToTags Py.String
instance ToTags Py.Subscript
instance ToTags Py.True
instance ToTags Py.TryStatement
instance ToTags Py.Tuple
instance ToTags Py.Type
instance ToTags Py.TypeConversion
instance ToTags Py.TypedDefaultParameter
instance ToTags Py.TypedParameter
instance ToTags Py.UnaryOperator
instance ToTags Py.Variables
instance ToTags Py.WhileStatement
instance ToTags Py.WildcardImport
instance ToTags Py.WithItem
instance ToTags Py.WithStatement
instance ToTags Py.Yield

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

@ -1,18 +1,12 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# HLINT ignore "Reduce duplication" #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
module Language.Ruby.Tags
( ToTags(..)
) where
@ -26,10 +20,13 @@ import Data.Foldable
import Data.Text as Text
import GHC.Generics
import Source.Loc
import Source.Range as Range
import Source.Source as Source
import Tags.Tag
import qualified Tags.Tagging.Precise as Tags
import qualified TreeSitter.Ruby.AST as Rb
import TreeSitter.Token
import qualified TreeSitter.Unmarshal as TS
class ToTags t where
tags
@ -39,54 +36,22 @@ class ToTags t where
)
=> t Loc
-> m ()
instance (ToTagsBy strategy t, strategy ~ ToTagsInstance t) => ToTags t where
tags = tags' @strategy
class ToTagsBy (strategy :: Strategy) t where
tags'
default tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Has (State [Text]) sig m
, Generic1 t
, Tags.GTraversable1 ToTags (Rep1 t)
)
=> t Loc
-> m ()
tags = gtags
instance ToTags (Token sym n) where tags _ = pure ()
data Strategy = Generic | Custom
type family ToTagsInstance t :: Strategy where
ToTagsInstance (_ :+: _) = 'Custom
ToTagsInstance Rb.Class = 'Custom
ToTagsInstance Rb.SingletonClass = 'Custom
ToTagsInstance Rb.Module = 'Custom
ToTagsInstance Rb.Method = 'Custom
ToTagsInstance Rb.SingletonMethod = 'Custom
ToTagsInstance Rb.Call = 'Custom
ToTagsInstance Rb.Lhs = 'Custom
ToTagsInstance Rb.MethodCall = 'Custom
ToTagsInstance Rb.Alias = 'Custom
ToTagsInstance Rb.Undef = 'Custom
-- Along with class, module, and method definitions, these introduce new lexical scopes for locals
ToTagsInstance Rb.Block = 'Custom
ToTagsInstance Rb.DoBlock = 'Custom
ToTagsInstance Rb.Lambda = 'Custom
-- Parameters and assignment introduce locals
ToTagsInstance Rb.MethodParameters = 'Custom
ToTagsInstance Rb.LambdaParameters = 'Custom
ToTagsInstance Rb.BlockParameters = 'Custom
ToTagsInstance Rb.Assignment = 'Custom
ToTagsInstance _ = 'Generic
instance (ToTags l, ToTags r) => ToTagsBy 'Custom (l :+: r) where
tags' (L1 l) = tags l
tags' (R1 r) = tags r
instance (ToTags l, ToTags r) => ToTags (l :+: r) where
tags (L1 l) = tags l
tags (R1 r) = tags r
-- These are all valid, but point to methods in Kernel and other parts of the
-- Ruby stdlib. A la carte displays some of these, but not others and since we
@ -101,6 +66,7 @@ nameBlacklist =
, "super"
, "undef"
, "__FILE__"
, "__LINE__"
, "lambda"
]
@ -111,41 +77,57 @@ yieldTag name kind loc range = do
let sliced = slice src range
Tags.yield (Tag name kind loc (Tags.firstLine sliced) Nothing)
instance ToTagsBy 'Custom Rb.Class where
tags' t@Rb.Class
{ ann = loc@Loc { byteRange = range }
instance ToTags Rb.Class where
tags t@Rb.Class
{ ann = loc@Loc { byteRange = Range { start } }
, name = expr
, extraChildren
} = enterScope True $ case expr of
Prj Rb.Constant { text } -> yield text
Prj Rb.ScopeResolution { name = Prj Rb.Constant { text } } -> yield text
Prj Rb.Constant { text } -> yield text
Prj Rb.ScopeResolution { name = Prj Rb.Constant { text } } -> yield text
Prj Rb.ScopeResolution { name = Prj Rb.Identifier { text } } -> yield text
_ -> gtags t
_ -> gtags t
where
yield name = yieldTag name Class loc range >> gtags t
range' = case extraChildren of
Prj Rb.Superclass { ann = Loc { byteRange = Range { end }}} : _ -> Range start end
_ -> Range start (getEnd expr)
getEnd = Range.end . byteRange . TS.gann
yield name = yieldTag name Class loc range' >> gtags t
instance ToTagsBy 'Custom Rb.SingletonClass where
tags' t@Rb.SingletonClass
{ ann = loc@Loc { byteRange = range }
instance ToTags Rb.SingletonClass where
tags t@Rb.SingletonClass
{ ann = loc@Loc { byteRange = range@Range { start } }
, value = Rb.Arg expr
, extraChildren
} = enterScope True $ case expr of
Prj (Rb.Primary (Prj (Rb.Lhs (Prj (Rb.Variable (Prj Rb.Constant { text })))))) -> yield text
Prj (Rb.Primary (Prj (Rb.Lhs (Prj Rb.ScopeResolution { name = Prj Rb.Constant { text } })))) -> yield text
Prj (Rb.Primary (Prj (Rb.Lhs (Prj (Rb.Variable (Prj Rb.Constant { text })))))) -> yield text
Prj (Rb.Primary (Prj (Rb.Lhs (Prj Rb.ScopeResolution { name = Prj Rb.Constant { text } })))) -> yield text
Prj (Rb.Primary (Prj (Rb.Lhs (Prj Rb.ScopeResolution { name = Prj Rb.Identifier { text } })))) -> yield text
_ -> gtags t
_ -> gtags t
where
yield name = yieldTag name Class loc range >> gtags t
range' = case extraChildren of
x : _ -> Range start (getStart x)
_ -> range
getStart = Range.start . byteRange . TS.gann
yield name = yieldTag name Class loc range' >> gtags t
instance ToTagsBy 'Custom Rb.Module where
tags' t@Rb.Module
{ ann = loc@Loc { byteRange = range }
instance ToTags Rb.Module where
tags t@Rb.Module
{ ann = loc@Loc { byteRange = Range { start } }
, name = expr
, extraChildren
} = enterScope True $ case expr of
Prj Rb.Constant { text = name } -> yield name
Prj Rb.ScopeResolution { name = Prj Rb.Constant { text = name } } -> yield name
Prj Rb.Constant { text = name } -> yield name
Prj Rb.ScopeResolution { name = Prj Rb.Constant { text = name } } -> yield name
Prj Rb.ScopeResolution { name = Prj Rb.Identifier { text = name } } -> yield name
_ -> gtags t
_ -> gtags t
where
yield name = yieldTag name Module loc range >> gtags t
range' = case extraChildren of
x : _ -> Range start (getStart x)
_ -> Range start (getEnd expr)
getEnd = Range.end . byteRange . TS.gann
getStart = Range.start . byteRange . TS.gann
yield name = yieldTag name Module loc range' >> gtags t
yieldMethodNameTag
:: ( Has (State [Text]) sig m
@ -155,16 +137,16 @@ yieldMethodNameTag
, Tags.GTraversable1 ToTags (Rep1 t)
) => t Loc -> Loc -> Range -> Rb.MethodName Loc -> m ()
yieldMethodNameTag t loc range (Rb.MethodName expr) = enterScope True $ case expr of
Prj Rb.Identifier { text = name } -> yield name
Prj Rb.Constant { text = name } -> yield name
Prj Rb.Identifier { text = name } -> yield name
Prj Rb.Constant { text = name } -> yield name
-- Prj Rb.ClassVariable { text = name } -> yield name
Prj Rb.Operator { text = name } -> yield name
Prj Rb.Operator { text = name } -> yield name
-- Prj Rb.GlobalVariable { text = name } -> yield name
-- Prj Rb.InstanceVariable { text = name } -> yield name
Prj Rb.Setter { extraChildren = Rb.Identifier { text = name } } -> yield (name <> "=") -- NB: Matches existing tags output, TODO: Remove this.
-- TODO: Should we report symbol method names as tags?
-- Prj Rb.Symbol { extraChildren = [Prj Rb.EscapeSequence { text = name }] } -> yield name
_ -> gtags t
_ -> gtags t
where
yield name = yieldTag name Function loc range >> gtags t
@ -175,41 +157,80 @@ enterScope createNew m = do
m
put locals
instance ToTagsBy 'Custom Rb.Method where
tags' t@Rb.Method
{ ann = loc@Loc { byteRange = range }
, name = expr
} = yieldMethodNameTag t loc range expr
instance ToTagsBy 'Custom Rb.SingletonMethod where
tags' t@Rb.SingletonMethod
{ ann = loc@Loc { byteRange = range }
, name = expr
} = yieldMethodNameTag t loc range expr
instance ToTagsBy 'Custom Rb.Block where
tags' = enterScope False . gtags
instance ToTagsBy 'Custom Rb.DoBlock where
tags' = enterScope False . gtags
instance ToTagsBy 'Custom Rb.Lambda where
tags' = enterScope False . gtags
instance ToTagsBy 'Custom Rb.Call where
tags' t@Rb.Call
{ ann = loc@Loc { byteRange = range }
, method = expr
} = case expr of
Prj Rb.Identifier { text = name } -> yield name Call
Prj Rb.Constant { text = name } -> yield name Call -- TODO: Should be Constant
Prj Rb.Operator { text = name } -> yield name Call
_ -> gtags t
instance ToTags Rb.Method where
tags t@Rb.Method
{ ann = loc@Loc { byteRange = Range { start } }
, name
, parameters
} = yieldMethodNameTag t loc range' name
where
yield name kind = yieldTag name kind loc range >> gtags t
range' = case parameters of
Just Rb.MethodParameters { ann = Loc { byteRange = Range { end } }} -> Range start end
_ -> Range start (getEnd name)
getEnd = Range.end . byteRange . TS.gann
instance ToTagsBy 'Custom Rb.Lhs where
tags' t@(Rb.Lhs expr) = case expr of
instance ToTags Rb.SingletonMethod where
tags t@Rb.SingletonMethod
{ ann = loc@Loc { byteRange = Range { start } }
, name
, parameters
} = yieldMethodNameTag t loc range' name
where
range' = case parameters of
Just Rb.MethodParameters { ann = Loc { byteRange = Range { end } }} -> Range start end
_ -> Range start (getEnd name)
getEnd = Range.end . byteRange . TS.gann
instance ToTags Rb.Block where
tags = enterScope False . gtags
instance ToTags Rb.DoBlock where
tags = enterScope False . gtags
instance ToTags Rb.Lambda where
tags Rb.Lambda { body, parameters } = enterScope False $ do
maybe (pure ()) tags parameters
tags body
instance ToTags Rb.If where
tags Rb.If { condition, consequence, alternative } = do
tags condition
maybe (pure ()) tags consequence
maybe (pure ()) tags alternative
instance ToTags Rb.Elsif where
tags Rb.Elsif { condition, consequence, alternative } = do
tags condition
maybe (pure ()) tags consequence
maybe (pure ()) tags alternative
instance ToTags Rb.Unless where
tags Rb.Unless { condition, consequence, alternative } = do
tags condition
maybe (pure ()) tags consequence
maybe (pure ()) tags alternative
instance ToTags Rb.While where
tags Rb.While { condition, body } = tags condition >> tags body
instance ToTags Rb.Until where
tags Rb.Until { condition, body } = tags condition >> tags body
instance ToTags Rb.Regex where
tags Rb.Regex { } = pure ()
instance ToTags Rb.Subshell where
tags Rb.Subshell { } = pure ()
instance ToTags Rb.Lhs where
tags t@(Rb.Lhs expr) = case expr of
-- NOTE: Calls do not look for locals
Prj Rb.Call { ann = loc@Loc { byteRange }, method } -> case method of
Prj Rb.Identifier { text } -> yieldCall text loc byteRange
Prj Rb.Constant { text } -> yieldCall text loc byteRange
Prj Rb.Operator { text } -> yieldCall text loc byteRange
_ -> gtags t
-- These do check for locals before yielding a call tag
Prj (Rb.Variable (Prj Rb.Identifier { ann = loc@Loc { byteRange }, text })) -> yield text Call loc byteRange
Prj Rb.ScopeResolution { ann = loc@Loc { byteRange }, name = Prj Rb.Identifier { text } } -> yield text Call loc byteRange
-- TODO: These would be great to track, but doesn't match current a la carte tags output
@ -217,46 +238,50 @@ instance ToTagsBy 'Custom Rb.Lhs where
-- Prj Rb.ScopeResolution { ann = loc@Loc { byteRange }, name = Prj Rb.Constant { text } } -> yield text Constant loc byteRange
_ -> gtags t
where
yieldCall name loc range = yieldTag name Call loc range >> gtags t
yield name kind loc range = do
locals <- get @[Text]
unless (name `elem` locals) $ yieldTag name kind loc range
gtags t
instance ToTagsBy 'Custom Rb.MethodCall where
tags' t@Rb.MethodCall
{ ann = loc@Loc { byteRange = range }
instance ToTags Rb.MethodCall where
tags t@Rb.MethodCall
{ ann = loc@Loc { byteRange = byteRange@Range {} }
, method = expr
} = case expr of
Prj (Rb.Variable (Prj Rb.Identifier { text = name })) -> yield name Call
Prj (Rb.Variable (Prj Rb.Constant { text = name })) -> yield name Call -- TODO: Should be Constant
Prj Rb.ScopeResolution { name = Prj Rb.Constant { text } } -> yield text Call
Prj Rb.ScopeResolution { name = Prj Rb.Identifier { text } } -> yield text Call -- TODO: Should be Constant
Prj (Rb.Variable (Prj Rb.Constant { text = name })) -> yield name Call -- TODO: Should yield Constant
Prj Rb.ScopeResolution { name = Prj Rb.Identifier { text } } -> yield text Call
Prj Rb.ScopeResolution { name = Prj Rb.Constant { text } } -> yield text Call -- TODO: Should yield Constant
Prj Rb.Call { method } -> case method of
Prj Rb.Identifier { text } -> yield text Call
Prj Rb.Constant { text } -> yield text Call
Prj Rb.Operator { text } -> yield text Call
_ -> gtags t
_ -> gtags t
where
yield name kind = yieldTag name kind loc range >> gtags t
yield name kind = yieldTag name kind loc byteRange >> gtags t
instance ToTagsBy 'Custom Rb.Alias where
tags' t@Rb.Alias
{ ann = loc@Loc { byteRange = range }
, alias = Rb.MethodName aliasExpr
instance ToTags Rb.Alias where
tags t@Rb.Alias
{ alias = Rb.MethodName aliasExpr
, name = Rb.MethodName nameExpr
} = do
case aliasExpr of
Prj Rb.Identifier { text } -> yieldTag text Function loc range
_ -> tags aliasExpr
Prj Rb.Identifier { ann = loc@Loc { byteRange}, text } -> yieldTag text Function loc byteRange
_ -> tags aliasExpr
case nameExpr of
Prj Rb.Identifier { text } -> yieldTag text Call loc range
_ -> tags nameExpr
Prj Rb.Identifier { ann = loc@Loc { byteRange}, text } -> yieldTag text Call loc byteRange
_ -> tags nameExpr
gtags t
instance ToTagsBy 'Custom Rb.Undef where
tags' t@Rb.Undef
{ ann = loc@Loc { byteRange = range }
, extraChildren
instance ToTags Rb.Undef where
tags t@Rb.Undef
{ extraChildren
} = for_ extraChildren $ \(Rb.MethodName expr) -> do
case expr of
Prj Rb.Identifier { text } -> yieldTag text Call loc range
_ -> tags expr
Prj Rb.Identifier { ann = loc@Loc { byteRange }, text } -> yieldTag text Call loc byteRange
_ -> tags expr
gtags t
introduceLocals
@ -269,37 +294,44 @@ introduceLocals
Loc ]
-> m ()
introduceLocals params = for_ params $ \param -> case param of
Prj Rb.BlockParameter { name = Rb.Identifier { text = lvar } } -> modify (lvar :)
Prj Rb.DestructuredParameter { extraChildren } -> introduceLocals extraChildren
Prj Rb.BlockParameter { name = Rb.Identifier { text = lvar } } -> modify (lvar :)
Prj Rb.DestructuredParameter { extraChildren } -> introduceLocals extraChildren
Prj Rb.HashSplatParameter { name = Just Rb.Identifier { text = lvar } } -> modify (lvar :)
Prj Rb.Identifier { text = lvar } -> modify (lvar :)
Prj Rb.KeywordParameter { name = Rb.Identifier { text = lvar }} -> modify (lvar :)
Prj Rb.OptionalParameter { name = Rb.Identifier { text = lvar }} -> modify (lvar :)
Prj Rb.SplatParameter { name = Just Rb.Identifier { text = lvar } } -> modify (lvar :)
_ -> tags param
Prj Rb.Identifier { text = lvar } -> modify (lvar :)
Prj Rb.KeywordParameter { name = Rb.Identifier { text = lvar }} -> modify (lvar :)
Prj Rb.OptionalParameter { name = Rb.Identifier { text = lvar }} -> modify (lvar :)
Prj Rb.SplatParameter { name = Just Rb.Identifier { text = lvar } } -> modify (lvar :)
_ -> pure ()
instance ToTagsBy 'Custom Rb.MethodParameters where
tags' Rb.MethodParameters{ extraChildren } = introduceLocals extraChildren
instance ToTags Rb.MethodParameters where
tags t@Rb.MethodParameters{ extraChildren } = introduceLocals extraChildren >> gtags t
instance ToTagsBy 'Custom Rb.LambdaParameters where
tags' Rb.LambdaParameters{ extraChildren } = introduceLocals extraChildren
instance ToTags Rb.LambdaParameters where
tags t@Rb.LambdaParameters{ extraChildren } = introduceLocals extraChildren >> gtags t
instance ToTagsBy 'Custom Rb.BlockParameters where
tags' Rb.BlockParameters{ extraChildren } = introduceLocals extraChildren
instance ToTags Rb.BlockParameters where
tags t@Rb.BlockParameters{ extraChildren } = introduceLocals extraChildren >> gtags t
instance ToTagsBy 'Custom Rb.Assignment where
tags' t@Rb.Assignment{ left } = do
instance ToTags Rb.Assignment where
tags t@Rb.Assignment{ left } = do
case left of
Prj (Rb.Lhs (Prj (Rb.Variable (Prj Rb.Identifier { text })))) -> modify (text :)
Prj Rb.LeftAssignmentList { extraChildren } -> introduceLhsLocals extraChildren
_ -> tags left
Prj Rb.LeftAssignmentList { extraChildren } -> introduceLhsLocals extraChildren
_ -> pure ()
gtags t
where
introduceLhsLocals xs = for_ xs $ \x -> case x of
Prj (Rb.Lhs (Prj (Rb.Variable (Prj Rb.Identifier { text })))) -> modify (text :)
Prj Rb.DestructuredLeftAssignment { extraChildren } -> introduceLhsLocals extraChildren
Prj Rb.RestAssignment { extraChildren = Just (Rb.Lhs (Prj (Rb.Variable (Prj Rb.Identifier { text })))) } -> modify (text :)
_ -> tags x
_ -> pure ()
instance ToTags Rb.OperatorAssignment where
tags t@Rb.OperatorAssignment{ left } = do
case left of
Prj (Rb.Lhs (Prj (Rb.Variable (Prj Rb.Identifier { text })))) -> modify (text :)
_ -> pure ()
gtags t
gtags
:: ( Has (Reader Source) sig m
@ -312,5 +344,115 @@ gtags
-> m ()
gtags = Tags.traverse1_ @ToTags (const (pure ())) tags . Tags.Generics
instance (Generic1 t, Tags.GTraversable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
tags' = gtags
-- instance ToTags Rb.Alias
instance ToTags Rb.Arg
instance ToTags Rb.ArgumentList
instance ToTags Rb.Array
-- instance ToTags Rb.Assignment
instance ToTags Rb.BareString
instance ToTags Rb.BareSymbol
instance ToTags Rb.Begin
instance ToTags Rb.BeginBlock
instance ToTags Rb.Binary
-- instance ToTags Rb.Block
instance ToTags Rb.BlockArgument
instance ToTags Rb.BlockParameter
-- instance ToTags Rb.BlockParameters
instance ToTags Rb.Break
instance ToTags Rb.Call
instance ToTags Rb.Case
instance ToTags Rb.ChainedString
instance ToTags Rb.Character
-- instance ToTags Rb.Class
instance ToTags Rb.ClassVariable
instance ToTags Rb.Complex
instance ToTags Rb.Conditional
instance ToTags Rb.Constant
instance ToTags Rb.DestructuredLeftAssignment
instance ToTags Rb.DestructuredParameter
instance ToTags Rb.Do
-- instance ToTags Rb.DoBlock
instance ToTags Rb.ElementReference
instance ToTags Rb.Else
-- instance ToTags Rb.Elsif
instance ToTags Rb.EmptyStatement
instance ToTags Rb.EndBlock
instance ToTags Rb.Ensure
instance ToTags Rb.EscapeSequence
instance ToTags Rb.ExceptionVariable
instance ToTags Rb.Exceptions
instance ToTags Rb.False
instance ToTags Rb.Float
instance ToTags Rb.For
instance ToTags Rb.GlobalVariable
instance ToTags Rb.Hash
instance ToTags Rb.HashSplatArgument
instance ToTags Rb.HashSplatParameter
instance ToTags Rb.HeredocBeginning
instance ToTags Rb.HeredocEnd
instance ToTags Rb.Identifier
-- instance ToTags Rb.If
instance ToTags Rb.IfModifier
instance ToTags Rb.In
instance ToTags Rb.InstanceVariable
instance ToTags Rb.Integer
instance ToTags Rb.Interpolation
instance ToTags Rb.KeywordParameter
-- instance ToTags Rb.Lambda
-- instance ToTags Rb.LambdaParameters
instance ToTags Rb.LeftAssignmentList
-- instance ToTags Rb.Lhs
-- instance ToTags Rb.Method
-- instance ToTags Rb.MethodCall
instance ToTags Rb.MethodName
-- instance ToTags Rb.MethodParameters
-- instance ToTags Rb.Module
instance ToTags Rb.Next
instance ToTags Rb.Nil
instance ToTags Rb.Operator
-- instance ToTags Rb.OperatorAssignment
instance ToTags Rb.OptionalParameter
instance ToTags Rb.Pair
instance ToTags Rb.ParenthesizedStatements
instance ToTags Rb.Pattern
instance ToTags Rb.Primary
instance ToTags Rb.Program
instance ToTags Rb.Range
instance ToTags Rb.Rational
instance ToTags Rb.Redo
-- instance ToTags Rb.Regex
instance ToTags Rb.Rescue
instance ToTags Rb.RescueModifier
instance ToTags Rb.RestAssignment
instance ToTags Rb.Retry
instance ToTags Rb.Return
instance ToTags Rb.RightAssignmentList
instance ToTags Rb.ScopeResolution
instance ToTags Rb.Self
instance ToTags Rb.Setter
-- instance ToTags Rb.SingletonClass
-- instance ToTags Rb.SingletonMethod
instance ToTags Rb.SplatArgument
instance ToTags Rb.SplatParameter
instance ToTags Rb.Statement
instance ToTags Rb.String
instance ToTags Rb.StringArray
-- instance ToTags Rb.Subshell
instance ToTags Rb.Super
instance ToTags Rb.Superclass
instance ToTags Rb.Symbol
instance ToTags Rb.SymbolArray
instance ToTags Rb.Then
instance ToTags Rb.True
instance ToTags Rb.Unary
-- instance ToTags Rb.Undef
instance ToTags Rb.Uninterpreted
-- instance ToTags Rb.Unless
instance ToTags Rb.UnlessModifier
-- instance ToTags Rb.Until
instance ToTags Rb.UntilModifier
instance ToTags Rb.Variable
instance ToTags Rb.When
-- instance ToTags Rb.While
instance ToTags Rb.WhileModifier
instance ToTags Rb.Yield

2
semantic-source/CHANGELOG.md
View File

@ -2,6 +2,8 @@
- Adds an `NFData` instance for `Source`.
- Decodes to `Text` leniently instead of throwing exceptions.
# 0.0.0.1

6
semantic-source/cabal.project
View File

@ -1,4 +1,4 @@
packages: .
-- ATTENTION: care must be taken to keep this file in sync with cabal.project.ci. If you add a package here, add it there (and add a package stanza with ghc-options to enable errors in CI at the bottom of that file).
package semantic-source
ghc-options: -Werror
-- Local packages
packages: .

14
semantic-source/cabal.project.ci Normal file
View File

@ -0,0 +1,14 @@
-- ATTENTION: care must be taken to keep this file in sync with cabal.project. If you add a package here, add it there (and add a package stanza with ghc-options to enable errors in CI at the bottom of this file).
-- Local packages
packages: .
-- Treat warnings as errors for CI builds
package semantic-scope-graph
ghc-options: -Werror
package semantic-source
ghc-options: -Werror

4
semantic-source/semantic-source.cabal
View File

@ -1,7 +1,7 @@
cabal-version: 2.4
name: semantic-source
version: 0.0.0.1
version: 0.0.1.0
synopsis: Types and functionality for working with source code
description: Types and functionality for working with source code (program text).
homepage: https://github.com/github/semantic/tree/master/semantic-source#readme
@ -48,7 +48,7 @@ library
Source.Span
build-depends:
aeson ^>= 1.4.2.0
, base >= 4.13 && < 5
, base >= 4.12 && < 5
, bytestring ^>= 0.10.8.2
, deepseq ^>= 1.4.4.0
, generic-monoid ^>= 0.1.0.0

3
semantic-source/src/Source/Source.hs
View File

@ -42,6 +42,7 @@ import Data.Semilattice.Lower
import Data.String (IsString (..))
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Text.Encoding.Error (lenientDecode)
import GHC.Generics (Generic)
import Source.Range
import Source.Span (Span(Span), Pos(..))
@ -87,7 +88,7 @@ fromText = Source . T.encodeUtf8
-- | Return the Text contained in the 'Source'.
toText :: Source -> T.Text
toText = T.decodeUtf8 . bytes
toText = T.decodeUtf8With lenientDecode . bytes
-- Slicing

4
semantic-tags/src/Tags/Tagging/Precise.hs
View File

@ -33,7 +33,7 @@ import Data.Functor (void)
import Data.Functor.Const
import Data.Functor.Identity
import Data.Monoid (Ap (..), Endo (..))
import Data.Text as Text (Text, takeWhile)
import Data.Text as Text (Text, takeWhile, stripEnd)
import GHC.Generics
import Prelude hiding (span)
import Source.Loc (Loc (..))
@ -61,7 +61,7 @@ runTagging source
. runReader source
firstLine :: Source -> Text
firstLine = Text.takeWhile (/= '\n') . toText . Source.take 180
firstLine = Text.stripEnd . Text.takeWhile (/= '\n') . toText . Source.take 180
-- FIXME: move Traversable1 into semantic-ast.

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

@ -1,18 +1,10 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -freduction-depth=0 #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Language.TSX.Tags
( ToTags(..)
) where
@ -27,6 +19,7 @@ import Source.Loc
import Source.Source as Source
import Tags.Tag
import qualified Tags.Tagging.Precise as Tags
import TreeSitter.Token
import qualified TreeSitter.TSX.AST as Tsx
class ToTags t where
@ -36,71 +29,54 @@ class ToTags t where
)
=> t Loc
-> m ()
instance (ToTagsBy strategy t, strategy ~ ToTagsInstance t) => ToTags t where
tags = tags' @strategy
class ToTagsBy (strategy :: Strategy) t where
tags'
default tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Generic1 t
, Tags.GTraversable1 ToTags (Rep1 t)
)
=> t Loc
-> m ()
tags = gtags
data Strategy = Generic | Custom
type family ToTagsInstance t :: Strategy where
ToTagsInstance (_ :+: _) = 'Custom
ToTagsInstance Tsx.CallExpression = 'Custom
ToTagsInstance Tsx.Class = 'Custom
ToTagsInstance Tsx.ClassDeclaration = 'Custom
ToTagsInstance Tsx.Function = 'Custom
ToTagsInstance Tsx.FunctionDeclaration = 'Custom
ToTagsInstance Tsx.FunctionSignature = 'Custom
ToTagsInstance Tsx.MethodDefinition = 'Custom
ToTagsInstance _ = 'Generic
instance ToTagsBy 'Custom Tsx.Function where
tags' t@Tsx.Function
instance ToTags Tsx.Function where
tags t@Tsx.Function
{ ann = loc@Loc { byteRange }
, name = Just Tsx.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t
tags' t = gtags t
tags t = gtags t
instance ToTagsBy 'Custom Tsx.FunctionSignature where
tags' t@Tsx.FunctionSignature
instance ToTags Tsx.FunctionSignature where
tags t@Tsx.FunctionSignature
{ ann = loc@Loc { byteRange }
, name = Tsx.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t
instance ToTagsBy 'Custom Tsx.FunctionDeclaration where
tags' t@Tsx.FunctionDeclaration
instance ToTags Tsx.FunctionDeclaration where
tags t@Tsx.FunctionDeclaration
{ ann = loc@Loc { byteRange }
, name = Tsx.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t
instance ToTagsBy 'Custom Tsx.MethodDefinition where
tags' t@Tsx.MethodDefinition
instance ToTags Tsx.MethodDefinition where
tags t@Tsx.MethodDefinition
{ ann = loc@Loc { byteRange }
, name
} = case name of
Prj Tsx.PropertyIdentifier { text } -> yield text
-- TODO: There are more here
_ -> gtags t
_ -> gtags t
where
yield name = yieldTag name Call loc byteRange >> gtags t
instance ToTagsBy 'Custom Tsx.ClassDeclaration where
tags' t@Tsx.ClassDeclaration
instance ToTags Tsx.ClassDeclaration where
tags t@Tsx.ClassDeclaration
{ ann = loc@Loc { byteRange }
, name = Tsx.TypeIdentifier { text }
} = yieldTag text Class loc byteRange >> gtags t
instance ToTagsBy 'Custom Tsx.CallExpression where
tags' t@Tsx.CallExpression
instance ToTags Tsx.CallExpression where
tags t@Tsx.CallExpression
{ ann = loc@Loc { byteRange }
, function = Tsx.Expression expr
} = match expr
@ -113,20 +89,22 @@ instance ToTagsBy 'Custom Tsx.CallExpression where
Prj Tsx.Function { name = Just Tsx.Identifier { text }} -> yield text
Prj Tsx.ParenthesizedExpression { extraChildren } -> for_ extraChildren $ \ x -> case x of
Prj (Tsx.Expression expr) -> match expr
_ -> tags x
_ -> tags x
_ -> gtags t
yield name = yieldTag name Call loc byteRange >> gtags t
instance ToTagsBy 'Custom Tsx.Class where
tags' t@Tsx.Class
instance ToTags Tsx.Class where
tags t@Tsx.Class
{ ann = loc@Loc { byteRange }
, name = Just Tsx.TypeIdentifier { text }
} = yieldTag text Class loc byteRange >> gtags t
tags' t = gtags t
tags t = gtags t
instance (ToTags l, ToTags r) => ToTagsBy 'Custom (l :+: r) where
tags' (L1 l) = tags l
tags' (R1 r) = tags r
instance (ToTags l, ToTags r) => ToTags (l :+: r) where
tags (L1 l) = tags l
tags (R1 r) = tags r
instance ToTags (Token sym n) where tags _ = pure ()
gtags
:: ( Has (Reader Source) sig m
@ -138,11 +116,176 @@ gtags
-> m ()
gtags = Tags.traverse1_ @ToTags (const (pure ())) tags . Tags.Generics
instance (Generic1 t, Tags.GTraversable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
tags' = gtags
-- These are all valid, but point to built-in functions (e.g. require) that a la
-- carte doesn't display and since we have nothing to link to yet (can't
-- jump-to-def), we hide them from the current tags output.
nameBlacklist :: [Text]
nameBlacklist =
[ "require"
]
yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m ()
yieldTag name Call _ _ | name `elem` nameBlacklist = pure ()
yieldTag name kind loc range = do
src <- ask @Source
let sliced = slice src range
Tags.yield (Tag name kind loc (Tags.firstLine sliced) Nothing)
instance ToTags Tsx.AbstractClassDeclaration
instance ToTags Tsx.AbstractMethodSignature
instance ToTags Tsx.AccessibilityModifier
instance ToTags Tsx.AmbientDeclaration
instance ToTags Tsx.Arguments
instance ToTags Tsx.Array
instance ToTags Tsx.ArrayPattern
instance ToTags Tsx.ArrayType
instance ToTags Tsx.ArrowFunction
instance ToTags Tsx.AsExpression
instance ToTags Tsx.AssignmentExpression
instance ToTags Tsx.AssignmentPattern
instance ToTags Tsx.AugmentedAssignmentExpression
instance ToTags Tsx.AwaitExpression
instance ToTags Tsx.BinaryExpression
instance ToTags Tsx.BreakStatement
-- instance ToTags Tsx.CallExpression
instance ToTags Tsx.CallSignature
instance ToTags Tsx.CatchClause
-- instance ToTags Tsx.Class
instance ToTags Tsx.ClassBody
-- instance ToTags Tsx.ClassDeclaration
instance ToTags Tsx.ClassHeritage
instance ToTags Tsx.ComputedPropertyName
instance ToTags Tsx.Constraint
instance ToTags Tsx.ConstructSignature
instance ToTags Tsx.ConstructorType
instance ToTags Tsx.ContinueStatement
instance ToTags Tsx.DebuggerStatement
instance ToTags Tsx.Declaration
instance ToTags Tsx.Decorator
instance ToTags Tsx.DefaultType
instance ToTags Tsx.DestructuringPattern
instance ToTags Tsx.DoStatement
instance ToTags Tsx.EmptyStatement
instance ToTags Tsx.EnumAssignment
instance ToTags Tsx.EnumBody
instance ToTags Tsx.EnumDeclaration
instance ToTags Tsx.EscapeSequence
instance ToTags Tsx.ExistentialType
instance ToTags Tsx.ExportClause
instance ToTags Tsx.ExportSpecifier
instance ToTags Tsx.ExportStatement
instance ToTags Tsx.Expression
instance ToTags Tsx.ExpressionStatement
instance ToTags Tsx.ExtendsClause
instance ToTags Tsx.False
instance ToTags Tsx.FinallyClause
instance ToTags Tsx.FlowMaybeType
instance ToTags Tsx.ForInStatement
instance ToTags Tsx.ForStatement
instance ToTags Tsx.FormalParameters
-- instance ToTags Tsx.Function
-- instance ToTags Tsx.FunctionDeclaration
-- instance ToTags Tsx.FunctionSignature
instance ToTags Tsx.FunctionType
instance ToTags Tsx.GeneratorFunction
instance ToTags Tsx.GeneratorFunctionDeclaration
instance ToTags Tsx.GenericType
instance ToTags Tsx.HashBangLine
instance ToTags Tsx.Identifier
instance ToTags Tsx.IfStatement
instance ToTags Tsx.ImplementsClause
instance ToTags Tsx.Import
instance ToTags Tsx.ImportAlias
instance ToTags Tsx.ImportClause
instance ToTags Tsx.ImportRequireClause
instance ToTags Tsx.ImportSpecifier
instance ToTags Tsx.ImportStatement
instance ToTags Tsx.IndexSignature
instance ToTags Tsx.IndexTypeQuery
instance ToTags Tsx.InterfaceDeclaration
instance ToTags Tsx.InternalModule
instance ToTags Tsx.IntersectionType
instance ToTags Tsx.JsxAttribute
instance ToTags Tsx.JsxClosingElement
instance ToTags Tsx.JsxElement
instance ToTags Tsx.JsxExpression
instance ToTags Tsx.JsxFragment
instance ToTags Tsx.JsxNamespaceName
instance ToTags Tsx.JsxOpeningElement
instance ToTags Tsx.JsxSelfClosingElement
instance ToTags Tsx.JsxText
instance ToTags Tsx.LabeledStatement
instance ToTags Tsx.LexicalDeclaration
instance ToTags Tsx.LiteralType
instance ToTags Tsx.LookupType
instance ToTags Tsx.MappedTypeClause
instance ToTags Tsx.MemberExpression
instance ToTags Tsx.MetaProperty
-- instance ToTags Tsx.MethodDefinition
instance ToTags Tsx.MethodSignature
instance ToTags Tsx.Module
instance ToTags Tsx.NamedImports
instance ToTags Tsx.NamespaceImport
instance ToTags Tsx.NestedIdentifier
instance ToTags Tsx.NestedTypeIdentifier
instance ToTags Tsx.NewExpression
instance ToTags Tsx.NonNullExpression
instance ToTags Tsx.Null
instance ToTags Tsx.Number
instance ToTags Tsx.Object
instance ToTags Tsx.ObjectPattern
instance ToTags Tsx.ObjectType
instance ToTags Tsx.OptionalParameter
instance ToTags Tsx.Pair
instance ToTags Tsx.ParenthesizedExpression
instance ToTags Tsx.ParenthesizedType
instance ToTags Tsx.PredefinedType
instance ToTags Tsx.Program
instance ToTags Tsx.PropertyIdentifier
instance ToTags Tsx.PropertySignature
instance ToTags Tsx.PublicFieldDefinition
instance ToTags Tsx.Readonly
instance ToTags Tsx.Regex
instance ToTags Tsx.RegexFlags
instance ToTags Tsx.RegexPattern
instance ToTags Tsx.RequiredParameter
instance ToTags Tsx.RestParameter
instance ToTags Tsx.ReturnStatement
instance ToTags Tsx.SequenceExpression
instance ToTags Tsx.ShorthandPropertyIdentifier
instance ToTags Tsx.SpreadElement
instance ToTags Tsx.Statement
instance ToTags Tsx.StatementBlock
instance ToTags Tsx.StatementIdentifier
instance ToTags Tsx.String
instance ToTags Tsx.SubscriptExpression
instance ToTags Tsx.Super
instance ToTags Tsx.SwitchBody
instance ToTags Tsx.SwitchCase
instance ToTags Tsx.SwitchDefault
instance ToTags Tsx.SwitchStatement
instance ToTags Tsx.TemplateString
instance ToTags Tsx.TemplateSubstitution
instance ToTags Tsx.TernaryExpression
instance ToTags Tsx.This
instance ToTags Tsx.ThrowStatement
instance ToTags Tsx.True
instance ToTags Tsx.TryStatement
instance ToTags Tsx.TupleType
instance ToTags Tsx.TypeAliasDeclaration
instance ToTags Tsx.TypeAnnotation
instance ToTags Tsx.TypeArguments
instance ToTags Tsx.TypeIdentifier
instance ToTags Tsx.TypeParameter
instance ToTags Tsx.TypeParameters
instance ToTags Tsx.TypePredicate
instance ToTags Tsx.TypeQuery
instance ToTags Tsx.UnaryExpression
instance ToTags Tsx.Undefined
instance ToTags Tsx.UnionType
instance ToTags Tsx.UpdateExpression
instance ToTags Tsx.VariableDeclaration
instance ToTags Tsx.VariableDeclarator
instance ToTags Tsx.WhileStatement
instance ToTags Tsx.WithStatement
instance ToTags Tsx.YieldExpression

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

@ -1,18 +1,10 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -freduction-depth=0 #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Language.TypeScript.Tags
( ToTags(..)
) where
@ -27,6 +19,7 @@ import Source.Loc
import Source.Source as Source
import Tags.Tag
import qualified Tags.Tagging.Precise as Tags
import TreeSitter.Token
import qualified TreeSitter.TypeScript.AST as Ts
class ToTags t where
@ -36,70 +29,54 @@ class ToTags t where
)
=> t Loc
-> m ()
instance (ToTagsBy strategy t, strategy ~ ToTagsInstance t) => ToTags t where
tags = tags' @strategy
class ToTagsBy (strategy :: Strategy) t where
tags'
default tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Generic1 t
, Tags.GTraversable1 ToTags (Rep1 t)
)
=> t Loc
-> m ()
tags = gtags
data Strategy = Generic | Custom
type family ToTagsInstance t :: Strategy where
ToTagsInstance (_ :+: _) = 'Custom
ToTagsInstance Ts.CallExpression = 'Custom
ToTagsInstance Ts.ClassDeclaration = 'Custom
ToTagsInstance Ts.Function = 'Custom
ToTagsInstance Ts.FunctionDeclaration = 'Custom
ToTagsInstance Ts.FunctionSignature = 'Custom
ToTagsInstance Ts.MethodDefinition = 'Custom
ToTagsInstance _ = 'Generic
instance ToTagsBy 'Custom Ts.Function where
tags' t@Ts.Function
instance ToTags Ts.Function where
tags t@Ts.Function
{ ann = loc@Loc { byteRange }
, name = Just Ts.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t
tags' t = gtags t
tags t = gtags t
instance ToTagsBy 'Custom Ts.FunctionSignature where
tags' t@Ts.FunctionSignature
instance ToTags Ts.FunctionSignature where
tags t@Ts.FunctionSignature
{ ann = loc@Loc { byteRange }
, name = Ts.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t
instance ToTagsBy 'Custom Ts.FunctionDeclaration where
tags' t@Ts.FunctionDeclaration
instance ToTags Ts.FunctionDeclaration where
tags t@Ts.FunctionDeclaration
{ ann = loc@Loc { byteRange }
, name = Ts.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t
instance ToTagsBy 'Custom Ts.MethodDefinition where
tags' t@Ts.MethodDefinition
instance ToTags Ts.MethodDefinition where
tags t@Ts.MethodDefinition
{ ann = loc@Loc { byteRange }
, name
} = case name of
Prj Ts.PropertyIdentifier { text } -> yield text
-- TODO: There are more here
_ -> gtags t
_ -> gtags t
where
yield name = yieldTag name Call loc byteRange >> gtags t
instance ToTagsBy 'Custom Ts.ClassDeclaration where
tags' t@Ts.ClassDeclaration
instance ToTags Ts.ClassDeclaration where
tags t@Ts.ClassDeclaration
{ ann = loc@Loc { byteRange }
, name = Ts.TypeIdentifier { text }
} = yieldTag text Class loc byteRange >> gtags t
instance ToTagsBy 'Custom Ts.CallExpression where
tags' t@Ts.CallExpression
instance ToTags Ts.CallExpression where
tags t@Ts.CallExpression
{ ann = loc@Loc { byteRange }
, function = Ts.Expression expr
} = match expr
@ -112,13 +89,15 @@ instance ToTagsBy 'Custom Ts.CallExpression where
Prj Ts.Function { name = Just Ts.Identifier { text }} -> yield text
Prj Ts.ParenthesizedExpression { extraChildren } -> for_ extraChildren $ \ x -> case x of
Prj (Ts.Expression expr) -> match expr
_ -> tags x
_ -> tags x
_ -> gtags t
yield name = yieldTag name Call loc byteRange >> gtags t
instance (ToTags l, ToTags r) => ToTagsBy 'Custom (l :+: r) where
tags' (L1 l) = tags l
tags' (R1 r) = tags r
instance (ToTags l, ToTags r) => ToTags (l :+: r) where
tags (L1 l) = tags l
tags (R1 r) = tags r
instance ToTags (Token sym n) where tags _ = pure ()
gtags
:: ( Has (Reader Source) sig m
@ -130,11 +109,177 @@ gtags
-> m ()
gtags = Tags.traverse1_ @ToTags (const (pure ())) tags . Tags.Generics
instance (Generic1 t, Tags.GTraversable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
tags' = gtags
-- These are all valid, but point to built-in functions (e.g. require) that a la
-- carte doesn't display and since we have nothing to link to yet (can't
-- jump-to-def), we hide them from the current tags output.
nameBlacklist :: [Text]
nameBlacklist =
[ "require"
]
yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m ()
yieldTag name Call _ _ | name `elem` nameBlacklist = pure ()
yieldTag name kind loc range = do
src <- ask @Source
let sliced = slice src range
Tags.yield (Tag name kind loc (Tags.firstLine sliced) Nothing)
instance ToTags Ts.AbstractClassDeclaration
instance ToTags Ts.AbstractMethodSignature
instance ToTags Ts.AccessibilityModifier
instance ToTags Ts.AmbientDeclaration
instance ToTags Ts.Arguments
instance ToTags Ts.Array
instance ToTags Ts.ArrayPattern
instance ToTags Ts.ArrayType
instance ToTags Ts.ArrowFunction
instance ToTags Ts.AsExpression
instance ToTags Ts.AssignmentExpression
instance ToTags Ts.AssignmentPattern
instance ToTags Ts.AugmentedAssignmentExpression
instance ToTags Ts.AwaitExpression
instance ToTags Ts.BinaryExpression
instance ToTags Ts.BreakStatement
-- instance ToTags Ts.CallExpression
instance ToTags Ts.CallSignature
instance ToTags Ts.CatchClause
instance ToTags Ts.Class
instance ToTags Ts.ClassBody
-- instance ToTags Ts.ClassDeclaration
instance ToTags Ts.ClassHeritage
instance ToTags Ts.ComputedPropertyName
instance ToTags Ts.Constraint
instance ToTags Ts.ConstructSignature
instance ToTags Ts.ConstructorType
instance ToTags Ts.ContinueStatement
instance ToTags Ts.DebuggerStatement
instance ToTags Ts.Declaration
instance ToTags Ts.Decorator
instance ToTags Ts.DefaultType
instance ToTags Ts.DestructuringPattern
instance ToTags Ts.DoStatement
instance ToTags Ts.EmptyStatement
instance ToTags Ts.EnumAssignment
instance ToTags Ts.EnumBody
instance ToTags Ts.EnumDeclaration
instance ToTags Ts.EscapeSequence
instance ToTags Ts.ExistentialType
instance ToTags Ts.ExportClause
instance ToTags Ts.ExportSpecifier
instance ToTags Ts.ExportStatement
instance ToTags Ts.Expression
instance ToTags Ts.ExpressionStatement
instance ToTags Ts.ExtendsClause
instance ToTags Ts.False
instance ToTags Ts.FinallyClause
instance ToTags Ts.FlowMaybeType
instance ToTags Ts.ForInStatement
instance ToTags Ts.ForStatement
instance ToTags Ts.FormalParameters
-- instance ToTags Ts.Function
-- instance ToTags Ts.FunctionDeclaration
-- instance ToTags Ts.FunctionSignature
instance ToTags Ts.FunctionType
instance ToTags Ts.GeneratorFunction
instance ToTags Ts.GeneratorFunctionDeclaration
instance ToTags Ts.GenericType
instance ToTags Ts.HashBangLine
instance ToTags Ts.Identifier
instance ToTags Ts.IfStatement
instance ToTags Ts.ImplementsClause
instance ToTags Ts.Import
instance ToTags Ts.ImportAlias
instance ToTags Ts.ImportClause
instance ToTags Ts.ImportRequireClause
instance ToTags Ts.ImportSpecifier
instance ToTags Ts.ImportStatement
instance ToTags Ts.IndexSignature
instance ToTags Ts.IndexTypeQuery
instance ToTags Ts.InterfaceDeclaration
instance ToTags Ts.InternalModule
instance ToTags Ts.IntersectionType
instance ToTags Ts.JsxAttribute
instance ToTags Ts.JsxClosingElement
instance ToTags Ts.JsxElement
instance ToTags Ts.JsxExpression
instance ToTags Ts.JsxFragment
instance ToTags Ts.JsxNamespaceName
instance ToTags Ts.JsxOpeningElement
instance ToTags Ts.JsxSelfClosingElement
instance ToTags Ts.JsxText
instance ToTags Ts.LabeledStatement
instance ToTags Ts.LexicalDeclaration
instance ToTags Ts.LiteralType
instance ToTags Ts.LookupType
instance ToTags Ts.MappedTypeClause
instance ToTags Ts.MemberExpression
instance ToTags Ts.MetaProperty
-- instance ToTags Ts.MethodDefinition
instance ToTags Ts.MethodSignature
instance ToTags Ts.Module
instance ToTags Ts.NamedImports
instance ToTags Ts.NamespaceImport
instance ToTags Ts.NestedIdentifier
instance ToTags Ts.NestedTypeIdentifier
instance ToTags Ts.NewExpression
instance ToTags Ts.NonNullExpression
instance ToTags Ts.Null
instance ToTags Ts.Number
instance ToTags Ts.Object
instance ToTags Ts.ObjectPattern
instance ToTags Ts.ObjectType
instance ToTags Ts.OptionalParameter
instance ToTags Ts.Pair
instance ToTags Ts.ParenthesizedExpression
instance ToTags Ts.ParenthesizedType
instance ToTags Ts.PredefinedType
instance ToTags Ts.Program
instance ToTags Ts.PropertyIdentifier
instance ToTags Ts.PropertySignature
instance ToTags Ts.PublicFieldDefinition
instance ToTags Ts.Readonly
instance ToTags Ts.Regex
instance ToTags Ts.RegexFlags
instance ToTags Ts.RegexPattern
instance ToTags Ts.RequiredParameter
instance ToTags Ts.RestParameter
instance ToTags Ts.ReturnStatement
instance ToTags Ts.SequenceExpression
instance ToTags Ts.ShorthandPropertyIdentifier
instance ToTags Ts.SpreadElement
instance ToTags Ts.Statement
instance ToTags Ts.StatementBlock
instance ToTags Ts.StatementIdentifier
instance ToTags Ts.String
instance ToTags Ts.SubscriptExpression
instance ToTags Ts.Super
instance ToTags Ts.SwitchBody
instance ToTags Ts.SwitchCase
instance ToTags Ts.SwitchDefault
instance ToTags Ts.SwitchStatement
instance ToTags Ts.TemplateString
instance ToTags Ts.TemplateSubstitution
instance ToTags Ts.TernaryExpression
instance ToTags Ts.This
instance ToTags Ts.ThrowStatement
instance ToTags Ts.True
instance ToTags Ts.TryStatement
instance ToTags Ts.TupleType
instance ToTags Ts.TypeAliasDeclaration
instance ToTags Ts.TypeAnnotation
instance ToTags Ts.TypeArguments
instance ToTags Ts.TypeAssertion
instance ToTags Ts.TypeIdentifier
instance ToTags Ts.TypeParameter
instance ToTags Ts.TypeParameters
instance ToTags Ts.TypePredicate
instance ToTags Ts.TypeQuery
instance ToTags Ts.UnaryExpression
instance ToTags Ts.Undefined
instance ToTags Ts.UnionType
instance ToTags Ts.UpdateExpression
instance ToTags Ts.VariableDeclaration
instance ToTags Ts.VariableDeclarator
instance ToTags Ts.WhileStatement
instance ToTags Ts.WithStatement
instance ToTags Ts.YieldExpression

2
src/Language/Go/Assignment.hs
View File

@ -290,7 +290,7 @@ defaultCase :: Assignment (Term Loc)
defaultCase = makeTerm <$> symbol DefaultCase <*> children (Go.Syntax.DefaultPattern <$> (expressions <|> emptyTerm))
defaultExpressionCase :: Assignment (Term Loc)
defaultExpressionCase = makeTerm <$> symbol DefaultCase <*> (Go.Syntax.DefaultPattern <$ rawSource <*> (expressions <|> emptyTerm))
defaultExpressionCase = makeTerm <$> symbol DefaultCase <*> children (Go.Syntax.DefaultPattern <$> (expressions <|> emptyTerm))
callExpression :: Assignment (Term Loc)
callExpression = makeTerm <$> symbol CallExpression <*> children (Expression.Call [] <$> expression <*> manyTerm expression <*> emptyTerm)

4
src/Language/Python/Assignment.hs
View File

@ -128,10 +128,10 @@ expressionList :: Assignment (Term Loc)
expressionList = makeTerm'' <$> symbol ExpressionList <*> children (someTerm expression)
listSplat :: Assignment (Term Loc)
listSplat = makeTerm <$> symbol ListSplat <*> (Syntax.Identifier . name <$> source)
listSplat = makeTerm <$> symbol ListSplat <*> children (manyTerm expression)
dictionarySplat :: Assignment (Term Loc)
dictionarySplat = makeTerm <$> symbol DictionarySplat <*> (Syntax.Identifier . name <$> source)
dictionarySplat = makeTerm <$> symbol DictionarySplat <*> children (manyTerm expression)
keywordArgument :: Assignment (Term Loc)
keywordArgument = makeTerm <$> symbol KeywordArgument <*> children (Statement.Assignment [] <$> term expression <*> term expression)

8
src/Language/Ruby/Assignment.hs
View File

@ -128,9 +128,9 @@ identifier =
<|> mk GlobalVariable
<|> mk Operator
<|> mk Setter
<|> mk SplatArgument
<|> mk HashSplatArgument
<|> mk Uninterpreted
<|> symbol HashSplatArgument *> children expression
<|> symbol SplatArgument *> children expression
<|> symbol BlockArgument *> children expression
where
mk s = makeTerm <$> symbol s <*> (Syntax.Identifier . name <$> source)
@ -248,7 +248,7 @@ method = makeTerm <$> symbol Method <*> (withNewScope . children) (Declaration.M
expressions' = makeTerm <$> location <*> many expression
singletonMethod :: Assignment (Term Loc)
singletonMethod = makeTerm <$> symbol SingletonMethod <*> (withNewScope . children) (Declaration.Method [] <$> expression <*> methodSelector <*> params <*> expressions <*> pure publicAccessControl)
singletonMethod = makeTerm <$> symbol SingletonMethod <*> (withExtendedScope . children) (Declaration.Method [] <$> expression <*> methodSelector <*> params <*> expressions <*> pure publicAccessControl)
where params = symbol MethodParameters *> children (many parameter) <|> pure []
lambda :: Assignment (Term Loc)
@ -398,7 +398,7 @@ assignment' = makeTerm <$> symbol Assignment <*> children (Ruby.Syntax.
assign c l r = inject (Statement.AugmentedAssignment (makeTerm1 (c l r)))
lhs = makeTerm <$> symbol LeftAssignmentList <*> children (many expr) <|> expr
rhs = makeTerm <$> symbol RightAssignmentList <*> children (many expr) <|> expr
rhs = makeTerm <$> symbol RightAssignmentList <*> children (many expression) <|> expression
expr = makeTerm <$> symbol RestAssignment <*> restAssign
<|> makeTerm <$> symbol DestructuredLeftAssignment <*> children (many expr)
<|> lhsIdent

2
src/Semantic/Api/Symbols.hs
View File

@ -100,7 +100,7 @@ tagsForBlob :: (Has (Error SomeException) sig m, Has Parse sig m, Has (Reader Pe
tagsForBlob blob = asks toTagsParsers >>= \p -> parseWith p (pure . tags symbolsToSummarize blob) blob
symbolsToSummarize :: [Text]
symbolsToSummarize = ["Function", "Method", "Class", "Module", "Call", "Send"]
symbolsToSummarize = ["Function", "AmbientFunction", "Method", "Class", "Module", "Call", "Send"]
class ToTags t where
tags :: [Text] -> Blob -> t Loc -> [Tag]

30
src/Tags/Taggable.hs
View File

@ -133,18 +133,20 @@ instance (TaggableBy strategy t, strategy ~ TaggableInstance t) => Taggable t wh
symbolName = symbolName' @strategy
type family TaggableInstance (t :: * -> *) :: Strategy where
TaggableInstance (Sum _) = 'Custom
TaggableInstance (TermF _ _) = 'Custom
TaggableInstance Syntax.Context = 'Custom
TaggableInstance Declaration.Function = 'Custom
TaggableInstance Declaration.Method = 'Custom
TaggableInstance Declaration.Class = 'Custom
TaggableInstance Ruby.Class = 'Custom
TaggableInstance Ruby.Module = 'Custom
TaggableInstance TypeScript.Module = 'Custom
TaggableInstance Expression.Call = 'Custom
TaggableInstance Ruby.Send = 'Custom
TaggableInstance _ = 'Default
TaggableInstance (Sum _) = 'Custom
TaggableInstance (TermF _ _) = 'Custom
TaggableInstance Syntax.Context = 'Custom
TaggableInstance Declaration.Function = 'Custom
TaggableInstance Declaration.Method = 'Custom
TaggableInstance Declaration.Class = 'Custom
TaggableInstance Ruby.Class = 'Custom
TaggableInstance Ruby.Module = 'Custom
TaggableInstance TypeScript.Module = 'Custom
TaggableInstance TypeScript.AmbientFunction = 'Custom
TaggableInstance Expression.Call = 'Custom
TaggableInstance Ruby.Send = 'Custom
TaggableInstance _ = 'Default
instance TaggableBy 'Default t
@ -172,6 +174,10 @@ instance TaggableBy 'Custom Declaration.Function where
snippet' ann (Declaration.Function _ _ _ body) = subtractLoc ann (termAnnotation body)
symbolName' = declaredName . Declaration.functionName
instance TaggableBy 'Custom TypeScript.AmbientFunction where
snippet' ann _ = byteRange ann
symbolName' = declaredName . TypeScript.ambientFunctionIdentifier
instance TaggableBy 'Custom Declaration.Method where
docsLiteral' Python (Declaration.Method _ _ _ _ body _)
| bodyF <- termOut body

23
src/Tags/Tagging.hs
View File

@ -39,13 +39,14 @@ runTagging lang symbolsToSummarize source
toKind x = do
guard (x `elem` symbolsToSummarize)
case x of
"Function" -> Just Function
"Method" -> Just Method
"Class" -> Just Class
"Module" -> Just Module
"Call" -> Just Call
"Send" -> Just Call -- Ruby’s Send is considered to be a kind of 'Call'
_ -> Nothing
"Function" -> Just Function
"Method" -> Just Method
"Class" -> Just Class
"Module" -> Just Module
"Call" -> Just Call
"Send" -> Just Call -- Ruby’s Send is considered to be a kind of 'Call'
"AmbientFunction" -> Just Function -- Classify TypeScript ambient functions as 'Function'
_ -> Nothing
type ContextToken = (Text, Range)
@ -59,12 +60,12 @@ contextualizing source toKind = Streaming.mapMaybeM $ \case
Exit x r -> Nothing <$ exitScope (x, r)
Iden iden loc docsLiteralRange -> fmap go (get @[ContextToken]) where
go = \case
((x, r):("Context", cr):_) | Just kind <- toKind x -> Just $ Tag iden kind loc (firstLine (slice r)) (Just (slice cr))
((x, r):_) | Just kind <- toKind x -> Just $ Tag iden kind loc (firstLine (slice r)) (slice <$> docsLiteralRange)
((x, r):("Context", cr):_) | Just kind <- toKind x -> Just $ Tag iden kind loc (firstLine r) (Just (slice cr))
((x, r):_) | Just kind <- toKind x -> Just $ Tag iden kind loc (firstLine r) (slice <$> docsLiteralRange)
_ -> Nothing
where
slice = stripEnd . Source.toText . Source.slice source
firstLine = T.take 180 . fst . breakOn "\n"
slice = T.stripEnd . Source.toText . Source.slice source
firstLine = T.stripEnd . T.takeWhile (/= '\n') . Source.toText . Source.take 180 . Source.slice source
enterScope, exitScope :: Has (State [ContextToken]) sig m
=> ContextToken

81
test/Examples.hs
View File

@ -1,5 +1,11 @@
{-# LANGUAGE FlexibleContexts, RecordWildCards, OverloadedStrings, TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# OPTIONS_GHC -O1 #-}
{-# OPTIONS_GHC -Wno-unused-top-binds -Wno-unused-imports #-}
module Main (main) where
import Control.Carrier.Parse.Measured
@ -12,6 +18,7 @@ import Data.Blob
import Data.Foldable
import Data.Language (LanguageMode (..), PerLanguageModes (..))
import Data.List
import Data.Int
import qualified Data.Text as Text
import Data.Traversable
import System.FilePath.Glob
@ -73,8 +80,13 @@ goFileSkips = Path.relPath <$>
-- Parse errors
, "go/src/math/big/arith.go" -- Unhandled identifier character: 'ŝ'
, "go/src/cmd/vet/testdata/deadcode.go"
, "go/src/cmd/vet/testdata/testingpkg/tests_test.go"
, "moby/vendor/github.com/beorn7/perks/quantile/stream.go" -- Unhandled identifier character: 'ƒ'
-- A la carte struggles on these
, "src/cmd/go/testdata/src/notest/hello.go" -- a la carte chokes on ParseError
, "go/src/cmd/asm/internal/asm/parse.go" -- a la carte spans are off on line 1124
-- UTF8 encoding issues ("Cannot decode byte '\xe3': Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream")
, "go/src/text/template/exec_test.go"
, "go/src/bufio/bufio_test.go"
@ -104,10 +116,18 @@ rubySkips = Path.relFile <$>
-- Doesn't parse
, "ruby_spec/language/string_spec.rb"
, "ruby_spec/language/fixtures/freeze_magic_comment_required_diff_enc.rb"
, "ruby_spec/command_line/fixtures/freeze_flag_required_diff_enc.rb"
, "ruby_spec/command_line/fixtures/bad_syntax.rb"
-- Can't detect method calls inside heredoc bodies with precise ASTs
, "ruby_spec/core/argf/readpartial_spec.rb"
, "ruby_spec/core/process/exec_spec.rb"
-- These are known differences between precise and a la carte (usually precise is producing better data) that we aren't going to fix.
, "ruby_spec/language/def_spec.rb"
, "ruby_spec/language/block_spec.rb"
, "ruby_spec/language/method_spec.rb"
, "ruby_spec/language/lambda_spec.rb"
]
tsxSkips :: [Path.RelFile]
@ -134,6 +154,9 @@ typescriptSkips = Path.relFile <$>
, "npm/node_modules/cli-table2/node_modules/lodash/index.js"
, "npm/node_modules/cli-table2/node_modules/lodash/index.js"
-- Parse errors
, "npm/node_modules/slide/lib/async-map-ordered.js"
-- Cannot decode byte '\xd0': Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream
, "npm/node_modules/npm-profile/node_modules/make-fetch-happen/node_modules/socks-proxy-agent/node_modules/socks/node_modules/smart-buffer/test/smart-buffer.test.js"
, "npm/node_modules/pacote/node_modules/make-fetch-happen/node_modules/socks-proxy-agent/node_modules/socks/node_modules/smart-buffer/test/smart-buffer.test.js"
@ -182,34 +205,63 @@ buildExamples session lang tsDir = do
([x], _) | e:_ <- toList (x^.errors)
-> HUnit.assertFailure ("Parse errors (a la carte) " <> show e)
([x], [y]) -> do
-- Check paths
HUnit.assertEqual "Expected paths to be equal" (x^.path) (y^.path)
-- Check symbols
let aLaCarteSymbols = sort . filterALaCarteSymbols (languageName lang) $ toListOf (symbols . traverse . symbol) x
preciseSymbols = sort $ toListOf (symbols . traverse . symbol) y
preciseSymbols = sort . filterALaCarteSymbols (languageName lang) $ toListOf (symbols . traverse . symbol) y
delta = aLaCarteSymbols \\ preciseSymbols
invDelta = preciseSymbols \\ aLaCarteSymbols
msg = "Found in a la carte, but not precise: "
<> show delta
<> "\n"
<> "Found in precise but not a la carte: "
<> show (preciseSymbols \\ aLaCarteSymbols)
<> show invDelta
<> "\n"
<> "Expected: " <> show aLaCarteSymbols <> "\n"
<> "But got:" <> show preciseSymbols
HUnit.assertBool ("Expected symbols to be equal.\n" <> msg) (null delta)
pure ()
HUnit.assertBool ("Expected symbols to be equal.\n" <> msg) (null invDelta)
-- Check details
let aLaCarteSymbols = sortOn sSym . filter (okALaCarteSymbol (languageName lang) . view symbol) $ toList (x^.symbols)
preciseSymbols = sortOn sSym . filter (okALaCarteSymbol (languageName lang) . view symbol) $ toList (y^.symbols)
for_ (zip aLaCarteSymbols preciseSymbols) $ \ (left, right) -> do
let lineNo = ":" <> show (left^.P.span^.start^.line)
-- lSpan = " [" <> show (startRow left) <> ", " <> show (left^.P.span^.start^.column) <> "]"
-- rSpan = " [" <> show (startRow right) <> ", " <> show (right^.P.span^.start^.column) <> "]"
HUnit.assertEqual (Text.unpack (x^.path) <> lineNo) (left^.symbol) (right^.symbol)
HUnit.assertEqual (Text.unpack (x^.path) <> lineNo) (Text.unpack (left^.symbol) <> span left) (Text.unpack (right^.symbol) <> span right)
-- HUnit.assertEqual (Text.unpack (x^.path) <> lineNo) (left^.line) (right^.line)
-- HUnit.assertBool (Text.unpack (x^.path) <> lineNo) (Text.isPrefixOf (left^.line) (right^.line))
-- if left^.kind == "Method"
-- then HUnit.assertEqual (Text.unpack (x^.path) <> lineNo) (left^.line) (right^.line)
-- -- -- then HUnit.assertBool (Text.unpack (x^.path) <> lineNo) (Text.isPrefixOf (left^.line) (right^.line))
-- else pure ()
_ -> HUnit.assertFailure "Expected 1 file in each response"
(Left e1, Left e2) -> HUnit.assertFailure ("Unable to parse (both)" <> show (displayException e1) <> show (displayException e2))
(_, Left e) -> HUnit.assertFailure ("Unable to parse (precise)" <> show (displayException e))
(Left e, _) -> HUnit.assertFailure ("Unable to parse (a la carte)" <> show (displayException e))
filterALaCarteSymbols :: String -> [Text.Text] -> [Text.Text]
filterALaCarteSymbols "ruby" symbols
= filterOutInstanceVariables
. filterOutBuiltInMethods
$ symbols
sSym x = SortableSymbol (x^.symbol) (x^.P.span^.start^.line) (x^.P.span^.start^.column) (x^.P.span^.end^.line) (x^.P.span^.end^.column)
span x = " [" <> show (x^.P.span^.start^.line) <> ", " <> show (x^.P.span^.start^.column) <>
" - " <> show (x^.P.span^.end^.line) <> ", " <> show (x^.P.span^.end^.column) <> "]"
data SortableSymbol = SortableSymbol Text.Text Int32 Int32 Int32 Int32
deriving (Eq, Show, Ord)
okALaCarteSymbol :: String -> Text.Text -> Bool
okALaCarteSymbol "typescript" symbol = symbol `notElem` blacklist
where
filterOutInstanceVariables = filter (not . Text.isPrefixOf "@")
filterOutBuiltInMethods = filter (`notElem` blacklist)
blacklist = ["require"]
okALaCarteSymbol "ruby" symbol = not (instanceVariable symbol || builtInMethod symbol)
where
instanceVariable = Text.isPrefixOf "@"
builtInMethod x = x `elem` blacklist
blacklist =
[ "alias"
, "load"
@ -220,7 +272,10 @@ filterALaCarteSymbols "ruby" symbols
, "defined?"
, "lambda"
]
filterALaCarteSymbols _ symbols = symbols
okALaCarteSymbol _ _ = True
filterALaCarteSymbols :: String -> [Text.Text] -> [Text.Text]
filterALaCarteSymbols lang = filter (okALaCarteSymbol lang)
aLaCarteLanguageModes :: PerLanguageModes
aLaCarteLanguageModes = PerLanguageModes

8
test/fixtures/go/corpus/case-statements.diffA-B.txt vendored
View File

@ -37,4 +37,10 @@
{+(Identifier)+}
{+(Empty)+})+})+}
{+(DefaultPattern
{+(Statements)+})+})+})+}) }))
{+(Statements
{+(Call
{+(Identifier)+}
{+(Statements)+}
{+(Empty)+})+}
{+(Break
{+(Empty)+})+})+})+})+})+}) }))

8
test/fixtures/go/corpus/case-statements.diffB-A.txt vendored
View File

@ -34,7 +34,13 @@
{-(Identifier)-}
{-(Empty)-})-})-}
{-(DefaultPattern
{-(Statements)-})-})-})-})
{-(Statements
{-(Call
{-(Identifier)-}
{-(Statements)-}
{-(Empty)-})-}
{-(Break
{-(Empty)-})-})-})-})-})-})
->(Match
{+(Empty)+}
{+(Statements)+}) }))

8
test/fixtures/go/corpus/case-statements.parseB.txt vendored
View File

@ -34,4 +34,10 @@
(Identifier)
(Empty)))
(DefaultPattern
(Statements)))))))
(Statements
(Call
(Identifier)
(Statements)
(Empty))
(Break
(Empty)))))))))

3
test/fixtures/go/corpus/select-statements.diffA-B.txt vendored
View File

@ -74,7 +74,8 @@
{-(Empty)-})-})-}
{-(Empty)-})-}))
(DefaultPattern
(Statements))))
(Return
(Empty)))))
(Select
(Statements
(Pattern

3
test/fixtures/go/corpus/select-statements.diffB-A.txt vendored
View File

@ -74,7 +74,8 @@
{-(Empty)-})-})-}
{-(Empty)-})-}))
(DefaultPattern
(Statements))))
(Return
(Empty)))))
(Select
(Statements
(Pattern

3
test/fixtures/go/corpus/select-statements.parseA.txt vendored
View File

@ -55,7 +55,8 @@
(Empty)))
(Empty))))
(DefaultPattern
(Statements))))
(Return
(Empty)))))
(Select
(Statements
(Pattern

3
test/fixtures/go/corpus/select-statements.parseB.txt vendored
View File

@ -55,7 +55,8 @@
(Empty)))
(Empty))))
(DefaultPattern
(Statements))))
(Return
(Empty)))))
(Select
(Statements
(Pattern

3
test/fixtures/go/corpus/type-switch-statements.diffA-B.txt vendored
View File

@ -35,7 +35,8 @@
(Break
(Empty)))
{+(DefaultPattern
{+(Statements)+})+}))
{+(Break
{+(Empty)+})+})+}))
(TypeSwitch
(Statements
{ (Identifier)

3
test/fixtures/go/corpus/type-switch-statements.diffB-A.txt vendored
View File

@ -35,7 +35,8 @@
(Break
(Empty)))
{-(DefaultPattern
{-(Statements)-})-}))
{-(Break
{-(Empty)-})-})-}))
(TypeSwitch
(Statements
{ (Identifier)

3
test/fixtures/go/corpus/type-switch-statements.parseB.txt vendored
View File

@ -32,7 +32,8 @@
(Break
(Empty)))
(DefaultPattern
(Statements))))
(Break
(Empty)))))
(TypeSwitch
(Statements
(Identifier)

27
test/fixtures/python/corpus/decorated-definition.diffA-B.txt vendored
View File

@ -11,15 +11,16 @@
(Decorator
{ (Identifier)
->(Identifier) }
{+(Identifier)+}
{+(Statements
{+(Identifier)+})+}
{-(Integer)-}
(Decorator
{ (Identifier)
->(Identifier) }
{+(Identifier)+}
{-(Statements
(Statements
{+(Identifier)+}
{-(Integer)-}
{-(Integer)-})-}
{-(Integer)-})
(Decorator
(Identifier)
{+(Statements
@ -27,17 +28,21 @@
{+(Assignment
{+(Identifier)+}
{+(Boolean)+})+}
{+(Identifier)+}
{+(Identifier)+})+}
{+(Statements
{+(Identifier)+})+}
{+(Statements
{+(Identifier)+})+})+}
{-(Assignment
{-(Identifier)-}
{-(Boolean)-})-}
{ (Decorator
{-(Identifier)-}
{-(Identifier)-}
{-(Statements
{-(Identifier)-})-}
{-(Decorator
{-(Identifier)-}
{-(Identifier)-}
{-(Statements
{-(Identifier)-})-}
{-(Decorator
{-(Identifier)-}
{-(Statements
@ -45,8 +50,10 @@
{-(Assignment
{-(Identifier)-}
{-(Boolean)-})-}
{-(Identifier)-}
{-(Identifier)-})-}
{-(Statements
{-(Identifier)-})-}
{-(Statements
{-(Identifier)-})-})-}
{-(Function
{-(Identifier)-}
{-(Statements

27
test/fixtures/python/corpus/decorated-definition.diffB-A.txt vendored
View File

@ -12,14 +12,15 @@
{ (Identifier)
->(Identifier) }
{+(Integer)+}
{-(Identifier)-}
{-(Statements
{-(Identifier)-})-}
(Decorator
{ (Identifier)
->(Identifier) }
{+(Statements
(Statements
{+(Integer)+}
{+(Integer)+})+}
{-(Identifier)-}
{+(Integer)+}
{-(Identifier)-})
(Decorator
(Identifier)
{+(Assignment
@ -30,18 +31,22 @@
{-(Assignment
{-(Identifier)-}
{-(Boolean)-})-}
{-(Identifier)-}
{-(Identifier)-})-}
{-(Statements
{-(Identifier)-})-}
{-(Statements
{-(Identifier)-})-})-}
{ (Function
{-(Identifier)-}
{-(Statements
{-(Identifier)-})-})
->(Decorator
{+(Identifier)+}
{+(Identifier)+}
{+(Statements
{+(Identifier)+})+}
{+(Decorator
{+(Identifier)+}
{+(Identifier)+}
{+(Statements
{+(Identifier)+})+}
{+(Decorator
{+(Identifier)+}
{+(Statements
@ -49,8 +54,10 @@
{+(Assignment
{+(Identifier)+}
{+(Boolean)+})+}
{+(Identifier)+}
{+(Identifier)+})+}
{+(Statements
{+(Identifier)+})+}
{+(Statements
{+(Identifier)+})+})+}
{+(Function
{+(Identifier)+}
{+(Statements

12
test/fixtures/python/corpus/decorated-definition.parseA.txt vendored
View File

@ -22,10 +22,12 @@
(Boolean))
(Decorator
(Identifier)
(Identifier)
(Statements
(Identifier))
(Decorator
(Identifier)
(Identifier)
(Statements
(Identifier))
(Decorator
(Identifier)
(Statements
@ -33,8 +35,10 @@
(Assignment
(Identifier)
(Boolean))
(Identifier)
(Identifier))
(Statements
(Identifier))
(Statements
(Identifier)))
(Function
(Identifier)
(Statements

12
test/fixtures/python/corpus/decorated-definition.parseB.txt vendored
View File

@ -9,10 +9,12 @@
(Statements)
(Decorator
(Identifier)
(Identifier)
(Statements
(Identifier))
(Decorator
(Identifier)
(Identifier)
(Statements
(Identifier))
(Decorator
(Identifier)
(Statements
@ -20,8 +22,10 @@
(Assignment
(Identifier)
(Boolean))
(Identifier)
(Identifier))
(Statements
(Identifier))
(Statements
(Identifier)))
(Function
(Identifier)
(Statements

10
test/fixtures/python/corpus/function-definition.diffA-B.txt vendored
View File

@ -14,8 +14,9 @@
(RequiredParameter
{ (Identifier)
->(Identifier) })
{ (Identifier)
->(Identifier) }
(Statements
{ (Identifier)
->(Identifier) })
(Statements
{ (Identifier)
->(Identifier) }))
@ -43,7 +44,8 @@
->(Integer) })
{ (Identifier)
->(Identifier) })
{ (Identifier)
->(Identifier) }
(Statements
{ (Identifier)
->(Identifier) })
(Statements
(Identifier))))

11
test/fixtures/python/corpus/function-definition.diffB-A.txt vendored
View File

@ -4,7 +4,8 @@
->(Identifier) }
{-(RequiredParameter
{-(Identifier)-})-}
{-(Identifier)-}
{-(Statements
{-(Identifier)-})-}
(Statements
{ (Identifier)
->(Identifier) }))
@ -21,7 +22,8 @@
(RequiredParameter
{ (Identifier)
->(Identifier) })
{+(Identifier)+}
{+(Statements
{+(Identifier)+})+}
(Statements
{ (Identifier)
->(Identifier) }))
@ -41,7 +43,8 @@
->(TextElement) })
{ (Identifier)
->(Identifier) })
{ (Identifier)
->(Identifier) }
(Statements
{ (Identifier)
->(Identifier) })
(Statements
(Identifier))))

6
test/fixtures/python/corpus/function-definition.parseA.txt vendored
View File

@ -13,7 +13,8 @@
(Identifier)
(RequiredParameter
(Identifier))
(Identifier)
(Statements
(Identifier))
(Statements
(Identifier)))
(Function
@ -30,6 +31,7 @@
(Identifier)
(TextElement))
(Identifier))
(Identifier)
(Statements
(Identifier))
(Statements
(Identifier))))

6
test/fixtures/python/corpus/function-definition.parseB.txt vendored
View File

@ -3,7 +3,8 @@
(Identifier)
(RequiredParameter
(Identifier))
(Identifier)
(Statements
(Identifier))
(Statements
(Identifier)))
(Function
@ -23,6 +24,7 @@
(Identifier)
(Integer))
(Identifier))
(Identifier)
(Statements
(Identifier))
(Statements
(Identifier))))

6
test/fixtures/ruby/corpus/calls.parseA.txt vendored
View File

@ -27,7 +27,9 @@
(Identifier)))
(Send
(Identifier)
(Identifier))
(Send
(Identifier)))
(Send
(Identifier)
(Identifier)))
(Send
(Identifier))))

3
test/fixtures/ruby/corpus/method-calls.diffA-B.txt vendored
View File

@ -27,7 +27,8 @@
{-(KeyValue
{-(Array)-}
{-(Integer)-})-}
{-(Identifier)-}
{-(Send
{-(Identifier)-})-}
{-(Send
{-(Identifier)-})-}
{-(Function

3
test/fixtures/ruby/corpus/method-calls.diffB-A.txt vendored
View File

@ -27,7 +27,8 @@
{+(KeyValue
{+(Array)+}
{+(Integer)+})+}
{+(Identifier)+}
{+(Send
{+(Identifier)+})+}
{+(Send
{+(Identifier)+})+}
{+(Function

3
test/fixtures/ruby/corpus/method-calls.parseA.txt vendored
View File

@ -26,7 +26,8 @@
(KeyValue
(Array)
(Integer))
(Identifier)
(Send
(Identifier))
(Send
(Identifier))
(Function

6
test/fixtures/ruby/corpus/multiple-assignments.diffA-B.txt vendored
View File

@ -33,7 +33,8 @@
{-(Statements
{-(Identifier)-}
{-(Identifier)-})-}
{-(Identifier)-})-}
{-(Send
{-(Identifier)-})-})-}
{-(Assignment
{-(Statements
{-(Send
@ -56,4 +57,5 @@
{-(Statements
{-(Identifier)-}
{-(Identifier)-})-})-}
{-(Identifier)-})-})
{-(Send
{-(Identifier)-})-})-})

6
test/fixtures/ruby/corpus/multiple-assignments.diffB-A.txt vendored
View File

@ -33,7 +33,8 @@
{+(Statements
{+(Identifier)+}
{+(Identifier)+})+}
{+(Identifier)+})+}
{+(Send
{+(Identifier)+})+})+}
{+(Assignment
{+(Statements
{+(Send
@ -56,4 +57,5 @@
{+(Statements
{+(Identifier)+}
{+(Identifier)+})+})+}
{+(Identifier)+})+})
{+(Send
{+(Identifier)+})+})+})

6
test/fixtures/ruby/corpus/multiple-assignments.parseA.txt vendored
View File

@ -33,7 +33,8 @@
(Statements
(Identifier)
(Identifier))
(Identifier))
(Send
(Identifier)))
(Assignment
(Statements
(Send
@ -56,4 +57,5 @@
(Statements
(Identifier)
(Identifier)))
(Identifier)))
(Send
(Identifier))))