Handle the top-comment in class signatures

Like module signatures, extract the top-comment from the loader and pass
it through. Render it the same way as modules.

src/document/generator.ml

@@ -81,6 +81,9 @@ let attach_expansion ?(status = `Default) (eq, o, e) page text =
       DocumentedSrc.
         [ Alternative (Expansion { summary; url; status; expansion }) ]
 
+let doc_of_expansion ~decl_doc ~expansion_doc =
+  Comment.standalone decl_doc @ Comment.standalone expansion_doc
+
 include Generator_signatures
 
 module Make (Syntax : SYNTAX) = struct
@@ -948,7 +951,7 @@ module Make (Syntax : SYNTAX) = struct
                 loop rest (List.rev_append items acc_items) )
       in
       (* FIXME: use [t.self] *)
-      loop c.items []
+      (c.doc, loop c.items [])
 
     let rec class_decl (cd : Odoc_model.Lang.Class.decl) =
       match cd with
@@ -977,10 +980,12 @@ module Make (Syntax : SYNTAX) = struct
         match t.expansion with
         | None -> (O.documentedSrc @@ O.txt name, None)
         | Some csig ->
-            let doc = Comment.standalone t.doc in
-            let items = class_signature csig in
+            let expansion_doc, items = class_signature csig in
             let url = Url.Path.from_identifier t.id in
-            let header = format_title `Class (make_name_from_path url) @ doc in
+            let header =
+              format_title `Class (make_name_from_path url)
+              @ doc_of_expansion ~decl_doc:t.doc ~expansion_doc
+            in
             let page = { Page.title = name; header; items; url } in
             (O.documentedSrc @@ path url [ inline @@ Text name ], Some page)
       in
@@ -1013,9 +1018,11 @@ module Make (Syntax : SYNTAX) = struct
         | None -> (O.documentedSrc @@ O.txt name, None)
         | Some csig ->
             let url = Url.Path.from_identifier t.id in
-            let doc = Comment.standalone t.doc in
-            let items = class_signature csig in
-            let header = format_title `Cty (make_name_from_path url) @ doc in
+            let expansion_doc, items = class_signature csig in
+            let header =
+              format_title `Cty (make_name_from_path url)
+              @ doc_of_expansion ~decl_doc:t.doc ~expansion_doc
+            in
             let page = { Page.title = name; header; items; url } in
             (O.documentedSrc @@ path url [ inline @@ Text name ], Some page)
       in
@@ -1069,9 +1076,6 @@ module Make (Syntax : SYNTAX) = struct
       | `Module (_, name) when ModuleName.is_internal name -> true
       | _ -> false
 
-    let doc_of_expansion ~decl_doc ~expansion_doc =
-      Comment.standalone decl_doc @ Comment.standalone expansion_doc
-
     let rec signature (s : Lang.Signature.t) =
       let rec loop l acc_items =
         match l with

src/loader/cmi.ml

@@ -755,7 +755,7 @@ let rec read_class_signature env parent params =
         List.map (read_method env parent csig.csig_concr) methods
       in
       let items = constraints @ instance_variables @ methods in
-        Signature {self; items}
+      Signature {self; items; doc = []}
   | Cty_arrow _ -> assert false
 
 let rec read_virtual = function

src/loader/cmt.ml

@@ -176,7 +176,8 @@ and read_class_signature env parent params cltyp =
             [] csig.csig_fields
         in
         let items = constraints @ List.rev items in
-          Signature {self; items}
+        let items, doc = Doc_attr.extract_top_comment_class items in
+        Signature {self; items; doc}
     | Tcty_arrow _ -> assert false
 #if OCAML_MAJOR = 4 && OCAML_MINOR >= 06
     | Tcty_open _ -> assert false
@@ -263,7 +264,8 @@ and read_class_structure env parent params cl =
             [] cstr.cstr_fields
         in
         let items = constraints @ List.rev items in
-          Signature {self; items}
+        let items, doc = Doc_attr.extract_top_comment_class items in
+        Signature {self; items; doc}
     | Tcl_fun _ -> assert false
     | Tcl_let(_, _, _, cl) -> read_class_structure env parent params cl
     | Tcl_constraint(cl, None, _, _, _) -> read_class_structure env parent params cl

src/loader/cmti.ml

@@ -383,7 +383,8 @@ and read_class_signature env parent label_parent cltyp =
             [] csig.csig_fields
         in
         let items = List.rev items in
-          Signature {self; items}
+        let items, doc = Doc_attr.extract_top_comment_class items in
+        Signature {self; items; doc}
     | Tcty_arrow _ -> assert false
 #if OCAML_MAJOR = 4 && OCAML_MINOR >= 06 && OCAML_MINOR < 08
   | Tcty_open (_, _, _, _, cty) -> read_class_signature env parent label_parent cty

src/loader/doc_attr.ml

@@ -132,3 +132,8 @@ let extract_top_comment items =
   match items with
   | Lang.Signature.Comment (`Docs doc) :: tl -> (tl, doc)
   | _ -> (items, empty)
+
+let extract_top_comment_class items =
+  match items with
+  | Lang.ClassSignature.Comment (`Docs doc) :: tl -> (tl, doc)
+  | _ -> items, empty

src/loader/doc_attr.mli

@@ -54,3 +54,7 @@ val standalone_multiple :
 val extract_top_comment :
   Lang.Signature.item list -> Lang.Signature.item list * Comment.docs
 (** Extract the first comment of a signature. Returns the remaining items. *)
+
+val extract_top_comment_class :
+  Lang.ClassSignature.item list -> Lang.ClassSignature.item list * Comment.docs
+(** Extract the first comment of a class signature. Returns the remaining items. *)

src/model/lang.ml

@@ -334,7 +334,7 @@ and ClassSignature : sig
     | Inherit of ClassType.expr
     | Comment of Comment.docs_or_stop
 
-  type t = { self : TypeExpr.t option; items : item list }
+  type t = { self : TypeExpr.t option; items : item list; doc : Comment.docs }
 end =
   ClassSignature
 

src/xref2/compile.ml

@@ -151,6 +151,7 @@ and class_signature env parent c =
     | Comment c -> Comment c
   in
   {
+    c with
     self = Opt.map (type_expression env container) c.self;
     items = List.map map_item c.items;
   }

src/xref2/component.ml

@@ -377,7 +377,7 @@ and ClassSignature : sig
     | Inherit of ClassType.expr
     | Comment of CComment.docs_or_stop
 
-  type t = { self : TypeExpr.t option; items : item list }
+  type t = { self : TypeExpr.t option; items : item list; doc : CComment.docs }
 end =
   ClassSignature
 
@@ -2177,7 +2177,11 @@ module Of_Lang = struct
           | Comment c -> Comment (docs_or_stop ident_map c))
         sg.items
     in
-    { ClassSignature.self = Opt.map (type_expression ident_map) sg.self; items }
+    {
+      ClassSignature.self = Opt.map (type_expression ident_map) sg.self;
+      items;
+      doc = docs ident_map sg.doc;
+    }
 
   and method_ ident_map m =
     let open Odoc_model.Lang.Method in

src/xref2/component.mli

@@ -351,7 +351,7 @@ and ClassSignature : sig
     | Inherit of ClassType.expr
     | Comment of CComment.docs_or_stop
 
-  type t = { self : TypeExpr.t option; items : item list }
+  type t = { self : TypeExpr.t option; items : item list; doc : CComment.docs }
 end
 
 and Method : sig

src/xref2/lang_of.ml

@@ -497,8 +497,8 @@ and class_signature map parent sg =
         | Comment c ->
             Comment (docs_or_stop (parent :> Identifier.LabelParent.t) c))
       sg.items
-  in
-  { self = Opt.map (type_expr map pparent) sg.self; items }
+  and doc = docs (parent :> Identifier.LabelParent.t) sg.doc in
+  { self = Opt.map (type_expr map pparent) sg.self; items; doc }
 
 and method_ map parent id m =
   let open Component.Method in

src/xref2/link.ml

@@ -297,6 +297,7 @@ and class_signature env parent c =
   {
     self = Opt.map (type_expression env parent []) c.self;
     items = List.map map_item c.items;
+    doc = comment_docs env c.doc;
   }
 
 and method_ env parent m =

src/xref2/subst.ml

@@ -769,6 +769,7 @@ and class_signature_item s =
 and class_signature s sg =
   let open Component.ClassSignature in
   {
+    sg with
     self = option_ type_expr s sg.self;
     items = List.map (class_signature_item s) sg.items;
   }

test/html/expect/test_package+ml/Toplevel_comments/class-c1/index.html

@@ -24,11 +24,10 @@ <h1>
    <p>
     Doc of <code>c1</code>, part 1.
    </p>
-  </header>
-  <div class="odoc-content">
    <p>
     Doc of <code>c1</code>, part 2.
    </p>
-  </div>
+  </header>
+  <div class="odoc-content"></div>
  </body>
 </html>

test/html/expect/test_package+ml/Toplevel_comments/class-c2/index.html

@@ -24,11 +24,10 @@ <h1>
    <p>
     Doc of <code>c2</code>.
    </p>
-  </header>
-  <div class="odoc-content">
    <p>
     Doc of <code>ct</code>, part 2.
    </p>
-  </div>
+  </header>
+  <div class="odoc-content"></div>
  </body>
 </html>

test/html/expect/test_package+ml/Toplevel_comments/class-type-ct/index.html

@@ -24,11 +24,10 @@ <h1>
    <p>
     Doc of <code>ct</code>, part 1.
    </p>
-  </header>
-  <div class="odoc-content">
    <p>
     Doc of <code>ct</code>, part 2.
    </p>
-  </div>
+  </header>
+  <div class="odoc-content"></div>
  </body>
 </html>

test/html/expect/test_package+re/Toplevel_comments/class-c1/index.html

@@ -24,11 +24,10 @@ <h1>
    <p>
     Doc of <code>c1</code>, part 1.
    </p>
-  </header>
-  <div class="odoc-content">
    <p>
     Doc of <code>c1</code>, part 2.
    </p>
-  </div>
+  </header>
+  <div class="odoc-content"></div>
  </body>
 </html>

test/html/expect/test_package+re/Toplevel_comments/class-c2/index.html

@@ -24,11 +24,10 @@ <h1>
    <p>
     Doc of <code>c2</code>.
    </p>
-  </header>
-  <div class="odoc-content">
    <p>
     Doc of <code>ct</code>, part 2.
    </p>
-  </div>
+  </header>
+  <div class="odoc-content"></div>
  </body>
 </html>

test/html/expect/test_package+re/Toplevel_comments/class-type-ct/index.html

@@ -24,11 +24,10 @@ <h1>
    <p>
     Doc of <code>ct</code>, part 1.
    </p>
-  </header>
-  <div class="odoc-content">
    <p>
     Doc of <code>ct</code>, part 2.
    </p>
-  </div>
+  </header>
+  <div class="odoc-content"></div>
  </body>
 </html>