diff --git a/semantic-tsx/src/Language/TSX/Tags.hs b/semantic-tsx/src/Language/TSX/Tags.hs index 83b0a46b6..8858c3e60 100644 --- a/semantic-tsx/src/Language/TSX/Tags.hs +++ b/semantic-tsx/src/Language/TSX/Tags.hs @@ -1,19 +1,19 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE DataKinds #-} +{-# 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 FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -freduction-depth=0 #-} module Language.TSX.Tags ( ToTags(..) ) where @@ -28,6 +28,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 @@ -37,71 +38,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 @@ -114,20 +98,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 @@ -139,9 +125,6 @@ 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. @@ -156,3 +139,162 @@ 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