Skip to content

Commit 5e0648c

Browse files
aspeddroaspeddro
committed
feat(inlayHint): simplify hint
1 parent a4fae36 commit 5e0648c

File tree

1 file changed

+53
-229
lines changed

1 file changed

+53
-229
lines changed

‎analysis/src/Hint.ml

+53-229
Original file line numberDiff line numberDiff line change
@@ -12,125 +12,40 @@ type kind =
1212
| EnumMember
1313
| TypeParameter
1414

15-
let hintPrefix label = Printf.sprintf ": %s" label
16-
let hintkindNumber = function TypeParameter | EnumMember -> 2 | _ -> 1
15+
let typeHintKindToNumber = function Variable -> 1 | _ -> 2
16+
let getPaddingFromKind = function Variable -> 4 | _ -> 0
17+
18+
let parseTypeReturn (t : Types.type_expr) =
19+
let typeString = Shared.typeToString t in
20+
match Str.split (Str.regexp "=>") typeString with
21+
| x :: xs -> List.fold_left (fun _ y -> y) x xs |> String.trim
22+
| _ -> typeString
1723

1824
let locItemToTypeHint ~full:{file; package} locItem =
1925
match locItem.locType with
20-
(* | TypeDefinition (name, decl, _stamp) -> *)
21-
(* let typeDef = Shared.declToString name decl in *)
22-
(* Some (hintPrefix typeDef) *)
23-
(* | LModule (Definition (stamp, _tip)) | LModule (LocalReference (stamp, _tip)) *)
24-
(* -> ( *)
25-
(* match Stamps.findModule file.stamps stamp with *)
26-
(* | None -> None *)
27-
(* | Some md -> ( *)
28-
(* match References.resolveModuleReference ~file ~package md with *)
29-
(* | None -> None *)
30-
(* | Some (file, declared) -> *)
31-
(* let name, docstring = *)
32-
(* match declared with *)
33-
(* | Some d -> (d.name.txt, d.docstring) *)
34-
(* | None -> (file.moduleName, file.structure.docstring) *)
35-
(* in *)
36-
(* Hover.showModule ~docstring ~name ~file declared)) *)
37-
(* | LModule (GlobalReference (moduleName, path, tip)) -> ( *)
38-
(* match ProcessCmt.fileForModule ~package moduleName with *)
39-
(* | None -> None *)
40-
(* | Some file -> ( *)
41-
(* let env = QueryEnv.fromFile file in *)
42-
(* match ResolvePath.resolvePath ~env ~path ~package with *)
43-
(* | None -> None *)
44-
(* | Some (env, name) -> ( *)
45-
(* match References.exportedForTip ~env name tip with *)
46-
(* | None -> None *)
47-
(* | Some stamp -> ( *)
48-
(* match Stamps.findModule file.stamps stamp with *)
49-
(* | None -> None *)
50-
(* | Some md -> ( *)
51-
(* match References.resolveModuleReference ~file ~package md with *)
52-
(* | None -> None *)
53-
(* | Some (file, declared) -> *)
54-
(* let name, docstring = *)
55-
(* match declared with *)
56-
(* | Some d -> (d.name.txt, d.docstring) *)
57-
(* | None -> (file.moduleName, file.structure.docstring) *)
58-
(* in *)
59-
(* Hover.showModule ~docstring ~name ~file declared))))) *)
60-
| LModule NotFound -> None
61-
(* | TopLevelModule name -> ( *)
62-
(* match ProcessCmt.fileForModule ~package name with *)
63-
(* | None -> None *)
64-
(* | Some file -> *)
65-
(* Hover.showModule ~docstring:file.structure.docstring ~name:file.moduleName *)
66-
(* ~file None) *)
67-
| Typed (_, _, Definition (_, (Field _ | Constructor _))) -> None
6826
| Constant t ->
6927
Some
70-
(hintPrefix
71-
(match t with
72-
| Const_int _ -> "int"
73-
| Const_char _ -> "char"
74-
| Const_string _ -> "string"
75-
| Const_float _ -> "float"
76-
| Const_int32 _ -> "int32"
77-
| Const_int64 _ -> "int64"
78-
| Const_nativeint _ -> "int"))
28+
(match t with
29+
| Const_int _ -> "int"
30+
| Const_char _ -> "char"
31+
| Const_string _ -> "string"
32+
| Const_float _ -> "float"
33+
| Const_int32 _ -> "int32"
34+
| Const_int64 _ -> "int64"
35+
| Const_nativeint _ -> "int")
7936
| Typed (_, t, locKind) ->
80-
(* let fromType ~docstring typ = *)
81-
(* let typeString = Hover.codeBlock (typ |> Shared.typeToString) in *)
82-
(* let extraTypeInfo = *)
83-
(* let env = QueryEnv.fromFile file in *)
84-
(* match typ |> Shared.digConstructor with *)
85-
(* | None -> None *)
86-
(* | Some path -> ( *)
87-
(* match References.digConstructor ~env ~package path with *)
88-
(* | None -> None *)
89-
(* | Some (_env, {docstring; name = {txt}; item = {decl}}) -> *)
90-
(* if Utils.isUncurriedInternal path then None *)
91-
(* else Some (decl |> Shared.declToString txt, docstring)) *)
92-
(* in *)
93-
(* let typeString, docstring = *)
94-
(* match extraTypeInfo with *)
95-
(* | None -> (typeString, docstring) *)
96-
(* | Some (extra, extraDocstring) -> *)
97-
(* (typeString ^ "\n\n" ^ Hover.codeBlock extra, extraDocstring) *)
98-
(* in *)
99-
(* (typeString, docstring) *)
100-
(* in *)
101-
let parts =
102-
match References.definedForLoc ~file ~package locKind with
103-
| None ->
104-
let typeString = Shared.typeToString t in
105-
typeString
106-
| Some (docstring, res) -> (
37+
Some
38+
(match References.definedForLoc ~file ~package locKind with
39+
| None -> parseTypeReturn t
40+
| Some (_, res) -> (
10741
match res with
108-
| `Declared ->
109-
let typeString = Shared.typeToString t in
110-
typeString
111-
| `Constructor {cname = {txt}; args} ->
112-
let typeString = Shared.typeToString t in
113-
typeString
114-
(* let typeString, docstring = t |> fromType ~docstring in *)
115-
(* let argsString = *)
116-
(* match args with *)
117-
(* | [] -> "" *)
118-
(* | _ -> *)
119-
(* args *)
120-
(* |> List.map (fun (t, _) -> (Shared.typeToString t) ^ "hre") *)
121-
(* |> String.concat ", " |> Printf.sprintf "(%s)" *)
122-
(* in *)
123-
(* typeString *)
124-
| `Field ->
125-
let typeString = Shared.typeToString t in
126-
typeString
127-
(* let typeString, docstring = t |> fromType ~docstring in *)
128-
(* typeString) *)
129-
)
130-
in
131-
Some parts
42+
| `Declared -> parseTypeReturn t
43+
| `Constructor _ -> parseTypeReturn t
44+
| `Field -> parseTypeReturn t))
45+
| _ -> None
13246

133-
let inlay ~path ~debug =
47+
(* TODO: filter for range of lines*)
48+
let inlay ~path ~pos ~debug =
13449
let symbols = ref [] in
13550
let rec exprKind (exp : Parsetree.expression) =
13651
match exp.pexp_desc with
@@ -142,34 +57,7 @@ let inlay ~path ~debug =
14257
| Pexp_constant _ -> Constant
14358
| _ -> Variable
14459
in
145-
(* let processTypeKind (tk : Parsetree.type_kind) = *)
146-
(* match tk with *)
147-
(* | Ptype_variant constrDecls -> *)
148-
(* constrDecls *)
149-
(* |> List.iter (fun (cd : Parsetree.constructor_declaration) -> *)
150-
(* symbols := (cd.pcd_name.txt, cd.pcd_loc, EnumMember) :: !symbols) *)
151-
(* | Ptype_record labelDecls -> *)
152-
(* labelDecls *)
153-
(* |> List.iter (fun (ld : Parsetree.label_declaration) -> *)
154-
(* symbols := (ld.pld_name.txt, ld.pld_loc, Property) :: !symbols) *)
155-
(* | _ -> () *)
156-
(* in *)
157-
(* let processTypeDeclaration (td : Parsetree.type_declaration) = *)
158-
(* symbols := (td.ptype_name.txt, td.ptype_loc, TypeParameter) :: !symbols; *)
159-
(* processTypeKind td.ptype_kind *)
160-
(* in *)
161-
let processValueDescription (vd : Parsetree.value_description) =
162-
symbols := (vd.pval_name.txt, vd.pval_loc, Variable) :: !symbols
163-
in
164-
(* let processModuleBinding (mb : Parsetree.module_binding) = *)
165-
(* symbols := (mb.pmb_name.txt, mb.pmb_loc, Module) :: !symbols *)
166-
(* in *)
167-
(* let processModuleDeclaration (md : Parsetree.module_declaration) = *)
168-
(* symbols := (md.pmd_name.txt, md.pmd_loc, Module) :: !symbols *)
169-
(* in *)
170-
(* let processExtensionConstructor (et : Parsetree.extension_constructor) = *)
171-
(* symbols := (et.pext_name.txt, et.pext_loc, Constructor) :: !symbols *)
172-
(* in *)
60+
(* TODO: Handle with tuples let-bindings *)
17361
let value_binding (iterator : Ast_iterator.iterator)
17462
(vb : Parsetree.value_binding) =
17563
(match vb.pvb_pat.ppat_desc with
@@ -178,58 +66,7 @@ let inlay ~path ~debug =
17866
| _ -> ());
17967
Ast_iterator.default_iterator.value_binding iterator vb
18068
in
181-
(* let expr (iterator : Ast_iterator.iterator) (e : Parsetree.expression) = *)
182-
(* (match e.pexp_desc with *)
183-
(* | Pexp_letmodule ({txt}, modExpr, _) -> *)
184-
(* symbols := *)
185-
(* (txt, {e.pexp_loc with loc_end = modExpr.pmod_loc.loc_end}, Module) *)
186-
(* :: !symbols *)
187-
(* (* | Pexp_letexception (ec, _) -> processExtensionConstructor ec *) *)
188-
(* | _ -> ()); *)
189-
(* Ast_iterator.default_iterator.expr iterator e *)
190-
(* in *)
191-
let structure_item (iterator : Ast_iterator.iterator)
192-
(item : Parsetree.structure_item) =
193-
(match item.pstr_desc with
194-
| Pstr_value _ -> ()
195-
| Pstr_primitive vd -> processValueDescription vd
196-
(* | Pstr_type (_, typDecls) -> typDecls |> List.iter processTypeDeclaration *)
197-
(* | Pstr_module mb -> processModuleBinding mb *)
198-
(* | Pstr_recmodule mbs -> mbs |> List.iter processModuleBinding *)
199-
(* | Pstr_exception ec -> processExtensionConstructor ec *)
200-
| _ -> ());
201-
Ast_iterator.default_iterator.structure_item iterator item
202-
in
203-
let signature_item (iterator : Ast_iterator.iterator)
204-
(item : Parsetree.signature_item) =
205-
(match item.psig_desc with
206-
| Psig_value vd -> processValueDescription vd
207-
(* | Psig_type (_, typDecls) -> typDecls |> List.iter processTypeDeclaration *)
208-
(* | Psig_module md -> processModuleDeclaration md *)
209-
(* | Psig_recmodule mds -> mds |> List.iter processModuleDeclaration *)
210-
(* | Psig_exception ec -> processExtensionConstructor ec *)
211-
| _ -> ());
212-
Ast_iterator.default_iterator.signature_item iterator item
213-
in
214-
(* let module_expr (iterator : Ast_iterator.iterator) *)
215-
(* (me : Parsetree.module_expr) = *)
216-
(* match me.pmod_desc with *)
217-
(* | Pmod_constraint (modExpr, _modTyp) -> *)
218-
(* (* Don't double-list items in implementation and interface *) *)
219-
(* Ast_iterator.default_iterator.module_expr iterator modExpr *)
220-
(* | _ -> Ast_iterator.default_iterator.module_expr iterator me *)
221-
(* in *)
222-
let iterator =
223-
{
224-
Ast_iterator.default_iterator with
225-
(* expr; *)
226-
(* module_expr; *)
227-
(* signature_item; *)
228-
(* structure_item; *)
229-
value_binding;
230-
}
231-
in
232-
69+
let iterator = {Ast_iterator.default_iterator with value_binding} in
23370
(if Filename.check_suffix path ".res" then
23471
let parser =
23572
Res_driver.parsingEngine.parseImplementation ~forPrinter:false
@@ -243,48 +80,35 @@ let inlay ~path ~debug =
24380
!symbols
24481
|> List.rev_map (fun (name, loc, kind) ->
24582
let range = Utils.cmtLocToRange loc in
246-
let character_end_pos =
247-
4 + range.start.character + String.length name
83+
(* TODO: find the ending or starting position of a let bindings *)
84+
let rangeEndCharacter =
85+
getPaddingFromKind kind + range.start.character + String.length name
24886
in
249-
let label =
250-
match Cmt.fullFromPath ~path with
251-
| None -> Protocol.null
252-
| Some full -> (
253-
match
254-
References.getLocItem ~full
255-
~pos:(range.start.line, character_end_pos)
256-
~debug:true
257-
with
258-
| None -> "refereces not found"
259-
| Some s -> (
260-
match locItemToTypeHint ~full s with
261-
| Some hint -> hint
262-
| None -> "TypeHint not found"))
87+
let hintKind = typeHintKindToNumber kind in
88+
let position : Protocol.position =
89+
{line = range.start.line; character = rangeEndCharacter}
26390
in
91+
match Cmt.fullFromPath ~path with
92+
| None -> None
93+
| Some full -> (
94+
match
95+
References.getLocItem ~full
96+
~pos:(position.line, position.character)
97+
~debug
98+
with
99+
| None -> None
100+
| Some s -> (
101+
match locItemToTypeHint ~full s with
102+
| Some typeHint -> Some (typeHint, hintKind, position)
103+
| None -> None)))
104+
|> List.filter_map (fun x -> x)
105+
|> List.map (fun (typeHint, kind, position) ->
264106
Protocol.stringifyHint
265107
{
266-
kind = hintkindNumber kind;
267-
(* label is type *)
268-
(* label = name; *)
269-
tooltip = {
270-
kind = "markdown";
271-
value = Hover.codeBlock label;
272-
};
108+
kind;
109+
position;
110+
tooltip = {kind = "markdown"; value = Hover.codeBlock typeHint};
273111
paddingLeft = false;
274112
paddingRight = false;
275-
label = ": " ^ label;
276-
277-
position =
278-
{
279-
line = range.start.line;
280-
(* From col 0 to last character
281-
let name = "lol"
282-
^
283-
*)
284-
character =
285-
character_end_pos
286-
(* character = pos.start.character; *)
287-
(* line = 0; *)
288-
(* character = 0; *);
289-
};
113+
label = ": " ^ typeHint;
290114
})

0 commit comments

Comments
 (0)