this repo has no description
Squashed 'odoc/' changes from 5629c8d5..4095c1af
4095c1af Constrain lwt < 6.1.0 (6.1.1 incompatible with oxcaml)
47c161ce Minor updates
1f56d069 Better source rendering
56c34e9a test: update json_expansion_with_sources test for pos_of_loc fix
825790c5 feat: add open/include tracking to source linking
77fbf3d4 feat: add record field references to source linking
dd8d0182 feat: add constructor references to source linking
8e072559 feat: re-enable documentation links from source code
21091826 fix: correct pos_of_loc end position in source annotations
git-subtree-dir: odoc
git-subtree-split: 4095c1afe288e6bf73c4ba8006cbc67d543913a7
+170
-26
+6
-1
doc/odoc-parser/index.mld
+6
-1
doc/odoc-parser/index.mld
+5
doc/sherlodoc/index.mld
+5
doc/sherlodoc/index.mld
+1
-1
sherlodoc.opam
+1
-1
sherlodoc.opam
+7
-12
src/document/generator.ml
+7
-12
src/document/generator.ml
···
265
265
266
266
let to_link { Lang.Source_info.documentation; implementation } =
267
267
let documentation =
268
-
(* Since documentation link are not rendered, we comment the code to
269
-
extract the href, and always output [None] *)
270
-
ignore documentation;
271
-
None
272
-
(* let open Paths.Path.Resolved in *)
273
-
(* match documentation with *)
274
-
(* | Some (`Resolved p) when not (is_hidden (p :> t)) -> ( *)
275
-
(* let id = identifier (p :> t) in *)
276
-
(* match Url.from_identifier ~stop_before:false id with *)
277
-
(* | Ok link -> Some link *)
278
-
(* | _ -> None) *)
279
-
(* | _ -> None *)
268
+
match documentation with
269
+
| Some (`Resolved p) when not (Paths.Path.Resolved.is_hidden (p :> Paths.Path.Resolved.t)) -> (
270
+
match Paths.Path.Resolved.identifier (p :> Paths.Path.Resolved.t) with
271
+
| Some id ->
272
+
Some (Url.from_identifier ~stop_before:false id)
273
+
| None -> None)
274
+
| _ -> None
280
275
in
281
276
let implementation =
282
277
match implementation with
+53
-10
src/loader/implementation.cppo.ml
+53
-10
src/loader/implementation.cppo.ml
···
14
14
pos_lnum = loc.loc_start.pos_lnum
15
15
} ;
16
16
loc_end = {
17
-
pos_cnum = loc.loc_start.pos_cnum ;
18
-
pos_lnum = loc.loc_start.pos_lnum
17
+
pos_cnum = loc.loc_end.pos_cnum ;
18
+
pos_lnum = loc.loc_end.pos_lnum
19
19
}
20
20
}
21
21
···
300
300
301
301
(* Extract [Typedtree_traverse] occurrence information and turn them into proper
302
302
source infos *)
303
-
let process_occurrences env poses loc_to_id local_ident_to_loc =
303
+
let rec read_module_path_fallback ~root p =
304
+
let open Odoc_model.Names in
305
+
match (p : Path.t) with
306
+
| Pident id -> `Dot (`Root (ModuleName.make_std root), ModuleName.make_std (Ident.name id))
307
+
| Pdot (p, s) -> `Dot (read_module_path_fallback ~root p, ModuleName.make_std s)
308
+
| Papply (p, arg) -> `Apply (read_module_path_fallback ~root p, read_module_path_fallback ~root arg)
309
+
#if OCAML_VERSION >= (5,1,0)
310
+
| Pextra_ty _ -> assert false
311
+
#endif
312
+
313
+
let process_occurrences ~module_name env poses loc_to_id local_ident_to_loc =
304
314
let open Odoc_model.Lang.Source_info in
305
315
(* Ensure source infos are not repeated by putting them in a Set (a unit hashtbl) *)
306
316
let occ_tbl = AnnotHashtbl.create 100 in
307
-
let process p find_in_env =
317
+
let fallback_read_value p =
318
+
let open Odoc_model.Names in
319
+
match (p : Path.t) with
320
+
| Pdot (parent, s) -> Some (`DotV (read_module_path_fallback ~root:module_name parent, ValueName.make_std s))
321
+
| _ -> None
322
+
in
323
+
let fallback_read_module p =
324
+
Some (read_module_path_fallback ~root:module_name p)
325
+
in
326
+
let fallback_read_module_type p =
327
+
let open Odoc_model.Names in
328
+
match (p : Path.t) with
329
+
| Pdot (parent, s) -> Some (`DotMT (read_module_path_fallback ~root:module_name parent, ModuleTypeName.make_std s))
330
+
| _ -> None
331
+
in
332
+
let fallback_read_type p =
333
+
let open Odoc_model.Names in
334
+
match (p : Path.t) with
335
+
| Pdot (parent, s) -> Some (`DotT (read_module_path_fallback ~root:module_name parent, TypeName.make_std s))
336
+
| _ -> None
337
+
in
338
+
let process p find_in_env fallback =
308
339
match p with
309
340
| Path.Pident id when IdentHashtbl.mem local_ident_to_loc id -> (
310
341
match
···
321
352
let documentation = if is_persistent p then Some path else None
322
353
and implementation = Some (Unresolved path) in
323
354
Some { documentation; implementation }
324
-
| exception _ -> None)
355
+
| exception _ ->
356
+
if not (is_persistent p) then
357
+
match fallback p with
358
+
| Some path ->
359
+
let documentation = None
360
+
and implementation = Some (Unresolved path) in
361
+
Some { documentation; implementation }
362
+
| None -> None
363
+
else None)
325
364
in
326
365
List.iter
327
366
(function
328
367
| Typedtree_traverse.Analysis.Value p, loc ->
329
-
process p Ident_env.Path.read_value
368
+
process p Ident_env.Path.read_value fallback_read_value
330
369
|> Option.iter @@ fun l ->
331
370
AnnotHashtbl.replace occ_tbl (Value l, pos_of_loc loc) ()
332
371
| Module p, loc ->
333
-
process p Ident_env.Path.read_module
372
+
process p Ident_env.Path.read_module fallback_read_module
334
373
|> Option.iter @@ fun l ->
335
374
AnnotHashtbl.replace occ_tbl (Module l, pos_of_loc loc) ()
336
375
| ModuleType p, loc ->
337
-
process p Ident_env.Path.read_module_type
376
+
process p Ident_env.Path.read_module_type fallback_read_module_type
338
377
|> Option.iter @@ fun l ->
339
378
AnnotHashtbl.replace occ_tbl (ModuleType l, pos_of_loc loc) ()
340
379
| Type p, loc ->
341
-
process p Ident_env.Path.read_type
380
+
process p Ident_env.Path.read_type fallback_read_type
342
381
|> Option.iter @@ fun l ->
343
382
AnnotHashtbl.replace occ_tbl (Type l, pos_of_loc loc) ()
344
383
| LocalDefinition _, _ -> ())
···
378
417
local_ident_to_loc;
379
418
populate_global_defs env source_id loc_to_id uid_to_loc uid_to_id
380
419
in
420
+
let module_name =
421
+
Odoc_model.Root.Odoc_file.name root.Odoc_model.Root.file
422
+
in
381
423
let source_infos =
382
-
process_occurrences env traverse_infos loc_to_id local_ident_to_loc
424
+
process_occurrences ~module_name env traverse_infos loc_to_id
425
+
local_ident_to_loc
383
426
|> add_definitions loc_to_id
384
427
in
385
428
let shape_info = Some (shape, Shape.Uid.Tbl.to_map uid_to_id) in
+96
src/loader/typedtree_traverse.cppo.ml
+96
src/loader/typedtree_traverse.cppo.ml
···
8
8
| ModuleType of Path.t
9
9
| Type of Path.t
10
10
11
+
(** Extract the type path from a constructor_description's result type. *)
12
+
let type_path_of_constructor_desc (cstr : Types.constructor_description) =
13
+
match Types.get_desc cstr.cstr_res with
14
+
| Tconstr (p, _, _) -> Some p
15
+
| _ -> None
16
+
17
+
(** Extract the type path from a label_description's result type. *)
18
+
let type_path_of_label_desc (lbl : Types.label_description) =
19
+
match Types.get_desc lbl.lbl_res with
20
+
| Tconstr (p, _, _) -> Some p
21
+
| _ -> None
22
+
11
23
let expr poses expr =
12
24
let exp_loc = expr.Typedtree.exp_loc in
13
25
if exp_loc.loc_ghost then ()
···
19
31
| Texp_ident (p, _, _) ->
20
32
#endif
21
33
poses := (Value p, exp_loc) :: !poses
34
+
#if defined OXCAML
35
+
| Texp_construct (_, cstr_desc, _, _) -> (
36
+
#else
37
+
| Texp_construct (_, cstr_desc, _) -> (
38
+
#endif
39
+
match type_path_of_constructor_desc cstr_desc with
40
+
| Some p -> poses := (Type p, exp_loc) :: !poses
41
+
| None -> ())
42
+
#if defined OXCAML
43
+
| Texp_field (_, _, _, lbl_desc, _, _) -> (
44
+
#else
45
+
| Texp_field (_, _, lbl_desc) -> (
46
+
#endif
47
+
match type_path_of_label_desc lbl_desc with
48
+
| Some p -> poses := (Type p, exp_loc) :: !poses
49
+
| None -> ())
22
50
| _ -> ()
23
51
24
52
let pat env (type a) poses : a Typedtree.general_pattern -> unit = function
···
52
80
match maybe_localvalue id loc.loc with
53
81
| Some x -> poses := x :: !poses
54
82
| None -> ())
83
+
| Tpat_construct (_, cstr_desc, _, _) -> (
84
+
match type_path_of_constructor_desc cstr_desc with
85
+
| Some p -> poses := (Type p, pat_loc) :: !poses
86
+
| None -> ())
87
+
| Tpat_record (fields, _) ->
88
+
List.iter (fun (lid, lbl_desc, _) ->
89
+
match type_path_of_label_desc lbl_desc with
90
+
| Some p ->
91
+
let loc = lid.Asttypes.loc in
92
+
if not loc.Location.loc_ghost then
93
+
poses := (Type p, loc) :: !poses
94
+
| None -> ()) fields
55
95
| _ -> ()
56
96
in
57
97
()
···
84
124
when not ctyp_loc.loc_ghost ->
85
125
poses := (Type p, ctyp_loc) :: !poses
86
126
| _ -> ()
127
+
128
+
let open_declaration poses (od : Typedtree.open_declaration) =
129
+
if not od.open_loc.loc_ghost then
130
+
match od.open_expr with
131
+
| { mod_desc = Tmod_ident (p, _); _ } ->
132
+
poses := (Module p, od.open_loc) :: !poses
133
+
| _ -> ()
134
+
135
+
let open_description poses (od : Typedtree.open_description) =
136
+
if not od.open_loc.loc_ghost then
137
+
let (p, _) = od.open_expr in
138
+
poses := (Module p, od.open_loc) :: !poses
139
+
140
+
let structure_item poses (item : Typedtree.structure_item) =
141
+
if not item.str_loc.loc_ghost then
142
+
match item.str_desc with
143
+
| Tstr_include incl -> (
144
+
match incl.incl_mod with
145
+
| { mod_desc = Tmod_ident (p, _); _ } ->
146
+
poses := (Module p, incl.incl_loc) :: !poses
147
+
| _ -> ())
148
+
| _ -> ()
149
+
150
+
let signature_item poses (item : Typedtree.signature_item) =
151
+
if not item.sig_loc.loc_ghost then
152
+
match item.sig_desc with
153
+
#if defined OXCAML
154
+
| Tsig_include (incl, _) -> (
155
+
#else
156
+
| Tsig_include incl -> (
157
+
#endif
158
+
match incl.incl_mod with
159
+
| { mty_desc = Tmty_ident (p, _); _ } ->
160
+
poses := (Module p, incl.incl_loc) :: !poses
161
+
| _ -> ())
162
+
| _ -> ()
87
163
end
88
164
89
165
let of_cmt env structure =
···
113
189
Analysis.module_binding env poses mb;
114
190
iter.module_binding iterator mb
115
191
in
192
+
let open_declaration iterator od =
193
+
Analysis.open_declaration poses od;
194
+
iter.open_declaration iterator od
195
+
in
196
+
let open_description iterator od =
197
+
Analysis.open_description poses od;
198
+
iter.open_description iterator od
199
+
in
200
+
let structure_item iterator item =
201
+
Analysis.structure_item poses item;
202
+
iter.structure_item iterator item
203
+
in
204
+
let signature_item iterator item =
205
+
Analysis.signature_item poses item;
206
+
iter.signature_item iterator item
207
+
in
116
208
let iterator =
117
209
{
118
210
iter with
···
122
214
typ;
123
215
module_type;
124
216
module_binding;
217
+
open_declaration;
218
+
open_description;
219
+
structure_item;
220
+
signature_item;
125
221
}
126
222
in
127
223
iterator.structure iterator structure;
+1
-1
src/odoc/resolver.ml
+1
-1
src/odoc/resolver.ml
···
563
563
lookup_unit ~important_digests ~imports_map extended_ap ~libs ~hierarchy
564
564
and lookup_page = lookup_page ap ~pages ~hierarchy
565
565
and lookup_asset = lookup_asset ~pages ~hierarchy
566
-
and lookup_impl = lookup_impl ap in
566
+
and lookup_impl = lookup_impl extended_ap in
567
567
{ Env.open_units; lookup_unit; lookup_page; lookup_impl; lookup_asset }
568
568
569
569
let build_compile_env_for_impl t i =
+1
-1
test/integration/json_expansion_with_sources.t/run.t
+1
-1
test/integration/json_expansion_with_sources.t/run.t
···
47
47
{"header":"<h1>Module <code><span>A.B</span></code><a href=\"../../../src/a.ml.html#module-B\" class=\"source_link\">Source</a></h1>","type":"documentation","uses_katex":false,"breadcrumbs":[{"name":"Index","href":"../../../index.html","kind":"leaf-page"},{"name":"Main","href":"../../index.html","kind":"module"},{"name":"A","href":"../index.html","kind":"module"},{"name":"B","href":"#","kind":"module"}],"toc":[],"source_anchor":"../../../src/a.ml.html#module-B","preamble":"","content":"","resources":[],"assets":[]}
48
48
49
49
$ cat html/src/a.ml.html.json
50
-
{"type":"source","breadcrumbs":[{"name":"Index","href":"../index.html","kind":"leaf-page"},{"name":"src","href":"index.html","kind":"page"},{"name":"a.ml","href":"#","kind":"source"}],"global_toc":null,"header":"<h1>Source file <code><span>a.ml</span></code></h1>","content":"<pre class=\"source_container\"><code class=\"source_line_column\"><a id=\"L1\" class=\"source_line\" href=\"#L1\">1</a>\u000A</code><code class=\"source_code\"><span><span class=\"MODULE\"><span id=\"module-B\"></span>module</span> <span class=\"UIDENT\">B</span> <span class=\"EQUAL\">=</span> <span class=\"STRUCT\">struct</span> <span class=\"END\">end</span><span class=\"EOL\">\u000A</span></span></code></pre>"}
50
+
{"type":"source","breadcrumbs":[{"name":"Index","href":"../index.html","kind":"leaf-page"},{"name":"src","href":"index.html","kind":"page"},{"name":"a.ml","href":"#","kind":"source"}],"global_toc":null,"header":"<h1>Source file <code><span>a.ml</span></code></h1>","content":"<pre class=\"source_container\"><code class=\"source_line_column\"><a id=\"L1\" class=\"source_line\" href=\"#L1\">1</a>\u000A</code><code class=\"source_code\"><span><span id=\"module-B\"><span class=\"MODULE\">module</span> <span class=\"UIDENT\">B</span> <span class=\"EQUAL\">=</span> <span class=\"STRUCT\">struct</span> <span class=\"END\">end</span></span><span class=\"EOL\">\u000A</span></span></code></pre>"}