diff --git a/analysis/src/SemanticTokens.ml b/analysis/src/SemanticTokens.ml
index bb1f0d822..7c64836ce 100644
--- a/analysis/src/SemanticTokens.ml
+++ b/analysis/src/SemanticTokens.ml
@@ -28,6 +28,7 @@ module Token = struct
| EnumMember (** variant A or poly variant #A *)
| Property (** {x:...} *)
| JsxLowercase (** div in <div> *)
+ | Function
let tokenTypeToString = function
| Operator -> "0"
@@ -38,6 +39,7 @@ module Token = struct
| EnumMember -> "5"
| Property -> "6"
| JsxLowercase -> "7"
+ | Function -> "8"
let tokenTypeDebug = function
| Operator -> "Operator"
@@ -48,21 +50,26 @@ module Token = struct
| EnumMember -> "EnumMember"
| Property -> "Property"
| JsxLowercase -> "JsxLowercase"
+ | Function -> "Function"
let tokenModifiersString = "0" (* None at the moment *)
- type token = int * int * int * tokenType
-
type emitter = {
- mutable tokens: token list;
+ mutable tokens: (int * int * tokenType, int) Hashtbl.t;
mutable lastLine: int;
mutable lastChar: int;
}
- let createEmitter () = {tokens = []; lastLine = 0; lastChar = 0}
+ let createEmitter () =
+ {tokens = Hashtbl.create 10; lastLine = 0; lastChar = 0}
let add ~line ~char ~length ~type_ e =
- e.tokens <- (line, char, length, type_) :: e.tokens
+ match type_ with
+ | Variable -> (
+ match Hashtbl.find_opt e.tokens (line, char, Function) with
+ | Some _ -> ()
+ | None -> Hashtbl.add e.tokens (line, char, type_) length)
+ | _ -> Hashtbl.add e.tokens (line, char, type_) length
let emitToken buf (line, char, length, type_) e =
let deltaLine = line - e.lastLine in
@@ -80,8 +87,14 @@ module Token = struct
^ tokenModifiersString)
let emit e =
+ let list =
+ Hashtbl.fold
+ (fun (line, char, token) length acc ->
+ (line, char, length, token) :: acc)
+ e.tokens []
+ in
let sortedTokens =
- e.tokens
+ list
|> List.sort (fun (l1, c1, _, _) (l2, c2, _, _) ->
if l1 = l2 then compare c1 c2 else compare l1 l2)
in
@@ -115,8 +128,8 @@ let emitFromLoc ~loc ~type_ emitter =
let emitLongident ?(backwards = false) ?(jsx = false)
?(lowerCaseToken = if jsx then Token.JsxLowercase else Token.Variable)
- ?(upperCaseToken = Token.Namespace) ?(lastToken = None) ?(posEnd = None) ~pos
- ~lid ~debug emitter =
+ ?(upperCaseToken = Token.Namespace) ?(lastToken = None) ?(posEnd = None)
+ ~pos ~lid ~debug emitter =
let rec flatten acc lid =
match lid with
| Longident.Lident txt -> txt :: acc
@@ -307,6 +320,17 @@ let command ~debug ~emitter ~path =
Printf.printf "Binary operator %s %s\n" op (Loc.toString loc);
emitter |> emitFromLoc ~loc ~type_:Operator;
Ast_iterator.default_iterator.expr iterator e
+ | Pexp_apply ({pexp_desc = Pexp_ident {txt = lid; loc}}, _)
+ when Longident.Lident "|." <> lid ->
+ emitter
+ |> emitLongident ~pos:(Loc.start loc) ~lid ~lowerCaseToken:Function ~debug;
+ Ast_iterator.default_iterator.expr iterator e
+ | Pexp_apply
+ ( {pexp_desc = Pexp_ident {txt = Lident "|."}},
+ [_; (_, {pexp_desc = Pexp_ident {txt = lid; loc}})] ) ->
+ emitter
+ |> emitLongident ~pos:(Loc.start loc) ~lid ~lowerCaseToken:Function ~debug;
+ Ast_iterator.default_iterator.expr iterator e
| Pexp_record (cases, _) ->
cases
|> List.iter (fun (label, _) -> emitter |> emitRecordLabel ~label ~debug);
diff --git a/analysis/tests/src/Highlight.res b/analysis/tests/src/Highlight.res
index 3baebefbd..0192f59d1 100644
--- a/analysis/tests/src/Highlight.res
+++ b/analysis/tests/src/Highlight.res
@@ -132,3 +132,11 @@ let _ = 3 == 3 || 3 === 3
let _ = (~_type_ as _) => ()
let _ = {"abc": 34}
+
+let _ = Js.log("Hello")
+
+"Hello"->Js.log
+
+"Hello"->Js.String2.concat("World")->Js.log
+
+[1, 2, 3]->Js.Array2.forEach(i => i->Js.log)
\ No newline at end of file
diff --git a/analysis/tests/src/expected/Highlight.res.txt b/analysis/tests/src/expected/Highlight.res.txt
index 23362420d..9b27864c1 100644
--- a/analysis/tests/src/expected/Highlight.res.txt
+++ b/analysis/tests/src/expected/Highlight.res.txt
@@ -1,5 +1,5 @@
Highlight src/Highlight.res
-structure items:38 diagnostics:0
+structure items:42 diagnostics:0
Lident: M 0:7 Namespace
Lident: C 1:9 Namespace
Lident: Component 1:13 Namespace
@@ -20,6 +20,8 @@ Lident: div 16:4 JsxLowercase
JsxTag >: 11:6
JsxTag >: 16:7
Ldot: React 12:5 Namespace
+Lident: string 12:11 Function
+Ldot: React 12:5 Namespace
Lident: string 12:11 Variable
JsxTag <: 13:4
Lident: div 13:5 JsxLowercase
@@ -27,10 +29,16 @@ Lident: div 13:34 JsxLowercase
JsxTag >: 13:8
JsxTag >: 13:37
Ldot: React 13:11 Namespace
+Lident: string 13:17 Function
+Ldot: React 13:11 Namespace
Lident: string 13:17 Variable
Ldot: React 14:5 Namespace
+Lident: string 14:11 Function
+Ldot: React 14:5 Namespace
Lident: string 14:11 Variable
Ldot: React 15:5 Namespace
+Lident: string 15:11 Function
+Ldot: React 15:5 Namespace
Lident: string 15:11 Variable
Lident: pair 18:5 Type
Lident: looooooooooooooooooooooooooooooooooooooong_int 20:5 Type
@@ -45,6 +53,7 @@ TypeArg: [26:4->26:50]
TypeArg: [27:4->27:53]
Lident: looooooooooooooooooooooooooooooooooooooong_int 26:4 Type
Lident: looooooooooooooooooooooooooooooooooooooong_string 27:4 Type
+Lident: not 31:8 Function
Binary operator < [31:12->31:13]
Binary operator > [31:22->31:23]
Lident: MT 33:12 Type
@@ -81,6 +90,7 @@ Variable: x [69:21->69:22]
Variable: world [69:24->69:30]
Lident: x 69:35 Variable
Lident: world 69:39 Variable
+Lident: add 71:21 Function
Lident: add 71:21 Variable
JsxTag <: 73:8
Lident: div 73:9 JsxLowercase
@@ -107,6 +117,7 @@ Variable: toAs [90:4->90:8]
Variable: x [90:19->90:20]
Lident: x 90:25 Variable
Variable: _toEquals [91:4->91:13]
+Lident: toAs 91:16 Function
Lident: toAs 91:16 Variable
Variable: to [93:4->93:6]
Lident: to 94:9 Variable
@@ -117,6 +128,8 @@ Lident: ToAsProp 98:7 Namespace
Variable: make [100:6->100:10]
Variable: to [100:14->100:17]
Ldot: React 101:8 Namespace
+Lident: int 101:14 Function
+Ldot: React 101:8 Namespace
Lident: int 101:14 Variable
Lident: to 101:18 Variable
JsxTag <: 104:8
@@ -140,4 +153,34 @@ Lident: x 124:9 Variable
Ldot: QQ 126:8 Namespace
Lident: somePolyEnumType 126:11 Type
Lident: abc 133:9->133:14 Property
+Ldot: Js 135:8 Namespace
+Lident: log 135:11 Function
+Ldot: Js 135:8 Namespace
+Lident: log 135:11 Variable
+Ldot: Js 137:9 Namespace
+Lident: log 137:12 Function
+Ldot: Js 137:9 Namespace
+Lident: log 137:12 Variable
+Ldot: Js 139:37 Namespace
+Lident: log 139:40 Function
+Ldot: Js 139:9 Namespace
+Ldot: String2 139:12 Namespace
+Lident: concat 139:20 Function
+Ldot: Js 139:9 Namespace
+Ldot: String2 139:12 Namespace
+Lident: concat 139:20 Variable
+Ldot: Js 139:37 Namespace
+Lident: log 139:40 Variable
+Ldot: Js 141:11 Namespace
+Ldot: Array2 141:14 Namespace
+Lident: forEach 141:21 Function
+Ldot: Js 141:11 Namespace
+Ldot: Array2 141:14 Namespace
+Lident: forEach 141:21 Variable
+Variable: i [141:29->141:30]
+Ldot: Js 141:37 Namespace
+Lident: log 141:40 Function
+Lident: i 141:34 Variable
+Ldot: Js 141:37 Namespace
+Lident: log 141:40 Variable
diff --git a/server/src/server.ts b/server/src/server.ts
index 98ec1779f..6aa462fc8 100644
--- a/server/src/server.ts
+++ b/server/src/server.ts
@@ -1131,7 +1131,8 @@ function onMessage(msg: p.Message) {
"namespace",
"enumMember",
"property",
- "interface", // emit jsxlowercase, div in <div> as interface
+ "interface", // emit jsxlowercase, div in <div> as interface,
+ "function"
],
tokenModifiers: [],
},