Cut the preamble at the first top-level heading

If the preamble contains a heading, this heading and the rest of the preamble is moved out of the 'header' to the 'content' of the page. That part of the preamble is rendered after the TOC and appears in it. Heading of level 2 or higher are kept in the preamble.
ocaml · Mar 15, 2021 · d13a109 · d13a109
1 parent b0c03d1
commit d13a109
Show file tree

Hide file tree

Showing 20 changed files with 166 additions and 86 deletions.
diff --git a/src/document/comment.ml b/src/document/comment.ml
@@ -309,18 +309,18 @@ let block_element : Comment.block_element -> Block.t = function
          TODO: Remove heading in attached documentation in the model *)
       [ block @@ Paragraph (non_link_inline_element_list content) ]
 
+let heading_level = function
+  | `Title -> 0
+  | `Section -> 1
+  | `Subsection -> 2
+  | `Subsubsection -> 3
+  | `Paragraph -> 4
+  | `Subparagraph -> 5
+
 let heading (`Heading (level, `Label (_, label), content)) =
   let label = Odoc_model.Names.LabelName.to_string label in
   let title = non_link_inline_element_list content in
-  let level =
-    match level with
-    | `Title -> 0
-    | `Section -> 1
-    | `Subsection -> 2
-    | `Subsubsection -> 3
-    | `Paragraph -> 4
-    | `Subparagraph -> 5
-  in
+  let level = heading_level level in
   let label = Some label in
   Item.Heading { label; level; title }
 

diff --git a/src/document/generator.ml b/src/document/generator.ml
@@ -81,8 +81,26 @@ 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
+(** Returns the preamble as an item. Stop the preamble at the first heading of
+    level 2 or more. The rest is inserted into [items]. *)
+let prepare_preamble comment items =
+  let preamble, first_comment =
+    Utils.split_at
+      ~f:(function
+        | { Odoc_model.Location_.value = `Heading (level, _, _); _ }
+          when Comment.heading_level level < 2 ->
+            true
+        | _ -> false)
+      comment
+  in
+  (Comment.standalone preamble, Comment.standalone first_comment @ items)
+
+let make_expansion_page title kind url ?(header_title = make_name_from_path url)
+    comments items =
+  let comment = List.concat comments in
+  let preamble, items = prepare_preamble comment items in
+  let header = format_title kind header_title @ preamble in
+  { Page.title; header; items; url }
 
 include Generator_signatures
 
@@ -985,11 +1003,9 @@ module Make (Syntax : SYNTAX) = struct
         | Some csig ->
             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_of_expansion ~decl_doc:t.doc ~expansion_doc
+            let page =
+              make_expansion_page name `Class url [ t.doc; expansion_doc ] items
             in
-            let page = { Page.title = name; header; items; url } in
             (O.documentedSrc @@ path url [ inline @@ Text name ], Some page)
       in
       let summary =
@@ -1022,11 +1038,9 @@ module Make (Syntax : SYNTAX) = struct
         | Some csig ->
             let url = Url.Path.from_identifier t.id 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
+            let page =
+              make_expansion_page name `Cty url [ t.doc; expansion_doc ] items
             in
-            let page = { Page.title = name; header; items; url } in
             (O.documentedSrc @@ path url [ inline @@ Text name ], Some page)
       in
       let summary = O.txt " = " ++ class_type_expr t.expr in
@@ -1137,12 +1151,9 @@ module Make (Syntax : SYNTAX) = struct
             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)
-                @ Comment.standalone expansion_doc
+              let content =
+                make_expansion_page name `Arg url [ expansion_doc ] items
               in
-              let title = name in
-              let content = { Page.items; title; header; url } in
               let summary = O.render modtyp in
               let status = `Default in
               let expansion =
@@ -1261,17 +1272,17 @@ module Make (Syntax : SYNTAX) = struct
         match expansion with
         | None -> (O.documentedSrc (O.txt modname), `Default, None)
         | 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
               | _ -> `Default
             in
             let url = Url.Path.from_identifier t.id in
             let link = path url [ inline @@ Text modname ] in
-            let title = modname in
-            let header = format_title `Mod (make_name_from_path url) @ doc in
-            let page = { Page.items; title; header; url } in
+            let page =
+              make_expansion_page modname `Mod url [ t.doc; expansion_doc ]
+                items
+            in
             (O.documentedSrc link, status, Some page)
       in
       let summary = mdexpr_in_decl t.id t.type_ in
@@ -1326,12 +1337,12 @@ module Make (Syntax : SYNTAX) = struct
         match expansion with
         | None -> (O.documentedSrc @@ O.txt modname, None)
         | 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
-            let header = format_title `Mty (make_name_from_path url) @ doc in
-            let page = { Page.items; title; header; url } in
+            let page =
+              make_expansion_page modname `Mty url [ t.doc; expansion_doc ]
+                items
+            in
             (O.documentedSrc link, Some page)
       in
       let summary =
@@ -1574,8 +1585,7 @@ module Make (Syntax : SYNTAX) = struct
         | Module sign -> signature sign
         | Pack packed -> ([], pack packed)
       in
-      let header = format_title `Mod title @ Comment.standalone unit_doc in
-      { Page.title; header; items; url }
+      make_expansion_page title ~header_title:title `Mod url [ unit_doc ] items
 
     let page (t : Odoc_model.Lang.Page.t) : Page.t =
       let name =

diff --git a/src/document/utils.ml b/src/document/utils.ml
@@ -11,3 +11,11 @@ let rec flatmap ?sep ~f = function
 let rec skip_until ~p = function
   | [] -> []
   | h :: t -> if p h then t else skip_until ~p t
+
+let split_at ~f lst =
+  let rec loop acc = function
+    | hd :: _ as rest when f hd -> (List.rev acc, rest)
+    | [] -> (List.rev acc, [])
+    | hd :: tl -> loop (hd :: acc) tl
+  in
+  loop [] lst
diff --git a/test/html/expect/test_package+ml/Labels/index.html b/test/html/expect/test_package+ml/Labels/index.html
@@ -21,18 +21,21 @@
    <h1>
     Module <code><span>Labels</span></code>
    </h1>
-   <h2 id="L1">
-    <a href="#L1" class="anchor"></a>Attached to unit
-   </h2>
   </header>
   <nav class="odoc-toc">
    <ul>
+    <li>
+     <a href="#L1">Attached to unit</a>
+    </li>
     <li>
      <a href="#L2">Attached to nothing</a>
     </li>
    </ul>
   </nav>
   <div class="odoc-content">
+   <h2 id="L1">
+    <a href="#L1" class="anchor"></a>Attached to unit
+   </h2>
    <h2 id="L2">
     <a href="#L2" class="anchor"></a>Attached to nothing
    </h2>

diff --git a/test/html/expect/test_package+ml/Nested/F/argument-1-Arg1/index.html b/test/html/expect/test_package+ml/Nested/F/argument-1-Arg1/index.html
@@ -21,18 +21,21 @@
    <h1>
     Parameter <code><span>F.1-Arg1</span></code>
    </h1>
-   <h2 id="type">
-    <a href="#type" class="anchor"></a>Type
-   </h2>
   </header>
   <nav class="odoc-toc">
    <ul>
+    <li>
+     <a href="#type">Type</a>
+    </li>
     <li>
      <a href="#values">Values</a>
     </li>
    </ul>
   </nav>
   <div class="odoc-content">
+   <h2 id="type">
+    <a href="#type" class="anchor"></a>Type
+   </h2>
    <div class="odoc-spec">
     <div class="spec type" id="type-t">
      <a href="#type-t" class="anchor"></a><code><span><span class="keyword">type</span> t</span></code>

diff --git a/test/html/expect/test_package+ml/Nested/F/argument-2-Arg2/index.html b/test/html/expect/test_package+ml/Nested/F/argument-2-Arg2/index.html
@@ -21,11 +21,18 @@
    <h1>
     Parameter <code><span>F.2-Arg2</span></code>
    </h1>
+  </header>
+  <nav class="odoc-toc">
+   <ul>
+    <li>
+     <a href="#type">Type</a>
+    </li>
+   </ul>
+  </nav>
+  <div class="odoc-content">
    <h2 id="type">
     <a href="#type" class="anchor"></a>Type
    </h2>
-  </header>
-  <div class="odoc-content">
    <div class="odoc-spec">
     <div class="spec type" id="type-t">
      <a href="#type-t" class="anchor"></a><code><span><span class="keyword">type</span> t</span></code>

diff --git a/test/html/expect/test_package+ml/Nested/F/index.html b/test/html/expect/test_package+ml/Nested/F/index.html
@@ -27,12 +27,12 @@ <h1>
    <p>
     Some additional comments.
    </p>
-   <h2 id="type">
-    <a href="#type" class="anchor"></a>Type
-   </h2>
   </header>
   <nav class="odoc-toc">
    <ul>
+    <li>
+     <a href="#type">Type</a>
+    </li>
     <li>
      <a href="#parameters">Parameters</a>
     </li>
@@ -42,6 +42,9 @@ <h2 id="type">
    </ul>
   </nav>
   <div class="odoc-content">
+   <h2 id="type">
+    <a href="#type" class="anchor"></a>Type
+   </h2>
    <h2 id="parameters">
     <a href="#parameters" class="anchor"></a>Parameters
    </h2>

diff --git a/test/html/expect/test_package+ml/Nested/X/index.html b/test/html/expect/test_package+ml/Nested/X/index.html
@@ -27,18 +27,21 @@ <h1>
    <p>
     Some additional comments.
    </p>
-   <h2 id="type">
-    <a href="#type" class="anchor"></a>Type
-   </h2>
   </header>
   <nav class="odoc-toc">
    <ul>
+    <li>
+     <a href="#type">Type</a>
+    </li>
     <li>
      <a href="#values">Values</a>
     </li>
    </ul>
   </nav>
   <div class="odoc-content">
+   <h2 id="type">
+    <a href="#type" class="anchor"></a>Type
+   </h2>
    <div class="odoc-spec">
     <div class="spec type" id="type-t">
      <a href="#type-t" class="anchor"></a><code><span><span class="keyword">type</span> t</span></code>

diff --git a/test/html/expect/test_package+ml/Nested/module-type-Y/index.html b/test/html/expect/test_package+ml/Nested/module-type-Y/index.html
@@ -27,18 +27,21 @@ <h1>
    <p>
     Some additional comments.
    </p>
-   <h2 id="type">
-    <a href="#type" class="anchor"></a>Type
-   </h2>
   </header>
   <nav class="odoc-toc">
    <ul>
+    <li>
+     <a href="#type">Type</a>
+    </li>
     <li>
      <a href="#values">Values</a>
     </li>
    </ul>
   </nav>
   <div class="odoc-content">
+   <h2 id="type">
+    <a href="#type" class="anchor"></a>Type
+   </h2>
    <div class="odoc-spec">
     <div class="spec type" id="type-t">
      <a href="#type-t" class="anchor"></a><code><span><span class="keyword">type</span> t</span></code>

diff --git a/test/html/expect/test_package+re/Labels/index.html b/test/html/expect/test_package+re/Labels/index.html
@@ -21,18 +21,21 @@
    <h1>
     Module <code><span>Labels</span></code>
    </h1>
-   <h2 id="L1">
-    <a href="#L1" class="anchor"></a>Attached to unit
-   </h2>
   </header>
   <nav class="odoc-toc">
    <ul>
+    <li>
+     <a href="#L1">Attached to unit</a>
+    </li>
     <li>
      <a href="#L2">Attached to nothing</a>
     </li>
    </ul>
   </nav>
   <div class="odoc-content">
+   <h2 id="L1">
+    <a href="#L1" class="anchor"></a>Attached to unit
+   </h2>
    <h2 id="L2">
     <a href="#L2" class="anchor"></a>Attached to nothing
    </h2>

diff --git a/test/html/expect/test_package+re/Nested/F/argument-1-Arg1/index.html b/test/html/expect/test_package+re/Nested/F/argument-1-Arg1/index.html
@@ -21,18 +21,21 @@
    <h1>
     Parameter <code><span>F.1-Arg1</span></code>
    </h1>
-   <h2 id="type">
-    <a href="#type" class="anchor"></a>Type
-   </h2>
   </header>
   <nav class="odoc-toc">
    <ul>
+    <li>
+     <a href="#type">Type</a>
+    </li>
     <li>
      <a href="#values">Values</a>
     </li>
    </ul>
   </nav>
   <div class="odoc-content">
+   <h2 id="type">
+    <a href="#type" class="anchor"></a>Type
+   </h2>
    <div class="odoc-spec">
     <div class="spec type" id="type-t">
      <a href="#type-t" class="anchor"></a><code><span><span class="keyword">type</span> t</span><span>;</span></code>

diff --git a/test/html/expect/test_package+re/Nested/F/argument-2-Arg2/index.html b/test/html/expect/test_package+re/Nested/F/argument-2-Arg2/index.html
@@ -21,11 +21,18 @@
    <h1>
     Parameter <code><span>F.2-Arg2</span></code>
    </h1>
+  </header>
+  <nav class="odoc-toc">
+   <ul>
+    <li>
+     <a href="#type">Type</a>
+    </li>
+   </ul>
+  </nav>
+  <div class="odoc-content">
    <h2 id="type">
     <a href="#type" class="anchor"></a>Type
    </h2>
-  </header>
-  <div class="odoc-content">
    <div class="odoc-spec">
     <div class="spec type" id="type-t">
      <a href="#type-t" class="anchor"></a><code><span><span class="keyword">type</span> t</span><span>;</span></code>