mirror of
https://github.com/github/semantic.git
synced 2024-12-24 23:42:31 +03:00
Explicitly list all the instances for Go.Tags.ToTags.
This commit is contained in:
parent
97c83694df
commit
ee0c74df38
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user