Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

semantic tokens: add infix operator #4030

Merged
merged 10 commits into from
Feb 3, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

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

-- * 0. Mapping name to Hs semantic token type.

idInfixOperator :: Identifier -> Maybe HsSemanticTokenType
idInfixOperator (Right name) = nameInfixOperator name
idInfixOperator _ = Nothing

nameInfixOperator :: Name -> Maybe HsSemanticTokenType
nameInfixOperator name | isSymOcc (nameOccName name) = Just TOperator
nameInfixOperator _ = Nothing

-- * 1. Mapping semantic token type to and from the LSP default token type.

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

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

-- | tyThingSemantic
tyThingSemantic :: TyThing -> Maybe HsSemanticTokenType
tyThingSemantic ty = case ty of
tyThingSemantic ty | (Just hst) <- tyThingSemantic' ty = Just hst <> nameInfixOperator (getName ty)
tyThingSemantic _ = Nothing
tyThingSemantic' :: TyThing -> Maybe HsSemanticTokenType
tyThingSemantic' ty = case ty of
AnId vid
| isTyVar vid -> Just TTypeVariable
| isRecordSelector vid -> Just TRecordField
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@ idIdSemanticFromHie hieKind rm ns = do
spanInfos <- M.lookup name' rm'
let typeTokenType = foldMap (typeSemantic hieKind) $ listToMaybe $ mapMaybe (identType . snd) spanInfos
contextInfoTokenType <- foldMap (contextInfosMaybeTokenType . identInfo . snd) spanInfos
fold [typeTokenType, Just contextInfoTokenType]
fold [typeTokenType, Just contextInfoTokenType, idInfixOperator ns]

contextInfosMaybeTokenType :: Set.Set ContextInfo -> Maybe HsSemanticTokenType
contextInfosMaybeTokenType details = foldMap infoTokenType (Set.toList details)
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -40,6 +40,7 @@ docName tt = case tt of
TTypeFamily -> "type families"
TRecordField -> "record fields"
TModule -> "modules"
TOperator -> "operators"

toConfigName :: String -> String
toConfigName = ("st" <>)
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -39,11 +39,10 @@ data HsSemanticTokenType
| TTypeSynonym -- Type synonym
| TTypeFamily -- type family
| TRecordField -- from match bind
| TOperator-- operator
| TModule -- module name
deriving (Eq, Ord, Show, Enum, Bounded, Generic, Lift)



-- type SemanticTokensConfig = SemanticTokensConfig_ Identity
instance Default SemanticTokensConfig where
def = STC
Expand All @@ -63,6 +62,7 @@ instance Default SemanticTokensConfig where
, stTypeFamily = SemanticTokenTypes_Interface
, stRecordField = SemanticTokenTypes_Property
, stModule = SemanticTokenTypes_Namespace
, stOperator = SemanticTokenTypes_Operator
}
-- | SemanticTokensConfig_ is a configuration for the semantic tokens plugin.
-- it contains map between the hs semantic token type and default token type.
Expand All @@ -79,6 +79,7 @@ data SemanticTokensConfig = STC
, stTypeFamily :: !SemanticTokenTypes
, stRecordField :: !SemanticTokenTypes
, stModule :: !SemanticTokenTypes
, stOperator :: !SemanticTokenTypes
} deriving (Generic, Show)


Expand Down
3 changes: 2 additions & 1 deletion plugins/hls-semantic-tokens-plugin/test/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -220,7 +220,8 @@ semanticTokensFunctionTests =
goldenWithSemanticTokensWithDefaultConfig "local functions" "TFunctionLocal",
goldenWithSemanticTokensWithDefaultConfig "functions under type synonym" "TFunctionUnderTypeSynonym",
goldenWithSemanticTokensWithDefaultConfig "function in let binding" "TFunctionLet",
goldenWithSemanticTokensWithDefaultConfig "negative case non-function with constraint" "TNoneFunctionWithConstraint"
goldenWithSemanticTokensWithDefaultConfig "negative case non-function with constraint" "TNoneFunctionWithConstraint",
goldenWithSemanticTokensWithDefaultConfig "TOperator" "TOperator"
]

main :: IO ()
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@
15:5-8 TClassMethod "boo"
15:9-10 TVariable "x"
15:13-14 TVariable "x"
15:15-16 TClassMethod "+"
15:15-16 TOperator "+"
17:6-8 TTypeConstructor "Dd"
17:11-13 TDataConstructor "Dd"
17:14-17 TTypeConstructor "Int"
Expand Down Expand Up @@ -63,18 +63,18 @@
36:11-13 TVariable "vv"
37:10-12 TVariable "gg"
38:14-17 TRecordField "foo"
38:18-19 TFunction "$"
38:18-19 TOperator "$"
38:20-21 TVariable "f"
38:24-27 TRecordField "foo"
39:14-17 TRecordField "foo"
39:18-19 TFunction "$"
39:18-19 TOperator "$"
39:20-21 TVariable "f"
39:24-27 TRecordField "foo"
41:1-3 TFunction "go"
41:6-9 TRecordField "foo"
42:1-4 TFunction "add"
42:8-16 TModule "Prelude."
42:16-17 TClassMethod "+"
42:16-17 TOperator "+"
47:1-5 TVariable "main"
47:9-11 TTypeConstructor "IO"
48:1-5 TVariable "main"
Expand Down
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
4:6-9 TTypeConstructor "Foo"
4:12-15 TDataConstructor "Foo"
4:16-19 TTypeConstructor "Int"
5:10-12 TClass "Eq"
5:13-16 TTypeConstructor "Foo"
6:6-8 TClassMethod "=="
5:10-14 TClass "Show"
5:15-18 TTypeConstructor "Foo"
6:5-9 TClassMethod "show"
6:12-21 TVariable "undefined"
Original file line number Diff line number Diff line change
Expand Up @@ -2,5 +2,5 @@ module TInstanceClassMethodBind where


data Foo = Foo Int
instance Eq Foo where
(==) = undefined
instance Show Foo where
show = undefined
Original file line number Diff line number Diff line change
@@ -1,2 +1,2 @@
4:1-3 TFunction "go"
4:10-12 TClassMethod "=="
4:8-12 TClassMethod "show"
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
module TInstanceClassMethodUse where


go = (==)
go = show

Original file line number Diff line number Diff line change
@@ -0,0 +1,33 @@
4:1-3 TFunction "go"
4:4-5 TFunction "f"
4:6-7 TVariable "x"
4:10-11 TFunction "f"
4:12-13 TOperator "$"
4:14-15 TVariable "x"
6:2-6 TOperator "$$$$"
7:1-2 TVariable "x"
7:7-11 TOperator "$$$$"
8:6-7 TTypeVariable "a"
8:8-11 TOperator ":+:"
8:12-13 TTypeVariable "b"
8:16-19 TDataConstructor "Add"
8:20-21 TTypeVariable "a"
8:22-23 TTypeVariable "b"
9:7-10 TOperator ":-:"
9:12-13 TTypeVariable "a"
9:14-15 TTypeVariable "b"
9:19-20 TTypeVariable "a"
9:22-23 TTypeVariable "b"
11:1-4 TFunction "add"
11:8-11 TTypeConstructor "Int"
11:12-15 TOperator ":+:"
11:16-19 TTypeConstructor "Int"
11:23-26 TTypeConstructor "Int"
11:27-30 TOperator ":-:"
11:31-34 TTypeConstructor "Int"
13:1-4 TFunction "add"
13:6-9 TDataConstructor "Add"
13:10-11 TVariable "x"
13:12-13 TVariable "y"
13:18-19 TVariable "x"
13:21-22 TVariable "y"
13 changes: 13 additions & 0 deletions plugins/hls-semantic-tokens-plugin/test/testdata/TOperator.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,13 @@
module TOperator where

-- imported operator
go f x = f $ x
-- operator defined in local module
($$$$) = b
x = 1 $$$$ 2
data a :+: b = Add a b
type (:-:) a b = (a, b)
-- type take precedence over operator
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I actually think people might prefer to see type operators highlighted differently? In "normal" Haskell syntax highlighting they are!

Copy link
Collaborator Author

@soulomoon soulomoon Feb 1, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yeah, I've been thinking about this, may be it's better for us to mark all the infix thing as operator.
Since infix does change the semantic of normal function application ordering, visually showing this would be more preferable.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I feel reasonably sure that we want "operator" to take precedence over "type". I'm still unsure about "operator" vs "class method"

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

me neither, maybe we can make a pool or something to collect people's opinion on this.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

To be clear, I think it's fine for you to just make a decision for now, we can adjust based on feedback or add configuration.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yep, lets stick to the simplest way for now. Make the infix on top of all.
We can sort things out in configuration PR that switching to the [HsSemanticTokenType] .

add :: Int :+: Int -> Int :-: Int
-- class method take precedence over operator
add (Add x y) = (x, y)
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,6 @@
7:18-22 TClassMethod "elem"
8:1-2 TVariable "c"
8:6-14 TModule "Prelude."
8:14-15 TClassMethod "+"
8:14-15 TOperator "+"
9:1-2 TVariable "d"
9:6-7 TClassMethod "+"
9:6-7 TOperator "+"
1 change: 1 addition & 0 deletions test/testdata/schema/ghc92/default-config.golden.json
Original file line number Diff line number Diff line change
Expand Up @@ -123,6 +123,7 @@
"dataConstructorToken": "enumMember",
"functionToken": "function",
"moduleToken": "namespace",
"operatorToken": "operator",
"patternSynonymToken": "macro",
"recordFieldToken": "property",
"typeConstructorToken": "enum",
Expand Down
56 changes: 56 additions & 0 deletions test/testdata/schema/ghc92/vscode-extension-schema.golden.json
Original file line number Diff line number Diff line change
Expand Up @@ -541,6 +541,62 @@
"scope": "resource",
"type": "string"
},
"haskell.plugin.semanticTokens.config.operatorToken": {
"default": "operator",
"description": "LSP semantic token type to use for operators",
"enum": [
"namespace",
"type",
"class",
"enum",
"interface",
"struct",
"typeParameter",
"parameter",
"variable",
"property",
"enumMember",
"event",
"function",
"method",
"macro",
"keyword",
"modifier",
"comment",
"string",
"number",
"regexp",
"operator",
"decorator"
],
"enumDescriptions": [
"LSP Semantic Token Type: namespace",
"LSP Semantic Token Type: type",
"LSP Semantic Token Type: class",
"LSP Semantic Token Type: enum",
"LSP Semantic Token Type: interface",
"LSP Semantic Token Type: struct",
"LSP Semantic Token Type: typeParameter",
"LSP Semantic Token Type: parameter",
"LSP Semantic Token Type: variable",
"LSP Semantic Token Type: property",
"LSP Semantic Token Type: enumMember",
"LSP Semantic Token Type: event",
"LSP Semantic Token Type: function",
"LSP Semantic Token Type: method",
"LSP Semantic Token Type: macro",
"LSP Semantic Token Type: keyword",
"LSP Semantic Token Type: modifier",
"LSP Semantic Token Type: comment",
"LSP Semantic Token Type: string",
"LSP Semantic Token Type: number",
"LSP Semantic Token Type: regexp",
"LSP Semantic Token Type: operator",
"LSP Semantic Token Type: decorator"
],
"scope": "resource",
"type": "string"
},
"haskell.plugin.semanticTokens.config.patternSynonymToken": {
"default": "macro",
"description": "LSP semantic token type to use for pattern synonyms",
Expand Down
1 change: 1 addition & 0 deletions test/testdata/schema/ghc94/default-config.golden.json
Original file line number Diff line number Diff line change
Expand Up @@ -123,6 +123,7 @@
"dataConstructorToken": "enumMember",
"functionToken": "function",
"moduleToken": "namespace",
"operatorToken": "operator",
"patternSynonymToken": "macro",
"recordFieldToken": "property",
"typeConstructorToken": "enum",
Expand Down
56 changes: 56 additions & 0 deletions test/testdata/schema/ghc94/vscode-extension-schema.golden.json
Original file line number Diff line number Diff line change
Expand Up @@ -541,6 +541,62 @@
"scope": "resource",
"type": "string"
},
"haskell.plugin.semanticTokens.config.operatorToken": {
"default": "operator",
"description": "LSP semantic token type to use for operators",
"enum": [
"namespace",
"type",
"class",
"enum",
"interface",
"struct",
"typeParameter",
"parameter",
"variable",
"property",
"enumMember",
"event",
"function",
"method",
"macro",
"keyword",
"modifier",
"comment",
"string",
"number",
"regexp",
"operator",
"decorator"
],
"enumDescriptions": [
"LSP Semantic Token Type: namespace",
"LSP Semantic Token Type: type",
"LSP Semantic Token Type: class",
"LSP Semantic Token Type: enum",
"LSP Semantic Token Type: interface",
"LSP Semantic Token Type: struct",
"LSP Semantic Token Type: typeParameter",
"LSP Semantic Token Type: parameter",
"LSP Semantic Token Type: variable",
"LSP Semantic Token Type: property",
"LSP Semantic Token Type: enumMember",
"LSP Semantic Token Type: event",
"LSP Semantic Token Type: function",
"LSP Semantic Token Type: method",
"LSP Semantic Token Type: macro",
"LSP Semantic Token Type: keyword",
"LSP Semantic Token Type: modifier",
"LSP Semantic Token Type: comment",
"LSP Semantic Token Type: string",
"LSP Semantic Token Type: number",
"LSP Semantic Token Type: regexp",
"LSP Semantic Token Type: operator",
"LSP Semantic Token Type: decorator"
],
"scope": "resource",
"type": "string"
},
"haskell.plugin.semanticTokens.config.patternSynonymToken": {
"default": "macro",
"description": "LSP semantic token type to use for pattern synonyms",
Expand Down
1 change: 1 addition & 0 deletions test/testdata/schema/ghc96/default-config.golden.json
Original file line number Diff line number Diff line change
Expand Up @@ -123,6 +123,7 @@
"dataConstructorToken": "enumMember",
"functionToken": "function",
"moduleToken": "namespace",
"operatorToken": "operator",
"patternSynonymToken": "macro",
"recordFieldToken": "property",
"typeConstructorToken": "enum",
Expand Down
Loading
Loading