@@ -18,11 +18,15 @@ type constructorDoc = {
18
18
items : constructorPayload option ;
19
19
}
20
20
21
+ type typeDoc = {path : string ; genericParameters : typeDoc list }
22
+ type valueSignature = {parameters : typeDoc list ; returnType : typeDoc }
23
+
21
24
type source = {filepath : string ; line : int ; col : int }
22
25
23
26
type docItemDetail =
24
27
| Record of {fieldDocs : fieldDoc list }
25
28
| Variant of {constructorDocs : constructorDoc list }
29
+ | Signature of valueSignature
26
30
27
31
type docItem =
28
32
| Value of {
@@ -31,6 +35,7 @@ type docItem =
31
35
signature : string ;
32
36
name : string ;
33
37
deprecated : string option ;
38
+ detail : docItemDetail option ;
34
39
source : source ;
35
40
}
36
41
| Type of {
@@ -104,6 +109,19 @@ let stringifyConstructorPayload ~indentation
104
109
|> array ) );
105
110
]
106
111
112
+ let rec stringifyTypeDoc ~indentation (td : typeDoc ) : string =
113
+ let open Protocol in
114
+ let ps =
115
+ match td.genericParameters with
116
+ | [] -> None
117
+ | ts ->
118
+ ts |> List. map (stringifyTypeDoc ~indentation: (indentation + 1 ))
119
+ |> fun ts -> Some (array ts)
120
+ in
121
+
122
+ stringifyObject ~indentation: (indentation + 1 )
123
+ [(" path" , Some (wrapInQuotes td.path)); (" genericTypeParameters" , ps)]
124
+
107
125
let stringifyDetail ?(indentation = 0 ) (detail : docItemDetail ) =
108
126
let open Protocol in
109
127
match detail with
@@ -147,6 +165,25 @@ let stringifyDetail ?(indentation = 0) (detail : docItemDetail) =
147
165
])
148
166
|> array ) );
149
167
]
168
+ | Signature {parameters; returnType} ->
169
+ let ps =
170
+ match parameters with
171
+ | [] -> None
172
+ | ps ->
173
+ ps |> List. map (stringifyTypeDoc ~indentation: (indentation + 1 ))
174
+ |> fun ps -> Some (array ps)
175
+ in
176
+ stringifyObject ~start OnNewline:true ~indentation
177
+ [
178
+ (" kind" , Some (wrapInQuotes " signature" ));
179
+ ( " items" ,
180
+ Some
181
+ (stringifyObject ~start OnNewline:false ~indentation
182
+ [
183
+ (" parameters" , ps);
184
+ (" returnType" , Some (stringifyTypeDoc ~indentation returnType));
185
+ ]) );
186
+ ]
150
187
151
188
let stringifySource ~indentation source =
152
189
let open Protocol in
@@ -160,7 +197,7 @@ let stringifySource ~indentation source =
160
197
let rec stringifyDocItem ?(indentation = 0 ) ~originalEnv (item : docItem ) =
161
198
let open Protocol in
162
199
match item with
163
- | Value {id; docstring; signature; name; deprecated; source} ->
200
+ | Value {id; docstring; signature; name; deprecated; source; detail } ->
164
201
stringifyObject ~start OnNewline:true ~indentation
165
202
[
166
203
(" id" , Some (wrapInQuotes id));
@@ -173,6 +210,11 @@ let rec stringifyDocItem ?(indentation = 0) ~originalEnv (item : docItem) =
173
210
(" signature" , Some (signature |> String. trim |> wrapInQuotes));
174
211
(" docstrings" , Some (stringifyDocstrings docstring));
175
212
(" source" , Some (stringifySource ~indentation: (indentation + 1 ) source));
213
+ ( " detail" ,
214
+ match detail with
215
+ | None -> None
216
+ | Some detail ->
217
+ Some (stringifyDetail ~indentation: (indentation + 1 ) detail) );
176
218
]
177
219
| Type {id; docstring; signature; name; deprecated; detail; source} ->
178
220
stringifyObject ~start OnNewline:true ~indentation
@@ -310,6 +352,60 @@ let typeDetail typ ~env ~full =
310
352
})
311
353
| _ -> None
312
354
355
+ (* split a list into two parts all the items except the last one and the last item *)
356
+ let splitLast l =
357
+ let rec splitLast ' acc = function
358
+ | [] -> failwith " splitLast: empty list"
359
+ | [x] -> (List. rev acc, x)
360
+ | x :: xs -> splitLast' (x :: acc) xs
361
+ in
362
+ splitLast' [] l
363
+
364
+ let path_to_string path =
365
+ let buf = Buffer. create 64 in
366
+ let rec aux = function
367
+ | Path. Pident id -> Buffer. add_string buf (Ident. name id)
368
+ | Path. Pdot (p , s , _ ) ->
369
+ aux p;
370
+ Buffer. add_char buf '.' ;
371
+ Buffer. add_string buf s
372
+ | Path. Papply (p1 , p2 ) ->
373
+ aux p1;
374
+ Buffer. add_char buf '(' ;
375
+ aux p2;
376
+ Buffer. add_char buf ')'
377
+ in
378
+ aux path;
379
+ Buffer. contents buf
380
+
381
+ let valueDetail (typ : Types.type_expr ) =
382
+ let rec collectSignatureTypes (typ_desc : Types.type_desc ) =
383
+ match typ_desc with
384
+ | Tlink t | Tsubst t | Tpoly (t , [] ) -> collectSignatureTypes t.desc
385
+ | Tconstr (Path. Pident {name = "function$" } , [t ; _ ], _ ) ->
386
+ collectSignatureTypes t.desc
387
+ | Tconstr (path , ts , _ ) -> (
388
+ let p = path_to_string path in
389
+ match ts with
390
+ | [] -> [{path = p; genericParameters = [] }]
391
+ | ts ->
392
+ let ts =
393
+ ts
394
+ |> List. concat_map (fun (t : Types.type_expr ) ->
395
+ collectSignatureTypes t.desc)
396
+ in
397
+ [{path = p; genericParameters = ts}])
398
+ | Tarrow (_ , t1 , t2 , _ ) ->
399
+ collectSignatureTypes t1.desc @ collectSignatureTypes t2.desc
400
+ | Tvar None -> [{path = " _" ; genericParameters = [] }]
401
+ | _ -> []
402
+ in
403
+ match collectSignatureTypes typ.desc with
404
+ | [] -> None
405
+ | ts ->
406
+ let parameters, returnType = splitLast ts in
407
+ Some (Signature {parameters; returnType})
408
+
313
409
let makeId modulePath ~identifier =
314
410
identifier :: modulePath |> List. rev |> SharedTypes. ident
315
411
@@ -398,6 +494,7 @@ let extractDocs ~entryPointFile ~debug =
398
494
^ Shared. typeToString typ;
399
495
name = item.name;
400
496
deprecated = item.deprecated;
497
+ detail = valueDetail typ;
401
498
source;
402
499
})
403
500
| Type (typ , _ ) ->
0 commit comments