Skip to content

Commit 2f3e919

Browse files
committed
Handle @inline includes when resolving modules lists
{!modules:...} lists are resolved when linking, code can't be shared with the generator because types are different too.
1 parent 9cc8389 commit 2f3e919

File tree

5 files changed

+30
-17
lines changed

5 files changed

+30
-17
lines changed

src/xref2/component.ml

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -330,6 +330,7 @@ and Include : sig
330330
shadowed : Odoc_model.Lang.Include.shadowed;
331331
expansion_ : Signature.t;
332332
decl : decl;
333+
inline : bool;
333334
}
334335
end =
335336
Include
@@ -2118,6 +2119,7 @@ module Of_Lang = struct
21182119
shadowed = i.expansion.shadowed;
21192120
expansion_ = apply_sig_map ident_map i.expansion.content;
21202121
decl;
2122+
inline = i.inline;
21212123
}
21222124

21232125
and class_ ident_map c =
@@ -2319,3 +2321,9 @@ let module_of_functor_argument (arg : FunctorParameter.parameter) =
23192321
canonical = None;
23202322
hidden = false;
23212323
}
2324+
2325+
(** This is equivalent to {!Lang.extract_signature_doc}. *)
2326+
let extract_signature_doc (s : Signature.t) =
2327+
match (s.doc, s.items) with
2328+
| [], Include { expansion_; inline; _ } :: _ when inline -> expansion_.doc
2329+
| doc, _ -> doc

src/xref2/component.mli

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -308,6 +308,7 @@ and Include : sig
308308
shadowed : Odoc_model.Lang.Include.shadowed;
309309
expansion_ : Signature.t;
310310
decl : decl;
311+
inline : bool;
311312
}
312313
end
313314

@@ -757,3 +758,5 @@ module Of_Lang : sig
757758
end
758759

759760
val module_of_functor_argument : FunctorParameter.parameter -> Module.t
761+
762+
val extract_signature_doc : Signature.t -> CComment.docs

src/xref2/lang_of.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -598,7 +598,7 @@ and include_ parent map i =
598598
{ map with shadowed = combine_shadowed map.shadowed i.shadowed }
599599
i.expansion_;
600600
};
601-
inline = false;
601+
inline = i.inline;
602602
}
603603

604604
and open_ parent map o =

src/xref2/link.ml

Lines changed: 17 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -11,8 +11,22 @@ module Opt = struct
1111
let map f = function Some x -> Some (f x) | None -> None
1212
end
1313

14-
let synopsis_from_comment parent docs =
15-
Odoc_model.Comment.synopsis (Lang_of.docs parent docs)
14+
(** Equivalent to {!Comment.synopsis}. *)
15+
let synopsis_from_comment (docs : Component.CComment.docs) =
16+
match docs with
17+
| { value = #Comment.nestable_block_element; _ } as e :: _ ->
18+
(* Only the first element is considered. *)
19+
Comment.synopsis [ e ]
20+
| _ -> None
21+
22+
let synopsis_of_module env (m : Component.Module.t) =
23+
match synopsis_from_comment m.doc with
24+
| Some _ as s -> s
25+
| None -> (
26+
(* If there is no doc, look at the expansion. *)
27+
match Tools.signature_of_module env m with
28+
| Ok sg -> synopsis_from_comment (Component.extract_signature_doc sg)
29+
| Error _ -> None )
1630

1731
exception Loop
1832

@@ -158,19 +172,7 @@ and comment_nestable_block_element env parent
158172
(fun (r : Comment.module_reference) ->
159173
match Ref_tools.resolve_module_reference env r.module_reference with
160174
| Some (r, _, m) ->
161-
let module_synopsis =
162-
match synopsis_from_comment parent m.doc with
163-
| Some _ as s -> s
164-
| None -> (
165-
(* If there is no doc, look at the expansion.
166-
This doesn't implement the "@inline includes" special
167-
case. The handling of the synopsis and the preamble
168-
should be moved to xref2 and store into Lang to solve
169-
that. *)
170-
match Tools.signature_of_module env m with
171-
| Ok sg -> synopsis_from_comment parent sg.doc
172-
| Error _ -> None)
173-
in
175+
let module_synopsis = synopsis_of_module env m in
174176
{ Comment.module_reference = `Resolved r; module_synopsis }
175177
| None -> r)
176178
refs

test/xref2/module_list.t/run.t

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,7 @@ Everything should resolve:
3232
{"`Resolved":{"`SubstAlias":[{"`Canonical":[{"`Module":[{"`Identifier":{"`Module":[{"`Root":[{"`RootPage":"test"},"Main"]},"Internal"]}},"C2"]},{"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"`RootPage":"test"},"Main"]},"C2"]}}}]},{"`Identifier":{"`Module":[{"`Root":[{"`RootPage":"test"},"Main"]},"C2"]}}]}}
3333
"None"
3434
{"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"`RootPage":"test"},"Main"]},"Inline_include"]}}}
35-
"None"
35+
{"Some":[{"`Word":"Doc"},"`Space",{"`Word":"for"},"`Space",{"`Code_span":"T"},{"`Word":"."}]}
3636
{"`Resolved":{"`Identifier":{"`Root":[{"`RootPage":"test"},"Starts_with_open"]}}}
3737
{"Some":[{"`Word":"Synopsis"},"`Space",{"`Word":"of"},"`Space",{"`Code_span":"Starts_with_open"},{"`Word":"."}]}
3838

0 commit comments

Comments
 (0)