refactor Page to remove kind and title, as these are both in url

sabine · jonludlam · commit 2a1afb7d3a1f · 2022-11-18T14:09:28.000Z
diff --git a/src/document/doctree.ml b/src/document/doctree.ml
@@ -296,20 +296,19 @@ end = struct
     in
     match kind with
     | `Module -> prefix "Module"
-    | `Argument -> prefix "Parameter"
+    | `Parameter -> prefix "Parameter"
     | `ModuleType -> prefix "Module type"
     | `ClassType -> prefix "Class type"
     | `Class -> prefix "Class"
-    | `Page -> []
+    | `Page | `LeafPage | `File -> []
 
-  let make_name_from_path { Url.Path.name; parent; _ } =
+  let make_name_from_path { Url.Path.path_fragment; parent; _ } =
     match parent with
-    | None | Some { kind = `Page; _ } -> name
-    | Some p -> Printf.sprintf "%s.%s" p.name name
+    | None | Some { kind = `Page; _ } -> path_fragment
+    | Some p -> Printf.sprintf "%s.%s" p.path_fragment path_fragment
 
   let render_title (p : Page.t) =
-    format_title p.kind
-      (make_name_from_path p.url)
+    format_title p.url.kind (make_name_from_path p.url)
 end
 
 module Math : sig
diff --git a/src/document/generator.ml b/src/document/generator.ml
@@ -72,10 +72,10 @@ let prepare_preamble comment items =
   in
   (Comment.standalone preamble, Comment.standalone first_comment @ items)
 
-let make_expansion_page title kind url comments items =
+let make_expansion_page url comments items =
   let comment = List.concat comments in
   let preamble, items = prepare_preamble comment items in
-  { Page.title; kind; preamble; items; url }
+  { Page.preamble; items; url }
 
 include Generator_signatures
 
@@ -1009,9 +1009,7 @@ 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 page =
-              make_expansion_page name `Class url [ t.doc; expansion_doc ] items
-            in
+            let page = make_expansion_page url [ t.doc; expansion_doc ] items in
             ( O.documentedSrc @@ path url [ inline @@ Text name ],
               Some page,
               Some expansion_doc )
@@ -1046,10 +1044,7 @@ 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 page =
-              make_expansion_page name `ClassType url [ t.doc; expansion_doc ]
-                items
-            in
+            let page = make_expansion_page url [ t.doc; expansion_doc ] items in
             ( O.documentedSrc @@ path url [ inline @@ Text name ],
               Some page,
               Some expansion_doc )
@@ -1173,9 +1168,7 @@ 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 content =
-                make_expansion_page name `Argument url [ expansion_doc ] items
-              in
+              let content = make_expansion_page url [ expansion_doc ] items in
               let summary = O.render modtyp in
               let status = `Default in
               let expansion =
@@ -1323,10 +1316,7 @@ module Make (Syntax : SYNTAX) = struct
             in
             let url = Url.Path.from_identifier t.id in
             let link = path url [ inline @@ Text modname ] in
-            let page =
-              make_expansion_page modname `Module url [ t.doc; expansion_doc ]
-                items
-            in
+            let page = make_expansion_page url [ t.doc; expansion_doc ] items in
             (link, status, Some page, Some expansion_doc)
       in
       let intro = O.keyword "module" ++ O.txt " " ++ modname in
@@ -1382,10 +1372,7 @@ module Make (Syntax : SYNTAX) = struct
         | Some (expansion_doc, items) ->
             let url = Url.Path.from_identifier id in
             let link = path url [ inline @@ Text modname ] in
-            let page =
-              make_expansion_page modname `ModuleType url [ doc; expansion_doc ]
-                items
-            in
+            let page = make_expansion_page url [ doc; expansion_doc ] items in
             (link, Some page, Some expansion_doc)
       in
       let summary =
@@ -1659,24 +1646,22 @@ module Make (Syntax : SYNTAX) = struct
       List.map f t
 
     let compilation_unit (t : Odoc_model.Lang.Compilation_unit.t) : Page.t =
-      let title = Paths.Identifier.name t.id in
       let url = Url.Path.from_identifier t.id in
       let unit_doc, items =
         match t.content with
         | Module sign -> signature sign
         | Pack packed -> ([], pack packed)
       in
-      make_expansion_page title `Module url [ unit_doc ] items
+      make_expansion_page 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 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 preamble, items = Sectioning.docs t.content in
-      let kind = `Page in
-      { Page.title; kind; preamble; items; url }
+      { Page.preamble; items; url }
   end
 
   include Page
diff --git a/src/document/types.ml b/src/document/types.ml
@@ -157,21 +157,7 @@ end =
   Item
 
 and Page : sig
-  type kind =
-    [ `Module
-    | `Argument
-    | `ModuleType
-    | `ClassType
-    | `Class
-    | `Page ]
-
-  type t = {
-    title : string;
-    kind : kind;
-    preamble : Item.t list;
-    items : Item.t list;
-    url : Url.Path.t;
-  }
+  type t = { preamble : Item.t list; items : Item.t list; url : Url.Path.t }
 end =
   Page
 
diff --git a/src/document/url.ml b/src/document/url.ml
@@ -98,7 +98,7 @@ module Path = struct
     | `Page
     | `LeafPage
     | `ModuleType
-    | `Argument
+    | `Parameter
     | `Class
     | `ClassType
     | `File ]
@@ -108,16 +108,16 @@ module Path = struct
     | `Module -> "module"
     | `LeafPage -> "leaf-page"
     | `ModuleType -> "module-type"
-    | `Argument -> "argument"
+    | `Parameter -> "argument"
     | `Class -> "class"
     | `ClassType -> "class-type"
     | `File -> "file"
 
   let pp_kind fmt kind = Format.fprintf fmt "%s" (string_of_kind kind)
 
-  type t = { kind : kind; parent : t option; name : string }
+  type t = { kind : kind; parent : t option; path_fragment : string }
 
-  let mk ?parent kind name = { kind; parent; name }
+  let mk ?parent kind path_fragment = { kind; parent; path_fragment }
 
   let rec from_identifier : source -> t =
    fun x ->
@@ -129,72 +129,73 @@ module Path = struct
           | None -> None
         in
         let kind = `Module in
-        let page = ModuleName.to_string unit_name in
-        mk ?parent kind page
+        let path_fragment = ModuleName.to_string unit_name in
+        mk ?parent kind path_fragment
     | { iv = `Page (parent, page_name); _ } ->
         let parent =
           match parent with
           | Some p -> Some (from_identifier (p :> source))
           | None -> None
         in
         let kind = `Page in
-        let page = PageName.to_string page_name in
-        mk ?parent kind page
+        let path_fragment = PageName.to_string page_name in
+        mk ?parent kind path_fragment
     | { iv = `LeafPage (parent, page_name); _ } ->
         let parent =
           match parent with
           | Some p -> Some (from_identifier (p :> source))
           | None -> None
         in
         let kind = `LeafPage in
-        let page = PageName.to_string page_name in
-        mk ?parent kind page
+        let path_fragment = PageName.to_string page_name in
+        mk ?parent kind path_fragment
     | { iv = `Module (parent, mod_name); _ } ->
         let parent = from_identifier (parent :> source) in
         let kind = `Module in
-        let page = ModuleName.to_string mod_name in
-        mk ~parent kind page
+        let path_fragment = ModuleName.to_string mod_name in
+        mk ~parent kind path_fragment
     | { iv = `Parameter (functor_id, arg_name); _ } as p ->
         let parent = from_identifier (functor_id :> source) in
-        let kind = `Argument in
+        let kind = `Parameter in
         let arg_num = functor_arg_pos p in
-        let page =
+        let path_fragment =
           Printf.sprintf "%d-%s" arg_num (ModuleName.to_string arg_name)
         in
-        mk ~parent kind page
+        mk ~parent kind path_fragment
     | { iv = `ModuleType (parent, modt_name); _ } ->
         let parent = from_identifier (parent :> source) in
         let kind = `ModuleType in
-        let page = ModuleTypeName.to_string modt_name in
-        mk ~parent kind page
+        let path_fragment = ModuleTypeName.to_string modt_name in
+        mk ~parent kind path_fragment
     | { iv = `Class (parent, name); _ } ->
         let parent = from_identifier (parent :> source) in
         let kind = `Class in
-        let page = ClassName.to_string name in
-        mk ~parent kind page
+        let path_fragment = ClassName.to_string name in
+        mk ~parent kind path_fragment
     | { iv = `ClassType (parent, name); _ } ->
         let parent = from_identifier (parent :> source) in
         let kind = `ClassType in
-        let page = ClassTypeName.to_string name in
-        mk ~parent kind page
+        let path_fragment = ClassTypeName.to_string name in
+        mk ~parent kind path_fragment
     | { iv = `Result p; _ } -> from_identifier (p :> source)
 
   let from_identifier p =
     from_identifier
       (p : [< source_pv ] Odoc_model.Paths.Identifier.id :> source)
 
   let to_list url =
-    let rec loop acc { parent; name; kind } =
+    let rec loop acc { parent; path_fragment; kind } =
       match parent with
-      | None -> (kind, name) :: acc
-      | Some p -> loop ((kind, name) :: acc) p
+      | None -> (kind, path_fragment) :: acc
+      | Some p -> loop ((kind, path_fragment) :: acc) p
     in
     loop [] url
 
   let of_list l =
     let rec inner parent = function
       | [] -> parent
-      | (kind, name) :: xs -> inner (Some { parent; name; kind }) xs
+      | (kind, path_fragment) :: xs ->
+          inner (Some { parent; path_fragment; kind }) xs
     in
     inner None l
 
@@ -242,11 +243,13 @@ module Anchor = struct
 
   type t = { page : Path.t; anchor : string; kind : kind }
 
-  let anchorify_path { Path.parent; name; kind } =
+  let anchorify_path { Path.parent; path_fragment; kind } =
     match parent with
     | None -> assert false (* We got a root, should never happen *)
     | Some page ->
-        let anchor = Printf.sprintf "%s-%s" (Path.string_of_kind kind) name in
+        let anchor =
+          Printf.sprintf "%s-%s" (Path.string_of_kind kind) path_fragment
+        in
         { page; anchor; kind = (kind :> kind) }
 
   let add_suffix ~kind { page; anchor; _ } suffix =
diff --git a/src/document/url.mli b/src/document/url.mli
@@ -17,7 +17,7 @@ module Path : sig
     | `Page
     | `LeafPage
     | `ModuleType
-    | `Argument
+    | `Parameter
     | `Class
     | `ClassType
     | `File ]
@@ -26,7 +26,7 @@ module Path : sig
 
   val string_of_kind : kind -> string
 
-  type t = { kind : kind; parent : t option; name : string }
+  type t = { kind : kind; parent : t option; path_fragment : string }
 
   type source_pv =
     [ Identifier.Page.t_pv
diff --git a/src/html/generator.ml b/src/html/generator.ml
@@ -389,8 +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; kind = _; preamble; items = i; url } =
-      Doctree.Labels.disambiguate_page p
+    let { Page.preamble; items = i; url } = Doctree.Labels.disambiguate_page p
     and subpages =
       (* Don't use the output of [disambiguate_page] to avoid unecessarily
          mangled labels. *)
@@ -404,7 +403,20 @@ module Page = struct
       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
+    let name =
+      match url.kind with
+      | `Parameter ->
+          let i =
+            try String.index url.path_fragment '-'
+            with Not_found ->
+              print_endline url.path_fragment;
+              0
+          in
+          String.sub url.path_fragment (i + 1)
+            (String.length url.path_fragment - i - 1)
+      | _ -> url.path_fragment
+    in
+    Tree.make ~config ~header ~toc ~url ~uses_katex name content subpages
 end
 
 let render ~config page = Page.page ~config page
diff --git a/src/html/tree.ml b/src/html/tree.ml
@@ -43,7 +43,8 @@ let page_creator ~config ~url ~uses_katex name header toc content =
       | Types.Absolute uri -> uri ^ "/" ^ file
       | Relative uri ->
           let page =
-            Odoc_document.Url.Path.{ kind = `File; parent = uri; name = file }
+            Odoc_document.Url.Path.
+              { kind = `File; parent = uri; path_fragment = file }
           in
           Link.href ~config ~resolve:(Current url)
             (Odoc_document.Url.from_path page)
@@ -127,12 +128,12 @@ let page_creator ~config ~url ~uses_katex name header toc content =
     match parents with
     | [] -> [] (* Can't happen - Url.Path.to_list returns a non-empty list *)
     | [ _ ] -> [] (* No parents *)
-    | [ x; { name = "index"; _ } ] ->
+    | [ x; { path_fragment = "index"; _ } ] ->
         (* Special case leaf pages called 'index' with one parent. This is for files called
            index.mld that would otherwise clash with their parent. In particular,
            dune and odig both cause this situation right now. *)
         let up_url = "../index.html" in
-        let parent_name = x.name in
+        let parent_name = x.path_fragment in
         make_navigation ~up_url [ Html.txt parent_name ]
     | _ ->
         let up_url = href ~config (List.hd (List.tl (List.rev parents))) in
@@ -145,11 +146,11 @@ let page_creator ~config ~url ~uses_katex name header toc content =
                ~f:(fun url' ->
                  [
                    [
-                     (if url = url' then Html.txt url.name
+                     (if url = url' then Html.txt url.path_fragment
                      else
                        Html.a
                          ~a:[ Html.a_href (href ~config url') ]
-                         [ Html.txt url'.name ]);
+                         [ Html.txt url'.path_fragment ]);
                    ];
                  ])
           |> List.flatten
diff --git a/src/latex/generator.ml b/src/latex/generator.ml
diff --git a/src/manpage/generator.ml b/src/manpage/generator.ml
diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml
