title formatting is now a renderer decision

Author: sabine

src/document/doctree.ml

@@ -91,7 +91,7 @@ end = struct
       | Declaration { content; _ } -> walk_documentedsrc content
       | Include i -> walk_items i.content.content)
 
-  let compute (p : Page.t) = walk_items (p.header @ p.items)
+  let compute (p : Page.t) = walk_items (p.preamble @ p.items)
 end
 
 module Shift = struct
@@ -133,7 +133,7 @@ module Shift = struct
         let content =
           {
             page with
-            header = walk_item ~on_sub shift_state page.header;
+            preamble = walk_item ~on_sub shift_state page.preamble;
             items = walk_item ~on_sub shift_state page.items;
           }
         in
@@ -183,7 +183,7 @@ module Headings : sig
 end = struct
   let fold =
     let rec w_page f acc page =
-      w_items f (w_items f acc page.Page.header) page.items
+      w_items f (w_items f acc page.Page.preamble) page.items
     and w_items f acc ts = List.fold_left (w_item f) acc ts
     and w_item f acc = function
       | Heading h -> f acc h
@@ -209,9 +209,9 @@ end = struct
 
   let foldmap =
     let rec w_page f acc page =
-      let acc, header = w_items f acc page.Page.header in
+      let acc, preamble = w_items f acc page.Page.preamble in
       let acc, items = w_items f acc page.items in
-      (acc, { page with header; items })
+      (acc, { page with preamble; items })
     and w_items f acc items = foldmap_left (w_item f) acc items
     and w_item f acc = function
       | Heading h ->
@@ -283,6 +283,35 @@ end = struct
     |> snd
 end
 
+module PageTitle : sig
+  val render_title : Page.t -> Item.t list
+end = struct
+  let format_title kind name =
+    let mk title =
+      let level = 0 and label = None in
+      [ Types.Item.Heading { level; label; title } ]
+    in
+    let prefix s =
+      mk (Types.inline (Text (s ^ " ")) :: Codefmt.code (Codefmt.txt name))
+    in
+    match kind with
+    | `Module -> prefix "Module"
+    | `Argument -> prefix "Parameter"
+    | `ModuleType -> prefix "Module type"
+    | `ClassType -> prefix "Class type"
+    | `Class -> prefix "Class"
+    | `Page -> []
+
+  let make_name_from_path { Url.Path.name; parent; _ } =
+    match parent with
+    | None | Some { kind = `Page; _ } -> name
+    | Some p -> Printf.sprintf "%s.%s" p.name name
+
+  let render_title (p : Page.t) =
+    format_title p.kind
+      (make_name_from_path p.url)
+end
+
 module Math : sig
   val has_math_elements : Page.t -> bool
 end = struct

src/document/generator.ml

@@ -21,26 +21,6 @@ open Types
 module O = Codefmt
 open O.Infix
 
-(* TODO: Title formatting should be a renderer decision *)
-let format_title kind name =
-  let mk title =
-    let level = 0 and label = None in
-    [ Item.Heading { level; label; title } ]
-  in
-  let prefix s = mk (inline (Text (s ^ " ")) :: O.code (O.txt name)) in
-  match kind with
-  | `Mod -> prefix "Module"
-  | `Arg -> prefix "Parameter"
-  | `Mty -> prefix "Module type"
-  | `Cty -> prefix "Class type"
-  | `Class -> prefix "Class"
-  | `Page -> mk [ inline @@ Text name ]
-
-let make_name_from_path { Url.Path.name; parent; _ } =
-  match parent with
-  | None -> name
-  | Some p -> Printf.sprintf "%s.%s" p.name name
-
 let label t =
   match t with
   | Odoc_model.Lang.TypeExpr.Label s -> O.txt s
@@ -92,12 +72,10 @@ let prepare_preamble comment items =
   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 make_expansion_page title kind 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 }
+  { Page.title; kind; preamble; items; url }
 
 include Generator_signatures
 
@@ -1069,7 +1047,8 @@ module Make (Syntax : SYNTAX) = struct
             let url = Url.Path.from_identifier t.id in
             let expansion_doc, items = class_signature csig in
             let page =
-              make_expansion_page name `Cty url [ t.doc; expansion_doc ] items
+              make_expansion_page name `ClassType url [ t.doc; expansion_doc ]
+                items
             in
             ( O.documentedSrc @@ path url [ inline @@ Text name ],
               Some page,
@@ -1195,7 +1174,7 @@ module Make (Syntax : SYNTAX) = struct
             let modname = path url [ inline @@ Text name ] in
             let type_with_expansion =
               let content =
-                make_expansion_page name `Arg url [ expansion_doc ] items
+                make_expansion_page name `Argument url [ expansion_doc ] items
               in
               let summary = O.render modtyp in
               let status = `Default in
@@ -1345,7 +1324,7 @@ module Make (Syntax : SYNTAX) = struct
             let url = Url.Path.from_identifier t.id in
             let link = path url [ inline @@ Text modname ] in
             let page =
-              make_expansion_page modname `Mod url [ t.doc; expansion_doc ]
+              make_expansion_page modname `Module url [ t.doc; expansion_doc ]
                 items
             in
             (link, status, Some page, Some expansion_doc)
@@ -1404,7 +1383,8 @@ module Make (Syntax : SYNTAX) = struct
             let url = Url.Path.from_identifier id in
             let link = path url [ inline @@ Text modname ] in
             let page =
-              make_expansion_page modname `Mty url [ doc; expansion_doc ] items
+              make_expansion_page modname `ModuleType url [ doc; expansion_doc ]
+                items
             in
             (link, Some page, Some expansion_doc)
       in
@@ -1686,16 +1666,17 @@ module Make (Syntax : SYNTAX) = struct
         | Module sign -> signature sign
         | Pack packed -> ([], pack packed)
       in
-      make_expansion_page title ~header_title:title `Mod url [ unit_doc ] items
+      make_expansion_page title `Module url [ unit_doc ] items
 
     let page (t : Odoc_model.Lang.Page.t) : Page.t =
       let name =
         match t.name.iv with `Page (_, name) | `LeafPage (_, name) -> name
       in
       let title = Odoc_model.Names.PageName.to_string name in
       let url = Url.Path.from_identifier t.name in
-      let header, items = Sectioning.docs t.content in
-      { Page.title; header; items; url }
+      let preamble, items = Sectioning.docs t.content in
+      let kind = `Page in
+      { Page.title; kind; preamble; items; url }
   end
 
   include Page

src/document/types.ml

@@ -157,9 +157,18 @@ end =
   Item
 
 and Page : sig
+  type kind =
+    [ `Module
+    | `Argument
+    | `ModuleType
+    | `ClassType
+    | `Class
+    | `Page ]
+
   type t = {
     title : string;
-    header : Item.t list;
+    kind : kind;
+    preamble : Item.t list;
     items : Item.t list;
     url : Url.Path.t;
   }

src/html/generator.ml

@@ -367,7 +367,7 @@ module Toc = struct
       in
       let title_str =
         List.map (Format.asprintf "%a" (Tyxml.Html.pp_elt ())) text
-        |> String.concat " "
+        |> String.concat ""
       in
       let href = Link.href ~config ~resolve url in
       { title; title_str; href; children = List.map section children }
@@ -389,7 +389,7 @@ module Page = struct
     Utils.list_concat_map ~f:(include_ ~config) subpages
 
   and page ~config p : Odoc_document.Renderer.page list =
-    let { Page.title; header; items = i; url } =
+    let { Page.title; kind = _; preamble; items = i; url } =
       Doctree.Labels.disambiguate_page p
     and subpages =
       (* Don't use the output of [disambiguate_page] to avoid unecessarily
@@ -400,7 +400,9 @@ module Page = struct
     let i = Doctree.Shift.compute ~on_sub i in
     let uses_katex = Doctree.Math.has_math_elements p in
     let toc = Toc.gen_toc ~config ~resolve ~path:url i in
-    let header = items ~config ~resolve header in
+    let header =
+      items ~config ~resolve (Doctree.PageTitle.render_title p @ preamble)
+    in
     let content = (items ~config ~resolve i :> any Html.elt list) in
     Tree.make ~config ~header ~toc ~url ~uses_katex title content subpages
 end

src/latex/generator.ml

@@ -459,11 +459,11 @@ module Page = struct
     List.flatten @@ List.map (subpage ~with_children) subpages
 
   and page ~with_children p =
-    let { Page.title = _; header; items = i; url } =
+    let { Page.title = _; kind = _; preamble; items = i; url } =
       Doctree.Labels.disambiguate_page p
     and subpages = subpages ~with_children @@ Doctree.Subpages.compute p in
     let i = Doctree.Shift.compute ~on_sub i in
-    let header = items header in
+    let header = items (Doctree.PageTitle.render_title p @ preamble) in
     let content = items i in
     let page = Doc.make ~with_children url (header @ content) subpages in
     page

src/manpage/generator.ml

@@ -431,7 +431,7 @@ let rec documentedSrc (l : DocumentedSrc.t) =
           let l = list ~sep:break (List.map f lines) in
           indent 2 (break ++ l) ++ break_if_nonempty rest ++ continue rest)
 
-and subpage { title = _; header = _; items; url = _ } =
+and subpage { title = _; kind = _; preamble = _; items; url = _ } =
   let content = items in
   let surround body =
     if content = [] then sp else indent 2 (break ++ body) ++ break
@@ -476,13 +476,15 @@ let on_sub subp =
   | `Page p -> if Link.should_inline p.Subpage.content.url then Some 1 else None
   | `Include incl -> if inline_subpage incl.Include.status then Some 0 else None
 
-let page { Page.title; header; items = i; url } =
+let page p =
   reset_heading ();
-  let header = Shift.compute ~on_sub header in
-  let i = Shift.compute ~on_sub i in
-  macro "TH" {|%s 3 "" "Odoc" "OCaml Library"|} title
+  let header =
+    Doctree.PageTitle.render_title p @ Shift.compute ~on_sub p.preamble
+  in
+  let i = Shift.compute ~on_sub p.items in
+  macro "TH" {|%s 3 "" "Odoc" "OCaml Library"|} p.title
   ++ macro "SH" "Name"
-  ++ str "%s" (String.concat "." @@ Link.for_printing url)
+  ++ str "%s" (String.concat "." @@ Link.for_printing p.url)
   ++ macro "SH" "Synopsis" ++ vspace ++ item ~nested:false header
   ++ macro "SH" "Documentation" ++ vspace ++ macro "nf" ""
   ++ item ~nested:false i