Pass documentation along with signatures

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
@@ -1036,7 +1043,8 @@ module Make (Syntax : SYNTAX) = struct
   open Class
 
   module Module : sig
-    val signature : Lang.Signature.t -> Item.t list
+    val signature : Lang.Signature.t -> Comment.Comment.docs * Item.t list
+    (** Returns [header_doc, content]. *)
   end = struct
     let internal_module m =
       let open Lang.Module in
@@ -1068,9 +1076,7 @@ module Make (Syntax : SYNTAX) = struct
       | `Module (_, name) when ModuleName.is_internal name -> true
       | _ -> false
 
-    let rec signature (s : Lang.Signature.t) = signature_items s.items
-
-    and signature_items s : Item.t list =
+    let rec signature (s : Lang.Signature.t) =
       let rec loop l acc_items =
         match l with
         | [] -> List.rev acc_items
@@ -1108,7 +1114,7 @@ module Make (Syntax : SYNTAX) = struct
                 let items = Sectioning.comment_items c in
                 loop rest (List.rev_append items acc_items) )
       in
-      loop s []
+      (s.doc, loop s.items [])
 
     and functor_parameter :
         Odoc_model.Lang.FunctorParameter.parameter -> DocumentedSrc.t =
@@ -1124,11 +1130,14 @@ module Make (Syntax : SYNTAX) = struct
         | None ->
             let modname = O.txt (Paths.Identifier.name arg.id) in
             (modname, O.documentedSrc modtyp)
-        | Some items ->
+        | Some (expansion_doc, items) ->
             let url = Url.Path.from_identifier arg.id in
             let modname = path url [ inline @@ Text name ] in
             let type_with_expansion =
-              let header = format_title `Arg (make_name_from_path url) in
+              let header =
+                format_title `Arg (make_name_from_path url)
+                @ Comment.standalone expansion_doc
+              in
               let title = name in
               let content = { Page.items; title; header; url } in
               let summary = O.render modtyp in
@@ -1163,7 +1172,8 @@ module Make (Syntax : SYNTAX) = struct
       Item.Declaration { kind; anchor; doc; content }
 
     and simple_expansion :
-        Odoc_model.Lang.ModuleType.simple_expansion -> Item.t list =
+        Odoc_model.Lang.ModuleType.simple_expansion ->
+        Comment.Comment.docs * Item.t list =
      fun t ->
       let rec extract_functor_params
           (f : Odoc_model.Lang.ModuleType.simple_expansion) =
@@ -1178,11 +1188,9 @@ module Make (Syntax : SYNTAX) = struct
             (Some (add_to params), sg)
       in
       match extract_functor_params t with
-      | None, sg ->
-          let expansion = signature_items sg.items in
-          expansion
+      | None, sg -> signature sg
       | Some params, sg ->
-          let content = signature_items sg.items in
+          let sg_doc, content = signature sg in
           let params =
             Utils.flatmap params ~f:(fun arg ->
                 let content = functor_parameter arg in
@@ -1211,10 +1219,11 @@ module Make (Syntax : SYNTAX) = struct
               }
             :: content
           in
-          prelude @ content
+          (sg_doc, prelude @ content)
 
     and expansion_of_module_type_expr :
-        Odoc_model.Lang.ModuleType.expr -> Item.t list option =
+        Odoc_model.Lang.ModuleType.expr ->
+        (Comment.Comment.docs * Item.t list) option =
      fun t ->
       let rec simple_expansion_of (t : Odoc_model.Lang.ModuleType.expr) =
         match t with
@@ -1241,18 +1250,15 @@ module Make (Syntax : SYNTAX) = struct
       let modname = Paths.Identifier.name t.id in
       let expansion =
         match t.type_ with
-        | Alias (_, Some e) -> Some (simple_expansion e.a_expansion, e.a_doc)
+        | Alias (_, Some e) -> Some (simple_expansion e)
         | Alias (_, None) -> None
-        | ModuleType e -> (
-            match expansion_of_module_type_expr e with
-            | Some e -> Some (e, t.doc)
-            | None -> None )
+        | ModuleType e -> expansion_of_module_type_expr e
       in
       let modname, status, expansion =
         match expansion with
         | None -> (O.documentedSrc (O.txt modname), `Default, None)
-        | Some (items, expansion_doc) ->
-            let doc = Comment.standalone expansion_doc in
+        | Some (expansion_doc, items) ->
+            let doc = doc_of_expansion ~decl_doc:t.doc ~expansion_doc in
             let status =
               match t.type_ with
               | ModuleType (Signature _) -> `Inline
@@ -1296,7 +1302,7 @@ module Make (Syntax : SYNTAX) = struct
         ++ Syntax.Mod.open_tag ++ O.txt " ... " ++ Syntax.Mod.close_tag
       in
       match md with
-      | Alias (_, Some se) -> simple_expansion_in_decl base se.a_expansion
+      | Alias (_, Some se) -> simple_expansion_in_decl base se
       | Alias (p, _) when not Paths.Path.(is_hidden (p :> t)) ->
           O.txt " = " ++ mdexpr md
       | Alias _ -> sig_dotdotdot
@@ -1316,8 +1322,8 @@ module Make (Syntax : SYNTAX) = struct
       let modname, expansion =
         match expansion with
         | None -> (O.documentedSrc @@ O.txt modname, None)
-        | Some items ->
-            let doc = Comment.standalone t.doc in
+        | Some (expansion_doc, items) ->
+            let doc = doc_of_expansion ~decl_doc:t.doc ~expansion_doc in
             let url = Url.Path.from_identifier t.id in
             let link = path url [ inline @@ Text modname ] in
             let title = modname in
@@ -1515,7 +1521,7 @@ module Make (Syntax : SYNTAX) = struct
         | ModuleType mt -> umty mt
       in
 
-      let content = signature t.expansion.content in
+      let sg_doc, content = signature t.expansion.content in
       let summary =
         O.render
           ( O.keyword "include" ++ O.txt " " ++ include_decl
@@ -1524,7 +1530,7 @@ module Make (Syntax : SYNTAX) = struct
       let content = { Include.content; status; summary } in
       let kind = Some "include" in
       let anchor = None in
-      let doc = Comment.first_to_ir t.doc in
+      let doc = Comment.first_to_ir sg_doc in
       Item.Include { kind; anchor; doc; content }
   end
 
@@ -1559,13 +1565,13 @@ module Make (Syntax : SYNTAX) = struct
 
     let compilation_unit (t : Odoc_model.Lang.Compilation_unit.t) : Page.t =
       let title = Paths.Identifier.name t.id in
-      let header = format_title `Mod title @ Comment.standalone t.doc in
       let url = Url.Path.from_identifier t.id in
-      let items =
+      let unit_doc, items =
         match t.content with
         | Module sign -> signature sign
-        | Pack packed -> pack packed
+        | Pack packed -> ([], pack packed)
       in
+      let header = format_title `Mod title @ Comment.standalone unit_doc in
       { Page.title; header; items; url }
 
     let page (t : Odoc_model.Lang.Page.t) : Page.t =

src/document/targets.ml

@@ -55,7 +55,7 @@ and module_ (t : Odoc_model.Lang.Module.t) =
   let url = Url.Path.from_identifier t.id in
   let subpages =
     match t.type_ with
-    | Alias (_, Some e) -> simple_expansion e.a_expansion
+    | Alias (_, Some e) -> simple_expansion e
     | Alias (_, None) -> []
     | ModuleType expr -> module_type_expr expr
   in

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
@@ -976,7 +976,7 @@ and read_signature_noenv env parent (items : Odoc_model.Compat.signature) =
     | Sig_class_type _ :: _
     | Sig_class _ :: _ -> assert false
 
-    | [] -> ({items = List.rev acc; compiled=false}, shadowed)
+    | [] -> ({items = List.rev acc; compiled=false; doc = [] }, shadowed)
   in
     loop ([],{s_modules=[]; s_module_types=[]; s_values=[];s_types=[]; s_classes=[]; s_class_types=[]}) items
 
@@ -986,7 +986,6 @@ and read_signature env parent (items : Odoc_model.Compat.signature) =
 
 
 let read_interface root name intf =
-  let id = `Root(root, Odoc_model.Names.ModuleName.make_std name) in
-  let doc = Doc_attr.empty in
+  let id = `Root (root, Odoc_model.Names.ModuleName.make_std name) in
   let items = read_signature Env.empty id intf in
-    (id, doc, items)
+  (id, items)

src/loader/cmi.mli

@@ -19,10 +19,11 @@
 module Paths = Odoc_model.Paths
 
 
-val read_interface: Odoc_model.Paths.Identifier.ContainerPage.t -> string -> Odoc_model.Compat.signature ->
-  Paths.Identifier.RootModule.t *
-  Odoc_model.Comment.docs *
-  Odoc_model.Lang.Signature.t
+val read_interface :
+  Odoc_model.Paths.Identifier.ContainerPage.t ->
+  string ->
+  Odoc_model.Compat.signature ->
+  Paths.Identifier.RootModule.t * Odoc_model.Lang.Signature.t
 
 val canonical : Odoc_model.Comment.docs -> [ `Dot of Paths.Path.Module.t * string ] option
 

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
@@ -545,20 +547,16 @@ and read_structure env parent str =
   let items =
     List.fold_left
       (fun items item ->
-         List.rev_append (read_structure_item env parent item) items)
+        List.rev_append (read_structure_item env parent item) items)
       [] str.str_items
+    |> List.rev
   in
-    { items = List.rev items; compiled=false }
+  let items, doc = Doc_attr.extract_top_comment items in
+  { items; compiled = false; doc }
 
 let read_implementation root name impl =
-  let id = `Root(root, Odoc_model.Names.ModuleName.make_std name) in
+  let id = `Root (root, Odoc_model.Names.ModuleName.make_std name) in
   let sg = read_structure Env.empty id impl in
-  let doc, sg =
-    let open Signature in
-    match sg.items with
-    | Comment (`Docs doc) :: items -> doc, {sg with items}
-    | _ -> Doc_attr.empty, sg
-  in
-    (id, doc, sg)
+  (id, sg)
 
 let _ = Cmti.read_module_expr := read_module_expr

src/loader/cmt.mli

@@ -14,7 +14,8 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-val read_implementation: Odoc_model.Paths.Identifier.ContainerPage.t -> string -> Typedtree.structure ->
-  Odoc_model.Paths.Identifier.RootModule.t *
-  Odoc_model.Comment.docs *
-  Odoc_model.Lang.Signature.t
+val read_implementation :
+  Odoc_model.Paths.Identifier.ContainerPage.t ->
+  string ->
+  Typedtree.structure ->
+  Odoc_model.Paths.Identifier.RootModule.t * Odoc_model.Lang.Signature.t

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
@@ -703,24 +704,18 @@ and read_open env parent o =
 #endif
 
 and read_signature env parent sg =
-  let env =
-    Env.add_signature_tree_items parent sg env
-  in
+  let env = Env.add_signature_tree_items parent sg env in
   let items =
     List.fold_left
       (fun items item ->
-         List.rev_append (read_signature_item env parent item) items)
+        List.rev_append (read_signature_item env parent item) items)
       [] sg.sig_items
+    |> List.rev
   in
-    { items = List.rev items; compiled=false }
+  let items, doc = Doc_attr.extract_top_comment items in
+  { items; compiled = false; doc }
 
 let read_interface root name intf =
-  let id = `Root(root, Odoc_model.Names.ModuleName.make_std name) in
+  let id = `Root (root, Odoc_model.Names.ModuleName.make_std name) in
   let sg = read_signature Env.empty id intf in
-  let doc, sg =
-    let open Signature in
-    match sg.items with
-    | Comment (`Docs doc) :: items -> doc, {sg with items}
-    | _ -> Doc_attr.empty, sg
-  in
-    (id, doc, sg)
+  (id, sg)

src/loader/cmti.mli

@@ -16,14 +16,19 @@
 
 module Paths = Odoc_model.Paths
 
-val read_module_expr : (Ident_env.t -> Paths.Identifier.Signature.t -> Paths.Identifier.LabelParent.t -> Typedtree.module_expr -> Odoc_model.Lang.ModuleType.expr) ref
+val read_module_expr :
+  (Ident_env.t ->
+  Paths.Identifier.Signature.t ->
+  Paths.Identifier.LabelParent.t ->
+  Typedtree.module_expr ->
+  Odoc_model.Lang.ModuleType.expr)
+  ref
+
 val read_interface :
   Odoc_model.Paths.Identifier.ContainerPage.t ->
   string ->
   Typedtree.signature ->
-  Paths.Identifier.RootModule.t
-  * Odoc_model.Comment.docs
-  * Odoc_model.Lang.Signature.t
+  Paths.Identifier.RootModule.t * Odoc_model.Lang.Signature.t
 
 val read_module_type :
   Ident_env.t ->