Skip to content

semantic tokens: add infix operator #4030

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

Merged
merged 10 commits into from
Feb 3, 2024
Merged
Original file line number Diff line number Diff line change
Expand Up @@ -29,6 +29,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 +56,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 @@ -66,7 +77,7 @@ tyThingSemantic ty = case ty of
| isTyVar vid -> Just TTypeVariable
| isRecordSelector vid -> Just TRecordField
| isClassOpId vid -> Just TClassMethod
| isFunVar vid -> Just TFunction
| isFunVar vid -> Just TFunction <> (nameInfixOperator $ getName vid)
Copy link
Collaborator

Choose a reason for hiding this comment

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

Since you're going to merge them all with <> later, perhaps tyThingSemantic should just return [HsSemanticTokenType], since in general we might allocate several types? That would simplify some things, e.g. here you're implicitly duplicating the fact that TClassMethod is preferred over TFunction by putting the match for isClassOpId first. (So if you ever changed the preference in the Semigroup instance you would still get the old answer!).

So you could do something like:

AnId vid -> [TTypeVariable | isTyVar vid] ++ ... ++ [TFunction | isFunVar vid] ++ [TOperator | isSymId vid]

and then let the semigroup instance sort it all out. Less important for the other cases where we don't have overlapping token types, though.

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.

True, let semigroup instance sort it all out would be better

Copy link
Collaborator

Choose a reason for hiding this comment

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

Also you would actually have to do this if you wanted to make the priorities configurable.

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.

yes, and it is going to be more tricky when priorities is configurable. Since we need to make sure the token type consistant between the one from hieAst and the one from typeThing.

Copy link
Collaborator

Choose a reason for hiding this comment

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

Well, that should work out okay with the model where we just collect (possibly many) token types and then pick the "best". We'll have to have a "best" function that is derived from the configuration, instead of just the hardcoded one based on the Semigroup instance, but that seems okay?

Copy link
Collaborator Author

Choose a reason for hiding this comment

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

I agree, we might want to switch to list or set eventually with priorities configurations. Since by then, we might need to add test to ensure the all the results coming from imported or local names would have the same set of token types(instead of the current strategy to have just the same token type).

Copy link
Collaborator

Choose a reason for hiding this comment

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

test to ensure the all the results coming from imported or local names would have the same set of token types

You mean if I have

module A where

foo = ...
module B where
import A

bar = foo

then foo should have the same tokens in both cases? That does seem like a nice property!

Copy link
Collaborator Author

@soulomoon soulomoon Feb 2, 2024

Choose a reason for hiding this comment

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

Exactly, we would have to have that property or the configuration would not work well.

| otherwise -> Just TVariable
AConLike con -> case con of
RealDataCon _ -> Just TDataConstructor
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,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 @@ -42,6 +42,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 @@ -36,6 +36,7 @@ import Language.Haskell.TH.Syntax (Lift)
data HsSemanticTokenType
= TVariable -- none function variable
| TFunction -- function
| TOperator-- operator
| TDataConstructor -- Data constructor
| TTypeVariable -- Type variable
| TClassMethod -- Class method
Expand Down Expand Up @@ -69,6 +70,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 @@ -85,6 +87,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 @@ -224,7 +224,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 @@ -63,11 +63,11 @@
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"
Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,27 @@
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 TTypeConstructor ":+:"
8:12-13 TTypeVariable "b"
8:16-19 TDataConstructor "Add"
8:20-21 TTypeVariable "a"
8:22-23 TTypeVariable "b"
10:1-4 TFunction "add"
10:8-11 TTypeConstructor "Int"
10:12-15 TTypeConstructor ":+:"
10:16-19 TTypeConstructor "Int"
10:23-26 TTypeConstructor "Int"
12:1-4 TFunction "add"
12:6-9 TDataConstructor "Add"
12:10-11 TVariable "x"
12:12-13 TVariable "y"
12:17-18 TVariable "x"
12:19-20 TClassMethod "+"
12:21-22 TVariable "y"
12 changes: 12 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,12 @@
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 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
-- class method take precedence over operator
add (Add x y) = x + y