Skip to content

Commit d99d919

Browse files
soulomoonsoulomoon
authored
semantic tokens: add infix operator (#4030)
* add infix operator * add test * mark all infix operator to have operator semantic type * update scheme * fix test * fix more test
1 parent 975db49 commit d99d919

21 files changed

+310
-18
lines changed

‎plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Mappings.hs

+16-1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
{-# LANGUAGE GADTs #-}
22
{-# LANGUAGE OverloadedStrings #-}
33
{-# LANGUAGE TypeFamilies #-}
4+
{-# LANGUAGE TypeOperators #-}
45

56
-- |
67
-- This module provides mappings to convert token type information in the Haskell IDE plugin. It includes functions for:
@@ -29,6 +30,16 @@ import Language.LSP.Protocol.Types (LspEnum (knownValues),
2930
UInt, absolutizeTokens)
3031
import Language.LSP.VFS hiding (line)
3132

33+
-- * 0. Mapping name to Hs semantic token type.
34+
35+
idInfixOperator :: Identifier -> Maybe HsSemanticTokenType
36+
idInfixOperator (Right name) = nameInfixOperator name
37+
idInfixOperator _ = Nothing
38+
39+
nameInfixOperator :: Name -> Maybe HsSemanticTokenType
40+
nameInfixOperator name | isSymOcc (nameOccName name) = Just TOperator
41+
nameInfixOperator _ = Nothing
42+
3243
-- * 1. Mapping semantic token type to and from the LSP default token type.
3344

3445
-- | map from haskell semantic token type to LSP default token type
@@ -46,6 +57,7 @@ toLspTokenType conf tk = case tk of
4657
TRecordField -> stRecordField conf
4758
TPatternSynonym -> stPatternSynonym conf
4859
TModule -> stModule conf
60+
TOperator -> stOperator conf
4961

5062
lspTokenReverseMap :: SemanticTokensConfig -> Map.Map SemanticTokenTypes HsSemanticTokenType
5163
lspTokenReverseMap config
@@ -61,7 +73,10 @@ lspTokenTypeHsTokenType cf tk = Map.lookup tk (lspTokenReverseMap cf)
6173

6274
-- | tyThingSemantic
6375
tyThingSemantic :: TyThing -> Maybe HsSemanticTokenType
64-
tyThingSemantic ty = case ty of
76+
tyThingSemantic ty | (Just hst) <- tyThingSemantic' ty = Just hst <> nameInfixOperator (getName ty)
77+
tyThingSemantic _ = Nothing
78+
tyThingSemantic' :: TyThing -> Maybe HsSemanticTokenType
79+
tyThingSemantic' ty = case ty of
6580
AnId vid
6681
| isTyVar vid -> Just TTypeVariable
6782
| isRecordSelector vid -> Just TRecordField

‎plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Query.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,7 @@ idIdSemanticFromHie hieKind rm ns = do
4747
spanInfos <- M.lookup name' rm'
4848
let typeTokenType = foldMap (typeSemantic hieKind) $ listToMaybe $ mapMaybe (identType . snd) spanInfos
4949
contextInfoTokenType <- foldMap (contextInfosMaybeTokenType . identInfo . snd) spanInfos
50-
fold [typeTokenType, Just contextInfoTokenType]
50+
fold [typeTokenType, Just contextInfoTokenType, idInfixOperator ns]
5151

5252
contextInfosMaybeTokenType :: Set.Set ContextInfo -> Maybe HsSemanticTokenType
5353
contextInfosMaybeTokenType details = foldMap infoTokenType (Set.toList details)

‎plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/SemanticConfig.hs

+1
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,7 @@ docName tt = case tt of
4040
TTypeFamily -> "type families"
4141
TRecordField -> "record fields"
4242
TModule -> "modules"
43+
TOperator -> "operators"
4344

4445
toConfigName :: String -> String
4546
toConfigName = ("st" <>)

‎plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Types.hs

+3-2
Original file line numberDiff line numberDiff line change
@@ -39,11 +39,10 @@ data HsSemanticTokenType
3939
| TTypeSynonym -- Type synonym
4040
| TTypeFamily -- type family
4141
| TRecordField -- from match bind
42+
| TOperator-- operator
4243
| TModule -- module name
4344
deriving (Eq, Ord, Show, Enum, Bounded, Generic, Lift)
4445

45-
46-
4746
-- type SemanticTokensConfig = SemanticTokensConfig_ Identity
4847
instance Default SemanticTokensConfig where
4948
def = STC
@@ -63,6 +62,7 @@ instance Default SemanticTokensConfig where
6362
, stTypeFamily = SemanticTokenTypes_Interface
6463
, stRecordField = SemanticTokenTypes_Property
6564
, stModule = SemanticTokenTypes_Namespace
65+
, stOperator = SemanticTokenTypes_Operator
6666
}
6767
-- | SemanticTokensConfig_ is a configuration for the semantic tokens plugin.
6868
-- it contains map between the hs semantic token type and default token type.
@@ -79,6 +79,7 @@ data SemanticTokensConfig = STC
7979
, stTypeFamily :: !SemanticTokenTypes
8080
, stRecordField :: !SemanticTokenTypes
8181
, stModule :: !SemanticTokenTypes
82+
, stOperator :: !SemanticTokenTypes
8283
} deriving (Generic, Show)
8384

8485

‎plugins/hls-semantic-tokens-plugin/test/Main.hs

+2-1
Original file line numberDiff line numberDiff line change
@@ -220,7 +220,8 @@ semanticTokensFunctionTests =
220220
goldenWithSemanticTokensWithDefaultConfig "local functions" "TFunctionLocal",
221221
goldenWithSemanticTokensWithDefaultConfig "functions under type synonym" "TFunctionUnderTypeSynonym",
222222
goldenWithSemanticTokensWithDefaultConfig "function in let binding" "TFunctionLet",
223-
goldenWithSemanticTokensWithDefaultConfig "negative case non-function with constraint" "TNoneFunctionWithConstraint"
223+
goldenWithSemanticTokensWithDefaultConfig "negative case non-function with constraint" "TNoneFunctionWithConstraint",
224+
goldenWithSemanticTokensWithDefaultConfig "TOperator" "TOperator"
224225
]
225226

226227
main :: IO ()

‎plugins/hls-semantic-tokens-plugin/test/testdata/T1.expected

+4-4
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@
1212
15:5-8 TClassMethod "boo"
1313
15:9-10 TVariable "x"
1414
15:13-14 TVariable "x"
15-
15:15-16 TClassMethod "+"
15+
15:15-16 TOperator "+"
1616
17:6-8 TTypeConstructor "Dd"
1717
17:11-13 TDataConstructor "Dd"
1818
17:14-17 TTypeConstructor "Int"
@@ -63,18 +63,18 @@
6363
36:11-13 TVariable "vv"
6464
37:10-12 TVariable "gg"
6565
38:14-17 TRecordField "foo"
66-
38:18-19 TFunction "$"
66+
38:18-19 TOperator "$"
6767
38:20-21 TVariable "f"
6868
38:24-27 TRecordField "foo"
6969
39:14-17 TRecordField "foo"
70-
39:18-19 TFunction "$"
70+
39:18-19 TOperator "$"
7171
39:20-21 TVariable "f"
7272
39:24-27 TRecordField "foo"
7373
41:1-3 TFunction "go"
7474
41:6-9 TRecordField "foo"
7575
42:1-4 TFunction "add"
7676
42:8-16 TModule "Prelude."
77-
42:16-17 TClassMethod "+"
77+
42:16-17 TOperator "+"
7878
47:1-5 TVariable "main"
7979
47:9-11 TTypeConstructor "IO"
8080
48:1-5 TVariable "main"

‎plugins/hls-semantic-tokens-plugin/test/testdata/TInstanceClassMethodBind.expected

+3-3
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
4:6-9 TTypeConstructor "Foo"
22
4:12-15 TDataConstructor "Foo"
33
4:16-19 TTypeConstructor "Int"
4-
5:10-12 TClass "Eq"
5-
5:13-16 TTypeConstructor "Foo"
6-
6:6-8 TClassMethod "=="
4+
5:10-14 TClass "Show"
5+
5:15-18 TTypeConstructor "Foo"
6+
6:5-9 TClassMethod "show"
77
6:12-21 TVariable "undefined"

‎plugins/hls-semantic-tokens-plugin/test/testdata/TInstanceClassMethodBind.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -2,5 +2,5 @@ module TInstanceClassMethodBind where
22

33

44
data Foo = Foo Int
5-
instance Eq Foo where
6-
(==) = undefined
5+
instance Show Foo where
6+
show = undefined

‎plugins/hls-semantic-tokens-plugin/test/testdata/TInstanceClassMethodUse.expected

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,2 +1,2 @@
11
4:1-3 TFunction "go"
2-
4:10-12 TClassMethod "=="
2+
4:8-12 TClassMethod "show"

‎plugins/hls-semantic-tokens-plugin/test/testdata/TInstanceClassMethodUse.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
module TInstanceClassMethodUse where
22

33

4-
go = (==)
4+
go = show
55

‎plugins/hls-semantic-tokens-plugin/test/testdata/TOperator.expected

+33
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,33 @@
1+
4:1-3 TFunction "go"
2+
4:4-5 TFunction "f"
3+
4:6-7 TVariable "x"
4+
4:10-11 TFunction "f"
5+
4:12-13 TOperator "$"
6+
4:14-15 TVariable "x"
7+
6:2-6 TOperator "$$$$"
8+
7:1-2 TVariable "x"
9+
7:7-11 TOperator "$$$$"
10+
8:6-7 TTypeVariable "a"
11+
8:8-11 TOperator ":+:"
12+
8:12-13 TTypeVariable "b"
13+
8:16-19 TDataConstructor "Add"
14+
8:20-21 TTypeVariable "a"
15+
8:22-23 TTypeVariable "b"
16+
9:7-10 TOperator ":-:"
17+
9:12-13 TTypeVariable "a"
18+
9:14-15 TTypeVariable "b"
19+
9:19-20 TTypeVariable "a"
20+
9:22-23 TTypeVariable "b"
21+
11:1-4 TFunction "add"
22+
11:8-11 TTypeConstructor "Int"
23+
11:12-15 TOperator ":+:"
24+
11:16-19 TTypeConstructor "Int"
25+
11:23-26 TTypeConstructor "Int"
26+
11:27-30 TOperator ":-:"
27+
11:31-34 TTypeConstructor "Int"
28+
13:1-4 TFunction "add"
29+
13:6-9 TDataConstructor "Add"
30+
13:10-11 TVariable "x"
31+
13:12-13 TVariable "y"
32+
13:18-19 TVariable "x"
33+
13:21-22 TVariable "y"

‎plugins/hls-semantic-tokens-plugin/test/testdata/TOperator.hs

+13
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
module TOperator where
2+
3+
-- imported operator
4+
go f x = f $ x
5+
-- operator defined in local module
6+
($$$$) = b
7+
x = 1 $$$$ 2
8+
data a :+: b = Add a b
9+
type (:-:) a b = (a, b)
10+
-- type take precedence over operator
11+
add :: Int :+: Int -> Int :-: Int
12+
-- class method take precedence over operator
13+
add (Add x y) = (x, y)

‎plugins/hls-semantic-tokens-plugin/test/testdata/TQualifiedName.expected

+2-2
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,6 @@
77
7:18-22 TClassMethod "elem"
88
8:1-2 TVariable "c"
99
8:6-14 TModule "Prelude."
10-
8:14-15 TClassMethod "+"
10+
8:14-15 TOperator "+"
1111
9:1-2 TVariable "d"
12-
9:6-7 TClassMethod "+"
12+
9:6-7 TOperator "+"

‎test/testdata/schema/ghc92/default-config.golden.json

+1
Original file line numberDiff line numberDiff line change
@@ -123,6 +123,7 @@
123123
"dataConstructorToken": "enumMember",
124124
"functionToken": "function",
125125
"moduleToken": "namespace",
126+
"operatorToken": "operator",
126127
"patternSynonymToken": "macro",
127128
"recordFieldToken": "property",
128129
"typeConstructorToken": "enum",

‎test/testdata/schema/ghc92/vscode-extension-schema.golden.json

+56
Original file line numberDiff line numberDiff line change
@@ -541,6 +541,62 @@
541541
"scope": "resource",
542542
"type": "string"
543543
},
544+
"haskell.plugin.semanticTokens.config.operatorToken": {
545+
"default": "operator",
546+
"description": "LSP semantic token type to use for operators",
547+
"enum": [
548+
"namespace",
549+
"type",
550+
"class",
551+
"enum",
552+
"interface",
553+
"struct",
554+
"typeParameter",
555+
"parameter",
556+
"variable",
557+
"property",
558+
"enumMember",
559+
"event",
560+
"function",
561+
"method",
562+
"macro",
563+
"keyword",
564+
"modifier",
565+
"comment",
566+
"string",
567+
"number",
568+
"regexp",
569+
"operator",
570+
"decorator"
571+
],
572+
"enumDescriptions": [
573+
"LSP Semantic Token Type: namespace",
574+
"LSP Semantic Token Type: type",
575+
"LSP Semantic Token Type: class",
576+
"LSP Semantic Token Type: enum",
577+
"LSP Semantic Token Type: interface",
578+
"LSP Semantic Token Type: struct",
579+
"LSP Semantic Token Type: typeParameter",
580+
"LSP Semantic Token Type: parameter",
581+
"LSP Semantic Token Type: variable",
582+
"LSP Semantic Token Type: property",
583+
"LSP Semantic Token Type: enumMember",
584+
"LSP Semantic Token Type: event",
585+
"LSP Semantic Token Type: function",
586+
"LSP Semantic Token Type: method",
587+
"LSP Semantic Token Type: macro",
588+
"LSP Semantic Token Type: keyword",
589+
"LSP Semantic Token Type: modifier",
590+
"LSP Semantic Token Type: comment",
591+
"LSP Semantic Token Type: string",
592+
"LSP Semantic Token Type: number",
593+
"LSP Semantic Token Type: regexp",
594+
"LSP Semantic Token Type: operator",
595+
"LSP Semantic Token Type: decorator"
596+
],
597+
"scope": "resource",
598+
"type": "string"
599+
},
544600
"haskell.plugin.semanticTokens.config.patternSynonymToken": {
545601
"default": "macro",
546602
"description": "LSP semantic token type to use for pattern synonyms",

‎test/testdata/schema/ghc94/default-config.golden.json

+1
Original file line numberDiff line numberDiff line change
@@ -123,6 +123,7 @@
123123
"dataConstructorToken": "enumMember",
124124
"functionToken": "function",
125125
"moduleToken": "namespace",
126+
"operatorToken": "operator",
126127
"patternSynonymToken": "macro",
127128
"recordFieldToken": "property",
128129
"typeConstructorToken": "enum",

‎test/testdata/schema/ghc94/vscode-extension-schema.golden.json

+56
Original file line numberDiff line numberDiff line change
@@ -541,6 +541,62 @@
541541
"scope": "resource",
542542
"type": "string"
543543
},
544+
"haskell.plugin.semanticTokens.config.operatorToken": {
545+
"default": "operator",
546+
"description": "LSP semantic token type to use for operators",
547+
"enum": [
548+
"namespace",
549+
"type",
550+
"class",
551+
"enum",
552+
"interface",
553+
"struct",
554+
"typeParameter",
555+
"parameter",
556+
"variable",
557+
"property",
558+
"enumMember",
559+
"event",
560+
"function",
561+
"method",
562+
"macro",
563+
"keyword",
564+
"modifier",
565+
"comment",
566+
"string",
567+
"number",
568+
"regexp",
569+
"operator",
570+
"decorator"
571+
],
572+
"enumDescriptions": [
573+
"LSP Semantic Token Type: namespace",
574+
"LSP Semantic Token Type: type",
575+
"LSP Semantic Token Type: class",
576+
"LSP Semantic Token Type: enum",
577+
"LSP Semantic Token Type: interface",
578+
"LSP Semantic Token Type: struct",
579+
"LSP Semantic Token Type: typeParameter",
580+
"LSP Semantic Token Type: parameter",
581+
"LSP Semantic Token Type: variable",
582+
"LSP Semantic Token Type: property",
583+
"LSP Semantic Token Type: enumMember",
584+
"LSP Semantic Token Type: event",
585+
"LSP Semantic Token Type: function",
586+
"LSP Semantic Token Type: method",
587+
"LSP Semantic Token Type: macro",
588+
"LSP Semantic Token Type: keyword",
589+
"LSP Semantic Token Type: modifier",
590+
"LSP Semantic Token Type: comment",
591+
"LSP Semantic Token Type: string",
592+
"LSP Semantic Token Type: number",
593+
"LSP Semantic Token Type: regexp",
594+
"LSP Semantic Token Type: operator",
595+
"LSP Semantic Token Type: decorator"
596+
],
597+
"scope": "resource",
598+
"type": "string"
599+
},
544600
"haskell.plugin.semanticTokens.config.patternSynonymToken": {
545601
"default": "macro",
546602
"description": "LSP semantic token type to use for pattern synonyms",

‎test/testdata/schema/ghc96/default-config.golden.json

+1
Original file line numberDiff line numberDiff line change
@@ -123,6 +123,7 @@
123123
"dataConstructorToken": "enumMember",
124124
"functionToken": "function",
125125
"moduleToken": "namespace",
126+
"operatorToken": "operator",
126127
"patternSynonymToken": "macro",
127128
"recordFieldToken": "property",
128129
"typeConstructorToken": "enum",

0 commit comments

Comments
 (0)