diff --git a/src/document/generator.ml b/src/document/generator.ml index 550f008e7d..a8b553902b 100644 --- a/src/document/generator.ml +++ b/src/document/generator.ml @@ -1132,7 +1132,7 @@ module Make (Syntax : SYNTAX) = struct let items = Sectioning.comment_items c in loop rest (List.rev_append items acc_items)) in - (s.doc, loop s.items []) + (Lang.extract_signature_doc s, loop s.items []) and functor_parameter : Odoc_model.Lang.FunctorParameter.parameter -> DocumentedSrc.t = diff --git a/src/model/lang.ml b/src/model/lang.ml index 3ecdd23d5e..17f0d63225 100644 --- a/src/model/lang.ml +++ b/src/model/lang.ml @@ -470,3 +470,14 @@ let umty_of_mty : ModuleType.expr -> ModuleType.U.expr option = function | Functor _ -> None | TypeOf t -> Some (TypeOf t) | With { w_substitutions; w_expr; _ } -> Some (With (w_substitutions, w_expr)) + +(** Query the top-comment of a signature. This is [s.doc] most of the time with + an exception for signature starting with an inline includes. *) +let extract_signature_doc (s : Signature.t) = + match (s.doc, s.items) with + | [], Include { expansion; status = `Inline; _ } :: _ -> + (* A signature that starts with an [@inline] include inherits the + top-comment from the expansion. This comment is not rendered for + [include] items. *) + expansion.content.doc + | doc, _ -> doc diff --git a/src/xref2/component.ml b/src/xref2/component.ml index 3691cb525e..b5df4e0859 100644 --- a/src/xref2/component.ml +++ b/src/xref2/component.ml @@ -2321,3 +2321,9 @@ let module_of_functor_argument (arg : FunctorParameter.parameter) = canonical = None; hidden = false; } + +(** This is equivalent to {!Lang.extract_signature_doc}. *) +let extract_signature_doc (s : Signature.t) = + match (s.doc, s.items) with + | [], Include { expansion_; status = `Inline; _ } :: _ -> expansion_.doc + | doc, _ -> doc diff --git a/src/xref2/component.mli b/src/xref2/component.mli index 2ebb0dc638..794c2b27d9 100644 --- a/src/xref2/component.mli +++ b/src/xref2/component.mli @@ -758,3 +758,5 @@ module Of_Lang : sig end val module_of_functor_argument : FunctorParameter.parameter -> Module.t + +val extract_signature_doc : Signature.t -> CComment.docs diff --git a/src/xref2/link.ml b/src/xref2/link.ml index 560ebce073..6275ee2527 100644 --- a/src/xref2/link.ml +++ b/src/xref2/link.ml @@ -11,8 +11,22 @@ module Opt = struct let map f = function Some x -> Some (f x) | None -> None end -let synopsis_from_comment parent docs = - Odoc_model.Comment.synopsis (Lang_of.docs parent docs) +(** Equivalent to {!Comment.synopsis}. *) +let synopsis_from_comment (docs : Component.CComment.docs) = + match docs with + | ({ value = #Comment.nestable_block_element; _ } as e) :: _ -> + (* Only the first element is considered. *) + Comment.synopsis [ e ] + | _ -> None + +let synopsis_of_module env (m : Component.Module.t) = + match synopsis_from_comment m.doc with + | Some _ as s -> s + | None -> ( + (* If there is no doc, look at the expansion. *) + match Tools.signature_of_module env m with + | Ok sg -> synopsis_from_comment (Component.extract_signature_doc sg) + | Error _ -> None) exception Loop @@ -158,15 +172,7 @@ and comment_nestable_block_element env parent (fun (r : Comment.module_reference) -> match Ref_tools.resolve_module_reference env r.module_reference with | Some (r, _, m) -> - let module_synopsis = - match synopsis_from_comment parent m.doc with - | Some _ as s -> s - | None -> ( - (* If there is no doc, look at the expansion. *) - match Tools.signature_of_module env m with - | Ok sg -> synopsis_from_comment parent sg.doc - | Error _ -> None) - in + let module_synopsis = synopsis_of_module env m in { Comment.module_reference = `Resolved r; module_synopsis } | None -> r) refs diff --git a/test/html/expect/test_package+ml/Toplevel_comments/Include_inline/index.html b/test/html/expect/test_package+ml/Toplevel_comments/Include_inline/index.html index 21e11d18dc..35bf9703c8 100644 --- a/test/html/expect/test_package+ml/Toplevel_comments/Include_inline/index.html +++ b/test/html/expect/test_package+ml/Toplevel_comments/Include_inline/index.html @@ -21,6 +21,9 @@
Toplevel_comments.Include_inline
+ Doc of T
, part 2.
+
module Include_inline : sig ... end
+ Doc of T
, part 2.
+
module type Include_inline_T = sig ... end
+ Doc of T
, part 2.
+
Toplevel_comments.Include_inline_T
+ Doc of T
, part 2.
+
Toplevel_comments.Include_inline
+ Doc of T
, part 2.
+
module Include_inline: { ... };
+ Doc of T
, part 2.
+
module type Include_inline_T = { ... };
+ Doc of T
, part 2.
+
Toplevel_comments.Include_inline_T
+ Doc of T
, part 2.
+