Skip to content

Commit 1b6ce4d

Browse files
zthGabriel Nordeborn
zth
authored and
Gabriel Nordeborn
committed
basic doc extraction
1 parent b776f70 commit 1b6ce4d

File tree

8 files changed

+394
-14
lines changed

8 files changed

+394
-14
lines changed

‎analysis/src/Cli.ml

Lines changed: 1 addition & 0 deletions
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; line; col; currentFile] ->
124125
Commands.codeAction ~path
125126
~pos:(int_of_string line, int_of_string col)

‎analysis/src/Commands.ml

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -343,6 +343,9 @@ let test ~path =
343343
let currentFile = createCurrentFile () in
344344
signatureHelp ~path ~pos:(line, col) ~currentFile ~debug:true;
345345
Sys.remove currentFile
346+
| "dex" ->
347+
print_endline ("Documentation extraction " ^ path);
348+
DocExtraction.extractDocs ~path ~debug:true
346349
| "int" ->
347350
print_endline ("Create Interface " ^ path);
348351
let cmiFile =

‎analysis/src/DocExtraction.ml

Lines changed: 179 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,179 @@
1+
let formatCode content =
2+
let {Res_driver.parsetree = signature; comments} =
3+
Res_driver.parseInterfaceFromSource ~forPrinter:true
4+
~displayFilename:"<missing-file>" ~source:content
5+
in
6+
Res_printer.printInterface ~width:!Res_cli.ResClflags.width ~comments
7+
signature
8+
|> String.trim
9+
10+
type docItemDetail =
11+
| Record of {fieldDocs: (string * string list) list}
12+
| Variant of {constructorDocs: (string * string list) list}
13+
type docItem =
14+
| Value of {docstring: string list; signature: string; name: string}
15+
| Type of {
16+
docstring: string list;
17+
signature: string;
18+
name: string;
19+
detail: docItemDetail option;
20+
}
21+
| Module of docsForModule
22+
and docsForModule = {docstring: string list; name: string; items: docItem list}
23+
24+
let stringifyDocstrings docstrings =
25+
let open Protocol in
26+
docstrings
27+
|> List.map (fun docstring ->
28+
docstring |> String.trim |> Json.escape |> wrapInQuotes)
29+
|> array
30+
31+
let stringifyDetail ?(indentation = 0) (detail : docItemDetail) =
32+
let open Protocol in
33+
match detail with
34+
| Record {fieldDocs} ->
35+
stringifyObject ~startOnNewline:true ~indentation
36+
[
37+
("kind", Some (wrapInQuotes "record"));
38+
( "fieldDocs",
39+
Some
40+
(fieldDocs
41+
|> List.map (fun (fieldName, docstrings) ->
42+
stringifyObject ~indentation:(indentation + 1)
43+
[
44+
("fieldName", Some (wrapInQuotes fieldName));
45+
("docstrings", Some (stringifyDocstrings docstrings));
46+
])
47+
|> array) );
48+
]
49+
| Variant {constructorDocs} ->
50+
stringifyObject ~startOnNewline:true ~indentation
51+
[
52+
("kind", Some (wrapInQuotes "variant"));
53+
( "fieldDocs",
54+
Some
55+
(constructorDocs
56+
|> List.map (fun (constructorName, docstrings) ->
57+
stringifyObject ~startOnNewline:true
58+
~indentation:(indentation + 1)
59+
[
60+
("constructorName", Some (wrapInQuotes constructorName));
61+
("docstrings", Some (stringifyDocstrings docstrings));
62+
])
63+
|> array) );
64+
]
65+
66+
let rec stringifyDocItem ?(indentation = 0) (item : docItem) =
67+
let open Protocol in
68+
match item with
69+
| Value {docstring; signature; name} ->
70+
stringifyObject ~startOnNewline:true ~indentation
71+
[
72+
("kind", Some (wrapInQuotes "value"));
73+
("name", Some (name |> Json.escape |> wrapInQuotes));
74+
( "signature",
75+
Some (signature |> String.trim |> Json.escape |> wrapInQuotes) );
76+
("docstrings", Some (stringifyDocstrings docstring));
77+
]
78+
| Type {docstring; signature; name; detail} ->
79+
stringifyObject ~startOnNewline:true ~indentation
80+
[
81+
("kind", Some (wrapInQuotes "type"));
82+
("name", Some (name |> Json.escape |> wrapInQuotes));
83+
("signature", Some (signature |> Json.escape |> wrapInQuotes));
84+
("docstrings", Some (stringifyDocstrings docstring));
85+
( "detail",
86+
match detail with
87+
| None -> None
88+
| Some detail ->
89+
Some (stringifyDetail ~indentation:(indentation + 1) detail) );
90+
]
91+
| Module m ->
92+
stringifyObject ~startOnNewline:true ~indentation
93+
[
94+
("kind", Some (wrapInQuotes "module"));
95+
("item", Some (stringifyDocsForModule ~indentation:(indentation + 1) m));
96+
]
97+
98+
and stringifyDocsForModule ?(indentation = 0) (d : docsForModule) =
99+
let open Protocol in
100+
stringifyObject ~startOnNewline:true ~indentation
101+
[
102+
("name", Some (wrapInQuotes d.name));
103+
("docstrings", Some (stringifyDocstrings d.docstring));
104+
( "items",
105+
Some
106+
(d.items
107+
|> List.map (stringifyDocItem ~indentation:(indentation + 1))
108+
|> array) );
109+
]
110+
111+
let extractDocs ~path ~debug =
112+
if debug then Printf.printf "extracting docs for %s\n" path;
113+
match Cmt.loadFullCmtFromPath ~path with
114+
| None -> ()
115+
| Some full ->
116+
let file = full.file in
117+
let structure = file.structure in
118+
let env = SharedTypes.QueryEnv.fromFile file in
119+
let rec extractDocs (structure : SharedTypes.Module.structure) =
120+
{
121+
docstring = structure.docstring |> List.map String.trim;
122+
name = structure.name;
123+
items =
124+
structure.items
125+
|> List.filter_map (fun (item : SharedTypes.Module.item) ->
126+
match item.kind with
127+
| Value typ ->
128+
Some
129+
(Value
130+
{
131+
docstring = item.docstring |> List.map String.trim;
132+
signature =
133+
"let " ^ item.name ^ ": " ^ Shared.typeToString typ
134+
|> formatCode;
135+
name = item.name;
136+
})
137+
| Type (typ, _) ->
138+
Some
139+
(Type
140+
{
141+
docstring = item.docstring |> List.map String.trim;
142+
signature =
143+
typ.decl
144+
|> Shared.declToString item.name
145+
|> formatCode;
146+
name = item.name;
147+
detail =
148+
(match
149+
TypeUtils.extractTypeFromResolvedType ~env ~full
150+
typ
151+
with
152+
| Some (Trecord {fields}) ->
153+
Some
154+
(Record
155+
{
156+
fieldDocs =
157+
fields
158+
|> List.map
159+
(fun (field : SharedTypes.field) ->
160+
(field.fname.txt, field.docstring));
161+
})
162+
| Some (Tvariant {constructors}) ->
163+
Some
164+
(Variant
165+
{
166+
constructorDocs =
167+
constructors
168+
|> List.map
169+
(fun (c : SharedTypes.Constructor.t)
170+
-> (c.cname.txt, c.docstring));
171+
})
172+
| _ -> None);
173+
})
174+
| Module (Structure m) -> Some (Module (extractDocs m))
175+
| _ -> None);
176+
}
177+
in
178+
let docs = extractDocs structure in
179+
print_endline (stringifyDocsForModule docs)

‎analysis/src/ProcessCmt.ml

Lines changed: 62 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -54,7 +54,13 @@ let rec forTypeSignatureItem ~(env : SharedTypes.Env.t) ~(exported : Exported.t)
5454
newDeclared
5555
| _ -> declared
5656
in
57-
[{Module.kind = Module.Value declared.item; name = declared.name.txt}]
57+
[
58+
{
59+
Module.kind = Module.Value declared.item;
60+
name = declared.name.txt;
61+
docstring = declared.docstring;
62+
};
63+
]
5864
| Sig_type
5965
( ident,
6066
({type_loc; type_kind; type_manifest; type_attributes} as decl),
@@ -121,7 +127,13 @@ let rec forTypeSignatureItem ~(env : SharedTypes.Env.t) ~(exported : Exported.t)
121127
(Exported.add exported Exported.Type)
122128
Stamps.addType
123129
in
124-
[{Module.kind = Type (declared.item, recStatus); name = declared.name.txt}]
130+
[
131+
{
132+
Module.kind = Type (declared.item, recStatus);
133+
name = declared.name.txt;
134+
docstring = declared.docstring;
135+
};
136+
]
125137
| Sig_module (ident, {md_type; md_attributes; md_loc}, _) ->
126138
let name = Ident.name ident in
127139
let declared =
@@ -132,7 +144,13 @@ let rec forTypeSignatureItem ~(env : SharedTypes.Env.t) ~(exported : Exported.t)
132144
(Exported.add exported Exported.Module)
133145
Stamps.addModule
134146
in
135-
[{Module.kind = Module declared.item; name = declared.name.txt}]
147+
[
148+
{
149+
Module.kind = Module declared.item;
150+
name = declared.name.txt;
151+
docstring = declared.docstring;
152+
};
153+
]
136154
| _ -> []
137155

138156
and forTypeSignature ~name ~env signature =
@@ -293,6 +311,7 @@ let forTypeDeclaration ~env ~(exported : Exported.t)
293311
{
294312
Module.kind = Module.Type (declared.item, recStatus);
295313
name = declared.name.txt;
314+
docstring = declared.docstring;
296315
}
297316

298317
let rec forSignatureItem ~env ~(exported : Exported.t)
@@ -306,7 +325,13 @@ let rec forSignatureItem ~env ~(exported : Exported.t)
306325
(Exported.add exported Exported.Value)
307326
Stamps.addValue
308327
in
309-
[{Module.kind = Module.Value declared.item; name = declared.name.txt}]
328+
[
329+
{
330+
Module.kind = Module.Value declared.item;
331+
name = declared.name.txt;
332+
docstring = declared.docstring;
333+
};
334+
]
310335
| Tsig_type (recFlag, decls) ->
311336
decls
312337
|> List.mapi (fun i decl ->
@@ -330,7 +355,13 @@ let rec forSignatureItem ~env ~(exported : Exported.t)
330355
(Exported.add exported Exported.Module)
331356
Stamps.addModule
332357
in
333-
[{Module.kind = Module declared.item; name = declared.name.txt}]
358+
[
359+
{
360+
Module.kind = Module declared.item;
361+
name = declared.name.txt;
362+
docstring = declared.docstring;
363+
};
364+
]
334365
| Tsig_recmodule modDecls ->
335366
modDecls
336367
|> List.map (fun modDecl ->
@@ -400,7 +431,11 @@ let rec forStructureItem ~env ~(exported : Exported.t) item =
400431
Stamps.addValue
401432
in
402433
items :=
403-
{Module.kind = Module.Value declared.item; name = declared.name.txt}
434+
{
435+
Module.kind = Module.Value declared.item;
436+
name = declared.name.txt;
437+
docstring = declared.docstring;
438+
}
404439
:: !items
405440
| Tpat_tuple pats | Tpat_array pats | Tpat_construct (_, _, pats) ->
406441
pats |> List.iter (fun p -> handlePattern [] p)
@@ -429,7 +464,13 @@ let rec forStructureItem ~env ~(exported : Exported.t) item =
429464
(Exported.add exported Exported.Module)
430465
Stamps.addModule
431466
in
432-
[{Module.kind = Module declared.item; name = declared.name.txt}]
467+
[
468+
{
469+
Module.kind = Module declared.item;
470+
name = declared.name.txt;
471+
docstring = declared.docstring;
472+
};
473+
]
433474
| Tstr_recmodule modDecls ->
434475
modDecls
435476
|> List.map (fun modDecl ->
@@ -453,7 +494,13 @@ let rec forStructureItem ~env ~(exported : Exported.t) item =
453494
(Exported.add exported Exported.Module)
454495
Stamps.addModule
455496
in
456-
[{Module.kind = Module modTypeItem; name = declared.name.txt}]
497+
[
498+
{
499+
Module.kind = Module modTypeItem;
500+
name = declared.name.txt;
501+
docstring = declared.docstring;
502+
};
503+
]
457504
| Tstr_include {incl_mod; incl_type} ->
458505
let env =
459506
match getModulePath incl_mod.mod_desc with
@@ -475,7 +522,13 @@ let rec forStructureItem ~env ~(exported : Exported.t) item =
475522
(Exported.add exported Exported.Value)
476523
Stamps.addValue
477524
in
478-
[{Module.kind = Value declared.item; name = declared.name.txt}]
525+
[
526+
{
527+
Module.kind = Value declared.item;
528+
name = declared.name.txt;
529+
docstring = declared.docstring;
530+
};
531+
]
479532
| Tstr_type (recFlag, decls) ->
480533
decls
481534
|> List.mapi (fun i decl ->

‎analysis/src/Protocol.ml

Lines changed: 7 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -98,16 +98,19 @@ let stringifyMarkupContent (m : markupContent) =
9898
Printf.sprintf {|{"kind": "%s", "value": "%s"}|} m.kind (Json.escape m.value)
9999

100100
(** None values are not emitted in the output. *)
101-
let stringifyObject properties =
102-
{|{
101+
let stringifyObject ?(startOnNewline = false) ?(indentation = 1) properties =
102+
let indentationStr = String.make (indentation * 2) ' ' in
103+
(if startOnNewline then "\n" ^ indentationStr else "")
104+
^ {|{
103105
|}
104106
^ (properties
105107
|> List.filter_map (fun (key, value) ->
106108
match value with
107109
| None -> None
108-
| Some v -> Some (Printf.sprintf {| "%s": %s|} key v))
110+
| Some v ->
111+
Some (Printf.sprintf {|%s "%s": %s|} indentationStr key v))
109112
|> String.concat ",\n")
110-
^ "\n }"
113+
^ "\n" ^ indentationStr ^ "}"
111114

112115
let wrapInQuotes s = "\"" ^ Json.escape s ^ "\""
113116

‎analysis/src/SharedTypes.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -122,7 +122,7 @@ module Module = struct
122122
| Type of Type.t * Types.rec_status
123123
| Module of t
124124

125-
and item = {kind: kind; name: string}
125+
and item = {kind: kind; name: string; docstring: string list}
126126

127127
and structure = {
128128
name: string;

0 commit comments

Comments
 (0)