Skip to content

Commit 80eb9ef

Browse files
zthzth
committed
refactor expanding types in hover so it can more easily be shared
1 parent 5e0e44e commit 80eb9ef

File tree

6 files changed

+136
-127
lines changed

6 files changed

+136
-127
lines changed

‎analysis/src/Commands.ml

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -52,14 +52,15 @@ let hover ~path ~pos ~currentFile ~debug ~supportsMarkdownLinks =
5252
match completions with
5353
| {kind = Label typString; docstring} :: _ ->
5454
let parts =
55-
(if typString = "" then [] else [Hover.codeBlock typString])
55+
(if typString = "" then [] else [Markdown.codeBlock typString])
5656
@ docstring
5757
in
5858
Protocol.stringifyHover (String.concat "\n\n" parts)
5959
| _ -> (
6060
match CompletionBackEnd.completionsGetTypeEnv completions with
6161
| Some (typ, _env) ->
62-
Protocol.stringifyHover (Hover.codeBlock (Shared.typeToString typ))
62+
Protocol.stringifyHover
63+
(Markdown.codeBlock (Shared.typeToString typ))
6364
| None -> Protocol.null))
6465
| Some locItem -> (
6566
let isModule =

‎analysis/src/Hover.ml

Lines changed: 74 additions & 123 deletions
Original file line numberDiff line numberDiff line change
@@ -1,51 +1,5 @@
11
open SharedTypes
22

3-
let codeBlock code = Printf.sprintf "```rescript\n%s\n```" code
4-
5-
(* Light weight, hopefully-enough-for-the-purpose fn to encode URI components.
6-
Built to handle the reserved characters listed in
7-
https://en.wikipedia.org/wiki/Percent-encoding. Note that this function is not
8-
general purpose, rather it's currently only for URL encoding the argument list
9-
passed to command links in markdown. *)
10-
let encodeURIComponent text =
11-
let ln = String.length text in
12-
let buf = Buffer.create ln in
13-
let rec loop i =
14-
if i < ln then (
15-
(match text.[i] with
16-
| '"' -> Buffer.add_string buf "%22"
17-
| '\'' -> Buffer.add_string buf "%22"
18-
| ':' -> Buffer.add_string buf "%3A"
19-
| ';' -> Buffer.add_string buf "%3B"
20-
| '/' -> Buffer.add_string buf "%2F"
21-
| '\\' -> Buffer.add_string buf "%5C"
22-
| ',' -> Buffer.add_string buf "%2C"
23-
| '&' -> Buffer.add_string buf "%26"
24-
| '[' -> Buffer.add_string buf "%5B"
25-
| ']' -> Buffer.add_string buf "%5D"
26-
| '#' -> Buffer.add_string buf "%23"
27-
| '$' -> Buffer.add_string buf "%24"
28-
| '+' -> Buffer.add_string buf "%2B"
29-
| '=' -> Buffer.add_string buf "%3D"
30-
| '?' -> Buffer.add_string buf "%3F"
31-
| '@' -> Buffer.add_string buf "%40"
32-
| '%' -> Buffer.add_string buf "%25"
33-
| c -> Buffer.add_char buf c);
34-
loop (i + 1))
35-
in
36-
loop 0;
37-
Buffer.contents buf
38-
39-
type link = {startPos: Protocol.position; file: string; label: string}
40-
41-
let linkToCommandArgs link =
42-
Printf.sprintf "[\"%s\",%i,%i]" link.file link.startPos.line
43-
link.startPos.character
44-
45-
let makeGotoCommand link =
46-
Printf.sprintf "[%s](command:rescript-vscode.go_to_location?%s)" link.label
47-
(encodeURIComponent (linkToCommandArgs link))
48-
493
let showModuleTopLevel ~docstring ~name (topLevel : Module.item list) =
504
let contents =
515
topLevel
@@ -60,7 +14,9 @@ let showModuleTopLevel ~docstring ~name (topLevel : Module.item list) =
6014
(* TODO indent *)
6115
|> String.concat "\n"
6216
in
63-
let full = codeBlock ("module " ^ name ^ " = {" ^ "\n" ^ contents ^ "\n}") in
17+
let full =
18+
Markdown.codeBlock ("module " ^ name ^ " = {" ^ "\n" ^ contents ^ "\n}")
19+
in
6420
let doc =
6521
match docstring with
6622
| [] -> ""
@@ -80,11 +36,62 @@ let rec showModule ~docstring ~(file : File.t) ~name
8036
| Some {item = Ident path} ->
8137
Some ("Unable to resolve module reference " ^ Path.name path)
8238

39+
type extractedType = {
40+
name: string;
41+
path: Path.t;
42+
decl: Types.type_declaration;
43+
env: SharedTypes.QueryEnv.t;
44+
loc: Warnings.loc;
45+
}
46+
47+
let findRelevantTypesFromType ~file ~package typ =
48+
(* Expand definitions of types mentioned in typ.
49+
If typ itself is a record or variant, search its body *)
50+
let env = QueryEnv.fromFile file in
51+
let envToSearch, typesToSearch =
52+
match typ |> Shared.digConstructor with
53+
| Some path -> (
54+
let labelDeclarationsTypes lds =
55+
lds |> List.map (fun (ld : Types.label_declaration) -> ld.ld_type)
56+
in
57+
match References.digConstructor ~env ~package path with
58+
| None -> (env, [typ])
59+
| Some (env1, {item = {decl}}) -> (
60+
match decl.type_kind with
61+
| Type_record (lds, _) -> (env1, typ :: (lds |> labelDeclarationsTypes))
62+
| Type_variant cds ->
63+
( env1,
64+
cds
65+
|> List.map (fun (cd : Types.constructor_declaration) ->
66+
let fromArgs =
67+
match cd.cd_args with
68+
| Cstr_tuple ts -> ts
69+
| Cstr_record lds -> lds |> labelDeclarationsTypes
70+
in
71+
typ
72+
::
73+
(match cd.cd_res with
74+
| None -> fromArgs
75+
| Some t -> t :: fromArgs))
76+
|> List.flatten )
77+
| _ -> (env, [typ])))
78+
| None -> (env, [typ])
79+
in
80+
let fromConstructorPath ~env path =
81+
match References.digConstructor ~env ~package path with
82+
| None -> None
83+
| Some (env, {name = {txt}; extentLoc; item = {decl}}) ->
84+
if Utils.isUncurriedInternal path then None
85+
else Some {name = txt; env; loc = extentLoc; decl; path}
86+
in
87+
let constructors = Shared.findTypeConstructors typesToSearch in
88+
constructors |> List.filter_map (fromConstructorPath ~env:envToSearch)
89+
8390
let newHover ~full:{file; package} ~supportsMarkdownLinks locItem =
8491
match locItem.locType with
8592
| TypeDefinition (name, decl, _stamp) ->
8693
let typeDef = Shared.declToString name decl in
87-
Some (codeBlock typeDef)
94+
Some (Markdown.codeBlock typeDef)
8895
| LModule (Definition (stamp, _tip)) | LModule (LocalReference (stamp, _tip))
8996
-> (
9097
match Stamps.findModule file.stamps stamp with
@@ -132,7 +139,7 @@ let newHover ~full:{file; package} ~supportsMarkdownLinks locItem =
132139
| Typed (_, _, Definition (_, (Field _ | Constructor _))) -> None
133140
| Constant t ->
134141
Some
135-
(codeBlock
142+
(Markdown.codeBlock
136143
(match t with
137144
| Const_int _ -> "int"
138145
| Const_char _ -> "char"
@@ -142,81 +149,25 @@ let newHover ~full:{file; package} ~supportsMarkdownLinks locItem =
142149
| Const_int64 _ -> "int64"
143150
| Const_nativeint _ -> "int"))
144151
| Typed (_, t, locKind) ->
145-
let fromConstructorPath ~env path =
146-
match References.digConstructor ~env ~package path with
147-
| None -> None
148-
| Some (env, {extentLoc; item = {decl}}) ->
149-
if Utils.isUncurriedInternal path then None
150-
else
151-
Some
152-
( decl
153-
|> Shared.declToString ~printNameAsIs:true
154-
(SharedTypes.pathIdentToString path),
155-
extentLoc,
156-
env )
157-
in
158152
let fromType ~docstring typ =
159-
let typeString = codeBlock (typ |> Shared.typeToString) in
153+
let typeString = Markdown.codeBlock (typ |> Shared.typeToString) in
154+
let types = findRelevantTypesFromType typ ~file ~package in
160155
let typeDefinitions =
161-
(* Expand definitions of types mentioned in typ.
162-
If typ itself is a record or variant, search its body *)
163-
let env = QueryEnv.fromFile file in
164-
let envToSearch, typesToSearch =
165-
match typ |> Shared.digConstructor with
166-
| Some path -> (
167-
let labelDeclarationsTypes lds =
168-
lds |> List.map (fun (ld : Types.label_declaration) -> ld.ld_type)
169-
in
170-
match References.digConstructor ~env ~package path with
171-
| None -> (env, [typ])
172-
| Some (env1, {item = {decl}}) -> (
173-
match decl.type_kind with
174-
| Type_record (lds, _) ->
175-
(env1, typ :: (lds |> labelDeclarationsTypes))
176-
| Type_variant cds ->
177-
( env1,
178-
cds
179-
|> List.map (fun (cd : Types.constructor_declaration) ->
180-
let fromArgs =
181-
match cd.cd_args with
182-
| Cstr_tuple ts -> ts
183-
| Cstr_record lds -> lds |> labelDeclarationsTypes
184-
in
185-
typ
186-
::
187-
(match cd.cd_res with
188-
| None -> fromArgs
189-
| Some t -> t :: fromArgs))
190-
|> List.flatten )
191-
| _ -> (env, [typ])))
192-
| None -> (env, [typ])
193-
in
194-
let constructors = Shared.findTypeConstructors typesToSearch in
195-
constructors
196-
|> List.filter_map (fun constructorPath ->
197-
match
198-
constructorPath |> fromConstructorPath ~env:envToSearch
199-
with
200-
| None -> None
201-
| Some (typString, extentLoc, env) ->
202-
let startLine, startCol = Pos.ofLexing extentLoc.loc_start in
203-
let linkToTypeDefinitionStr =
204-
if supportsMarkdownLinks then
205-
"\nGo to: "
206-
^ makeGotoCommand
207-
{
208-
label = "Type definition";
209-
file = Uri.toString env.file.uri;
210-
startPos = {line = startLine; character = startCol};
211-
}
212-
else ""
213-
in
214-
Some
215-
(Shared.markdownSpacing ^ codeBlock typString
216-
^ linkToTypeDefinitionStr ^ "\n\n---\n"))
156+
types
157+
|> List.map (fun {decl; env; loc; path} ->
158+
let linkToTypeDefinitionStr =
159+
if supportsMarkdownLinks then
160+
Markdown.goToDefinitionText ~env ~pos:loc.Warnings.loc_start
161+
else ""
162+
in
163+
"\n" ^ Markdown.spacing
164+
^ Markdown.codeBlock
165+
(decl
166+
|> Shared.declToString ~printNameAsIs:true
167+
(SharedTypes.pathIdentToString path))
168+
^ linkToTypeDefinitionStr ^ "\n" ^ Markdown.divider)
217169
in
218-
let typeString = typeString :: typeDefinitions |> String.concat "\n\n" in
219-
(typeString, docstring)
170+
(typeString :: typeDefinitions |> String.concat "\n", docstring)
220171
in
221172
let parts =
222173
match References.definedForLoc ~file ~package locKind with
@@ -238,9 +189,9 @@ let newHover ~full:{file; package} ~supportsMarkdownLinks locItem =
238189
|> List.map (fun (t, _) -> Shared.typeToString t)
239190
|> String.concat ", " |> Printf.sprintf "(%s)"
240191
in
241-
typeString :: codeBlock (txt ^ argsString) :: docstring
192+
typeString :: Markdown.codeBlock (txt ^ argsString) :: docstring
242193
| `Field ->
243194
let typeString, docstring = t |> fromType ~docstring in
244195
typeString :: docstring)
245196
in
246-
Some (String.concat "\n\n" parts)
197+
Some (String.concat "\n\n" parts)

‎analysis/src/Markdown.ml

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
let spacing = "\n```\n \n```\n"
2+
let codeBlock code = Printf.sprintf "```rescript\n%s\n```" code
3+
let divider = "\n---\n"
4+
5+
type link = {startPos: Protocol.position; file: string; label: string}
6+
7+
let linkToCommandArgs link =
8+
Printf.sprintf "[\"%s\",%i,%i]" link.file link.startPos.line
9+
link.startPos.character
10+
11+
let makeGotoCommand link =
12+
Printf.sprintf "[%s](command:rescript-vscode.go_to_location?%s)" link.label
13+
(Uri.encodeURIComponent (linkToCommandArgs link))
14+
15+
let goToDefinitionText ~env ~pos =
16+
let startLine, startCol = Pos.ofLexing pos in
17+
"\nGo to: "
18+
^ makeGotoCommand
19+
{
20+
label = "Type definition";
21+
file = Uri.toString env.SharedTypes.QueryEnv.file.uri;
22+
startPos = {line = startLine; character = startCol};
23+
}

‎analysis/src/Shared.ml

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -78,5 +78,3 @@ let typeToString ?lineWidth (t : Types.type_expr) =
7878
Hashtbl.replace typeTbl (t.id, t) s;
7979
s
8080
| Some s -> s
81-
82-
let markdownSpacing = "\n```\n \n```\n"

‎analysis/src/Uri.ml

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -22,3 +22,38 @@ let toTopLevelLoc {path} =
2222
{Location.loc_start = topPos; Location.loc_end = topPos; loc_ghost = false}
2323

2424
let toString {uri} = if !stripPath then Filename.basename uri else uri
25+
26+
27+
(* Light weight, hopefully-enough-for-the-purpose fn to encode URI components.
28+
Built to handle the reserved characters listed in
29+
https://en.wikipedia.org/wiki/Percent-encoding. Note that this function is not
30+
general purpose, rather it's currently only for URL encoding the argument list
31+
passed to command links in markdown. *)
32+
let encodeURIComponent text =
33+
let ln = String.length text in
34+
let buf = Buffer.create ln in
35+
let rec loop i =
36+
if i < ln then (
37+
(match text.[i] with
38+
| '"' -> Buffer.add_string buf "%22"
39+
| '\'' -> Buffer.add_string buf "%22"
40+
| ':' -> Buffer.add_string buf "%3A"
41+
| ';' -> Buffer.add_string buf "%3B"
42+
| '/' -> Buffer.add_string buf "%2F"
43+
| '\\' -> Buffer.add_string buf "%5C"
44+
| ',' -> Buffer.add_string buf "%2C"
45+
| '&' -> Buffer.add_string buf "%26"
46+
| '[' -> Buffer.add_string buf "%5B"
47+
| ']' -> Buffer.add_string buf "%5D"
48+
| '#' -> Buffer.add_string buf "%23"
49+
| '$' -> Buffer.add_string buf "%24"
50+
| '+' -> Buffer.add_string buf "%2B"
51+
| '=' -> Buffer.add_string buf "%3D"
52+
| '?' -> Buffer.add_string buf "%3F"
53+
| '@' -> Buffer.add_string buf "%40"
54+
| '%' -> Buffer.add_string buf "%25"
55+
| c -> Buffer.add_char buf c);
56+
loop (i + 1))
57+
in
58+
loop 0;
59+
Buffer.contents buf

‎analysis/src/Uri.mli

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,3 +6,4 @@ val stripPath : bool ref
66
val toPath : t -> string
77
val toString : t -> string
88
val toTopLevelLoc : t -> Location.t
9+
val encodeURIComponent : string -> string

0 commit comments

Comments
 (0)