Skip to content

Commit 5c05b17

Browse files
zthaspeddro
zth
and
aspeddro
authored
[PoC] Doc extraction (#732)
* basic doc extraction * basic extraction of linkables * prefer resi file when available, and prefer module signature vs impl * temporary command for extracting docs * add id:s and signatures for constructors/record fields * produce what id to link to in linkables * linkables in constructor and record field details * fix linkable link ids * field name, and fix double escaping * remove linkables concept * support extracting module aliases * first tests * update tests * remove location field * only emit deprecated * remove location field * add module name field (#819) * [DocGen]: Rename key `item` -> `items` (#821) * rename to items * update tests * docgen: convert items to array (#822) * [DocGen]: Polish (#796) * emit items from module alias * add error msg * rename fields * remove double name field * add ocaml.text attr * search for all attrs * fix id module * update tests * emit valid id path * update tests * docgen: polish (#825) --------- Co-authored-by: Pedro Castro <aspeddro@gmail.com>
1 parent 28e1957 commit 5c05b17

15 files changed

+823
-21
lines changed

‎analysis/src/Cli.ml

+1
Original file line numberDiff line numberDiff line change
@@ -120,6 +120,7 @@ let main () =
120120
~pos:(int_of_string line_start, int_of_string line_end)
121121
~maxLength ~debug:false
122122
| [_; "codeLens"; path] -> Commands.codeLens ~path ~debug:false
123+
| [_; "extractDocs"; path] -> DocExtraction.extractDocs ~path ~debug:false
123124
| [_; "codeAction"; path; startLine; startCol; endLine; endCol; currentFile]
124125
->
125126
Commands.codeAction ~path

‎analysis/src/Commands.ml

+3
Original file line numberDiff line numberDiff line change
@@ -345,6 +345,9 @@ let test ~path =
345345
let currentFile = createCurrentFile () in
346346
signatureHelp ~path ~pos:(line, col) ~currentFile ~debug:true;
347347
Sys.remove currentFile
348+
| "dex" ->
349+
print_endline ("Documentation extraction " ^ path);
350+
DocExtraction.extractDocs ~path ~debug:true
348351
| "int" ->
349352
print_endline ("Create Interface " ^ path);
350353
let cmiFile =

‎analysis/src/DocExtraction.ml

+347
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,347 @@
1+
type fieldDoc = {
2+
fieldName: string;
3+
docstrings: string list;
4+
signature: string;
5+
optional: bool;
6+
deprecated: string option;
7+
}
8+
9+
type constructorDoc = {
10+
constructorName: string;
11+
docstrings: string list;
12+
signature: string;
13+
deprecated: string option;
14+
}
15+
16+
type docItemDetail =
17+
| Record of {fieldDocs: fieldDoc list}
18+
| Variant of {constructorDocs: constructorDoc list}
19+
type docItem =
20+
| Value of {
21+
id: string;
22+
docstring: string list;
23+
signature: string;
24+
name: string;
25+
deprecated: string option;
26+
}
27+
| Type of {
28+
id: string;
29+
docstring: string list;
30+
signature: string;
31+
name: string;
32+
deprecated: string option;
33+
detail: docItemDetail option;
34+
(** Additional documentation for constructors and record fields, if available. *)
35+
}
36+
| Module of docsForModule
37+
| ModuleAlias of {
38+
id: string;
39+
docstring: string list;
40+
name: string;
41+
items: docItem list;
42+
}
43+
and docsForModule = {
44+
id: string;
45+
docstring: string list;
46+
deprecated: string option;
47+
name: string;
48+
items: docItem list;
49+
}
50+
51+
let formatCode content =
52+
let {Res_driver.parsetree = signature; comments} =
53+
Res_driver.parseInterfaceFromSource ~forPrinter:true
54+
~displayFilename:"<missing-file>" ~source:content
55+
in
56+
Res_printer.printInterface ~width:!Res_cli.ResClflags.width ~comments
57+
signature
58+
|> String.trim
59+
60+
let stringifyDocstrings docstrings =
61+
let open Protocol in
62+
docstrings
63+
|> List.map (fun docstring -> docstring |> String.trim |> wrapInQuotes)
64+
|> array
65+
66+
let stringifyDetail ?(indentation = 0) (detail : docItemDetail) =
67+
let open Protocol in
68+
match detail with
69+
| Record {fieldDocs} ->
70+
stringifyObject ~startOnNewline:true ~indentation
71+
[
72+
("kind", Some (wrapInQuotes "record"));
73+
( "items",
74+
Some
75+
(fieldDocs
76+
|> List.map (fun fieldDoc ->
77+
stringifyObject ~indentation:(indentation + 1)
78+
[
79+
("name", Some (wrapInQuotes fieldDoc.fieldName));
80+
( "deprecated",
81+
match fieldDoc.deprecated with
82+
| Some d -> Some (wrapInQuotes d)
83+
| None -> None );
84+
("optional", Some (string_of_bool fieldDoc.optional));
85+
( "docstrings",
86+
Some (stringifyDocstrings fieldDoc.docstrings) );
87+
("signature", Some (wrapInQuotes fieldDoc.signature));
88+
])
89+
|> array) );
90+
]
91+
| Variant {constructorDocs} ->
92+
stringifyObject ~startOnNewline:true ~indentation
93+
[
94+
("kind", Some (wrapInQuotes "variant"));
95+
( "items",
96+
Some
97+
(constructorDocs
98+
|> List.map (fun constructorDoc ->
99+
stringifyObject ~startOnNewline:true
100+
~indentation:(indentation + 1)
101+
[
102+
( "name",
103+
Some (wrapInQuotes constructorDoc.constructorName) );
104+
( "deprecated",
105+
match constructorDoc.deprecated with
106+
| Some d -> Some (wrapInQuotes d)
107+
| None -> None );
108+
( "docstrings",
109+
Some (stringifyDocstrings constructorDoc.docstrings) );
110+
( "signature",
111+
Some (wrapInQuotes constructorDoc.signature) );
112+
])
113+
|> array) );
114+
]
115+
116+
let rec stringifyDocItem ?(indentation = 0) ~originalEnv (item : docItem) =
117+
let open Protocol in
118+
match item with
119+
| Value {id; docstring; signature; name; deprecated} ->
120+
stringifyObject ~startOnNewline:true ~indentation
121+
[
122+
("id", Some (wrapInQuotes id));
123+
("kind", Some (wrapInQuotes "value"));
124+
("name", Some (name |> Json.escape |> wrapInQuotes));
125+
( "deprecated",
126+
match deprecated with
127+
| Some d -> Some (wrapInQuotes d)
128+
| None -> None );
129+
( "signature",
130+
Some (signature |> String.trim |> Json.escape |> wrapInQuotes) );
131+
("docstrings", Some (stringifyDocstrings docstring));
132+
]
133+
| Type {id; docstring; signature; name; deprecated; detail} ->
134+
stringifyObject ~startOnNewline:true ~indentation
135+
[
136+
("id", Some (wrapInQuotes id));
137+
("kind", Some (wrapInQuotes "type"));
138+
("name", Some (name |> Json.escape |> wrapInQuotes));
139+
( "deprecated",
140+
match deprecated with
141+
| Some d -> Some (wrapInQuotes d)
142+
| None -> None );
143+
("signature", Some (signature |> Json.escape |> wrapInQuotes));
144+
("docstrings", Some (stringifyDocstrings docstring));
145+
( "detail",
146+
match detail with
147+
| None -> None
148+
| Some detail ->
149+
Some (stringifyDetail ~indentation:(indentation + 1) detail) );
150+
]
151+
| Module m ->
152+
stringifyObject ~startOnNewline:true ~indentation
153+
[
154+
("id", Some (wrapInQuotes m.id));
155+
("name", Some (wrapInQuotes m.name));
156+
("kind", Some (wrapInQuotes "module"));
157+
( "items",
158+
Some
159+
(m.items
160+
|> List.map
161+
(stringifyDocItem ~originalEnv ~indentation:(indentation + 1))
162+
|> array) );
163+
]
164+
| ModuleAlias m ->
165+
stringifyObject ~startOnNewline:true ~indentation
166+
[
167+
("id", Some (wrapInQuotes m.id));
168+
("kind", Some (wrapInQuotes "moduleAlias"));
169+
("name", Some (wrapInQuotes m.name));
170+
("docstrings", Some (stringifyDocstrings m.docstring));
171+
( "items",
172+
Some
173+
(m.items
174+
|> List.map
175+
(stringifyDocItem ~originalEnv ~indentation:(indentation + 1))
176+
|> array) );
177+
]
178+
179+
and stringifyDocsForModule ?(indentation = 0) ~originalEnv (d : docsForModule) =
180+
let open Protocol in
181+
stringifyObject ~startOnNewline:true ~indentation
182+
[
183+
("name", Some (wrapInQuotes d.name));
184+
( "deprecated",
185+
match d.deprecated with
186+
| Some d -> Some (wrapInQuotes d)
187+
| None -> None );
188+
("docstrings", Some (stringifyDocstrings d.docstring));
189+
( "items",
190+
Some
191+
(d.items
192+
|> List.map
193+
(stringifyDocItem ~originalEnv ~indentation:(indentation + 1))
194+
|> array) );
195+
]
196+
197+
let typeDetail typ ~env ~full =
198+
let open SharedTypes in
199+
match TypeUtils.extractTypeFromResolvedType ~env ~full typ with
200+
| Some (Trecord {fields}) ->
201+
Some
202+
(Record
203+
{
204+
fieldDocs =
205+
fields
206+
|> List.map (fun (field : field) ->
207+
{
208+
fieldName = field.fname.txt;
209+
docstrings = field.docstring;
210+
optional = field.optional;
211+
signature = Shared.typeToString field.typ;
212+
deprecated = field.deprecated;
213+
});
214+
})
215+
| Some (Tvariant {constructors}) ->
216+
Some
217+
(Variant
218+
{
219+
constructorDocs =
220+
constructors
221+
|> List.map (fun (c : Constructor.t) ->
222+
{
223+
constructorName = c.cname.txt;
224+
docstrings = c.docstring;
225+
signature = CompletionBackEnd.showConstructor c;
226+
deprecated = c.deprecated;
227+
});
228+
})
229+
| _ -> None
230+
231+
let makeId modulePath ~identifier =
232+
identifier :: modulePath |> List.rev |> SharedTypes.ident
233+
234+
let extractDocs ~path ~debug =
235+
if debug then Printf.printf "extracting docs for %s\n" path;
236+
if
237+
FindFiles.isImplementation path = false
238+
&& FindFiles.isInterface path = false
239+
then (
240+
Printf.eprintf "error: failed to read %s, expected an .res or .resi file\n"
241+
path;
242+
exit 1);
243+
let path =
244+
if FindFiles.isImplementation path then
245+
let pathAsResi =
246+
(path |> Filename.dirname) ^ "/"
247+
^ (path |> Filename.basename |> Filename.chop_extension)
248+
^ ".resi"
249+
in
250+
if Sys.file_exists pathAsResi then (
251+
if debug then
252+
Printf.printf "preferring found resi file for impl: %s\n" pathAsResi;
253+
pathAsResi)
254+
else path
255+
else path
256+
in
257+
match Cmt.loadFullCmtFromPath ~path with
258+
| None ->
259+
Printf.eprintf
260+
"error: failed to generate doc for %s, try to build the project\n" path;
261+
exit 1
262+
| Some full ->
263+
let file = full.file in
264+
let structure = file.structure in
265+
let open SharedTypes in
266+
let env = QueryEnv.fromFile file in
267+
let rec extractDocsForModule ?(modulePath = [env.file.moduleName])
268+
(structure : Module.structure) =
269+
{
270+
id = modulePath |> List.rev |> ident;
271+
docstring = structure.docstring |> List.map String.trim;
272+
name = structure.name;
273+
deprecated = structure.deprecated;
274+
items =
275+
structure.items
276+
|> List.filter_map (fun (item : Module.item) ->
277+
match item.kind with
278+
| Value typ ->
279+
Some
280+
(Value
281+
{
282+
id = modulePath |> makeId ~identifier:item.name;
283+
docstring = item.docstring |> List.map String.trim;
284+
signature =
285+
"let " ^ item.name ^ ": " ^ Shared.typeToString typ
286+
|> formatCode;
287+
name = item.name;
288+
deprecated = item.deprecated;
289+
})
290+
| Type (typ, _) ->
291+
Some
292+
(Type
293+
{
294+
id = modulePath |> makeId ~identifier:item.name;
295+
docstring = item.docstring |> List.map String.trim;
296+
signature =
297+
typ.decl
298+
|> Shared.declToString item.name
299+
|> formatCode;
300+
name = item.name;
301+
deprecated = item.deprecated;
302+
detail = typeDetail typ ~full ~env;
303+
})
304+
| Module (Ident p) ->
305+
(* module Whatever = OtherModule *)
306+
let aliasToModule = p |> pathIdentToString in
307+
let id =
308+
(modulePath |> List.rev |> List.hd) ^ "." ^ item.name
309+
in
310+
let items =
311+
match
312+
ProcessCmt.fileForModule ~package:full.package
313+
aliasToModule
314+
with
315+
| None -> []
316+
| Some file ->
317+
let docs =
318+
extractDocsForModule ~modulePath:[id] file.structure
319+
in
320+
docs.items
321+
in
322+
Some
323+
(ModuleAlias
324+
{
325+
id;
326+
name = item.name;
327+
items;
328+
docstring = item.docstring |> List.map String.trim;
329+
})
330+
| Module (Structure m) ->
331+
(* module Whatever = {} in res or module Whatever: {} in resi. *)
332+
Some
333+
(Module
334+
(extractDocsForModule ~modulePath:(m.name :: modulePath)
335+
m))
336+
| Module (Constraint (Structure _impl, Structure interface)) ->
337+
(* module Whatever: { <interface> } = { <impl> }. Prefer the interface. *)
338+
Some
339+
(Module
340+
(extractDocsForModule
341+
~modulePath:(interface.name :: modulePath)
342+
interface))
343+
| _ -> None);
344+
}
345+
in
346+
let docs = extractDocsForModule structure in
347+
print_endline (stringifyDocsForModule ~originalEnv:env docs)

‎analysis/src/ProcessAttributes.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ let rec findDocAttribute attributes =
55
let open Parsetree in
66
match attributes with
77
| [] -> None
8-
| ( {Asttypes.txt = "ocaml.doc" | "ns.doc" | "res.doc"},
8+
| ( {Asttypes.txt = "ocaml.doc" | "ocaml.text" | "ns.doc" | "res.doc"},
99
PStr
1010
[
1111
{

0 commit comments

Comments
 (0)