1
1
mirror of https://github.com/github/semantic.git synced 2024-12-26 08:25:19 +03:00

Explicitly list all the instances for TSX.Tags.ToTags.

This commit is contained in:
Rob Rix 2020-01-15 10:41:45 -05:00
parent 1f5c7fda5c
commit cae589a449
No known key found for this signature in database
GPG Key ID: 2BE643E01DC032AE

View File

@ -1,5 +1,6 @@
{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
@ -13,7 +14,6 @@
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -freduction-depth=0 #-}
module Language.TSX.Tags module Language.TSX.Tags
( ToTags(..) ( ToTags(..)
) where ) where
@ -28,6 +28,7 @@ import Source.Loc
import Source.Source as Source import Source.Source as Source
import Tags.Tag import Tags.Tag
import qualified Tags.Tagging.Precise as Tags import qualified Tags.Tagging.Precise as Tags
import TreeSitter.Token
import qualified TreeSitter.TSX.AST as Tsx import qualified TreeSitter.TSX.AST as Tsx
class ToTags t where class ToTags t where
@ -37,54 +38,37 @@ class ToTags t where
) )
=> t Loc => t Loc
-> m () -> m ()
default tags
instance (ToTagsBy strategy t, strategy ~ ToTagsInstance t) => ToTags t where
tags = tags' @strategy
class ToTagsBy (strategy :: Strategy) t where
tags'
:: ( Has (Reader Source) sig m :: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m , Has (Writer Tags.Tags) sig m
, Generic1 t
, Tags.GTraversable1 ToTags (Rep1 t)
) )
=> t Loc => t Loc
-> m () -> m ()
tags = gtags
instance ToTags Tsx.Function where
data Strategy = Generic | Custom tags t@Tsx.Function
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
{ ann = loc@Loc { byteRange } { ann = loc@Loc { byteRange }
, name = Just Tsx.Identifier { text } , name = Just Tsx.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t } = yieldTag text Function loc byteRange >> gtags t
tags' t = gtags t tags t = gtags t
instance ToTagsBy 'Custom Tsx.FunctionSignature where instance ToTags Tsx.FunctionSignature where
tags' t@Tsx.FunctionSignature tags t@Tsx.FunctionSignature
{ ann = loc@Loc { byteRange } { ann = loc@Loc { byteRange }
, name = Tsx.Identifier { text } , name = Tsx.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t } = yieldTag text Function loc byteRange >> gtags t
instance ToTagsBy 'Custom Tsx.FunctionDeclaration where instance ToTags Tsx.FunctionDeclaration where
tags' t@Tsx.FunctionDeclaration tags t@Tsx.FunctionDeclaration
{ ann = loc@Loc { byteRange } { ann = loc@Loc { byteRange }
, name = Tsx.Identifier { text } , name = Tsx.Identifier { text }
} = yieldTag text Function loc byteRange >> gtags t } = yieldTag text Function loc byteRange >> gtags t
instance ToTagsBy 'Custom Tsx.MethodDefinition where instance ToTags Tsx.MethodDefinition where
tags' t@Tsx.MethodDefinition tags t@Tsx.MethodDefinition
{ ann = loc@Loc { byteRange } { ann = loc@Loc { byteRange }
, name , name
} = case name of } = case name of
@ -94,14 +78,14 @@ instance ToTagsBy 'Custom Tsx.MethodDefinition where
where where
yield name = yieldTag name Call loc byteRange >> gtags t yield name = yieldTag name Call loc byteRange >> gtags t
instance ToTagsBy 'Custom Tsx.ClassDeclaration where instance ToTags Tsx.ClassDeclaration where
tags' t@Tsx.ClassDeclaration tags t@Tsx.ClassDeclaration
{ ann = loc@Loc { byteRange } { ann = loc@Loc { byteRange }
, name = Tsx.TypeIdentifier { text } , name = Tsx.TypeIdentifier { text }
} = yieldTag text Class loc byteRange >> gtags t } = yieldTag text Class loc byteRange >> gtags t
instance ToTagsBy 'Custom Tsx.CallExpression where instance ToTags Tsx.CallExpression where
tags' t@Tsx.CallExpression tags t@Tsx.CallExpression
{ ann = loc@Loc { byteRange } { ann = loc@Loc { byteRange }
, function = Tsx.Expression expr , function = Tsx.Expression expr
} = match expr } = match expr
@ -118,16 +102,18 @@ instance ToTagsBy 'Custom Tsx.CallExpression where
_ -> gtags t _ -> gtags t
yield name = yieldTag name Call loc byteRange >> gtags t yield name = yieldTag name Call loc byteRange >> gtags t
instance ToTagsBy 'Custom Tsx.Class where instance ToTags Tsx.Class where
tags' t@Tsx.Class tags t@Tsx.Class
{ ann = loc@Loc { byteRange } { ann = loc@Loc { byteRange }
, name = Just Tsx.TypeIdentifier { text } , name = Just Tsx.TypeIdentifier { text }
} = yieldTag text Class loc byteRange >> gtags t } = 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 instance (ToTags l, ToTags r) => ToTags (l :+: r) where
tags' (L1 l) = tags l tags (L1 l) = tags l
tags' (R1 r) = tags r tags (R1 r) = tags r
instance ToTags (Token sym n) where tags _ = pure ()
gtags gtags
:: ( Has (Reader Source) sig m :: ( Has (Reader Source) sig m
@ -139,9 +125,6 @@ gtags
-> m () -> m ()
gtags = Tags.traverse1_ @ToTags (const (pure ())) tags . Tags.Generics 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 -- These are all valid, but point to built-in functions (e.g. require) that a la
-- carte doesn't display and since we have nothing to link to yet (can't -- carte doesn't display and since we have nothing to link to yet (can't
-- jump-to-def), we hide them from the current tags output. -- jump-to-def), we hide them from the current tags output.
@ -156,3 +139,162 @@ yieldTag name kind loc range = do
src <- ask @Source src <- ask @Source
let sliced = slice src range let sliced = slice src range
Tags.yield (Tag name kind loc (Tags.firstLine sliced) Nothing) 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