remove prefix for parameters from Url.Path, output file structure is unchanged, but the breadcrumb names are without the prefix now

Author: sabine

src/document/doctree.ml

@@ -296,16 +296,16 @@ end = struct
     in
     match kind with
     | `Module -> prefix "Module"
-    | `Parameter -> prefix "Parameter"
+    | `Parameter _ -> prefix "Parameter"
     | `ModuleType -> prefix "Module type"
     | `ClassType -> prefix "Class type"
     | `Class -> prefix "Class"
     | `Page | `LeafPage | `File -> []
 
-  let make_name_from_path { Url.Path.path_fragment; parent; _ } =
+  let make_name_from_path { Url.Path.name; parent; _ } =
     match parent with
-    | None | Some { kind = `Page; _ } -> path_fragment
-    | Some p -> Printf.sprintf "%s.%s" p.path_fragment path_fragment
+    | None | Some { kind = `Page; _ } -> name
+    | Some p -> Printf.sprintf "%s.%s" p.name name
 
   let render_title (p : Page.t) =
     format_title p.url.kind (make_name_from_path p.url)

src/document/url.ml

@@ -98,7 +98,7 @@ module Path = struct
     | `Page
     | `LeafPage
     | `ModuleType
-    | `Parameter
+    | `Parameter of int
     | `Class
     | `ClassType
     | `File ]
@@ -108,16 +108,16 @@ module Path = struct
     | `Module -> "module"
     | `LeafPage -> "leaf-page"
     | `ModuleType -> "module-type"
-    | `Parameter -> "argument"
+    | `Parameter arg_num -> Printf.sprintf "argument-%d" arg_num
     | `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; path_fragment : string }
+  type t = { kind : kind; parent : t option; name : string }
 
-  let mk ?parent kind path_fragment = { kind; parent; path_fragment }
+  let mk ?parent kind name = { kind; parent; name }
 
   let rec from_identifier : source -> t =
    fun x ->
@@ -129,73 +129,70 @@ module Path = struct
           | None -> None
         in
         let kind = `Module in
-        let path_fragment = ModuleName.to_string unit_name in
-        mk ?parent kind path_fragment
+        let name = ModuleName.to_string unit_name in
+        mk ?parent kind name
     | { 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 path_fragment = PageName.to_string page_name in
-        mk ?parent kind path_fragment
+        let name = PageName.to_string page_name in
+        mk ?parent kind name
     | { 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 path_fragment = PageName.to_string page_name in
-        mk ?parent kind path_fragment
+        let name = PageName.to_string page_name in
+        mk ?parent kind name
     | { iv = `Module (parent, mod_name); _ } ->
         let parent = from_identifier (parent :> source) in
         let kind = `Module in
-        let path_fragment = ModuleName.to_string mod_name in
-        mk ~parent kind path_fragment
+        let name = ModuleName.to_string mod_name in
+        mk ~parent kind name
     | { iv = `Parameter (functor_id, arg_name); _ } as p ->
         let parent = from_identifier (functor_id :> source) in
-        let kind = `Parameter in
         let arg_num = functor_arg_pos p in
-        let path_fragment =
-          Printf.sprintf "%d-%s" arg_num (ModuleName.to_string arg_name)
-        in
-        mk ~parent kind path_fragment
+        let kind = `Parameter arg_num in
+        let name = ModuleName.to_string arg_name in
+        mk ~parent kind name
     | { iv = `ModuleType (parent, modt_name); _ } ->
         let parent = from_identifier (parent :> source) in
         let kind = `ModuleType in
-        let path_fragment = ModuleTypeName.to_string modt_name in
-        mk ~parent kind path_fragment
+        let name = ModuleTypeName.to_string modt_name in
+        mk ~parent kind name
     | { iv = `Class (parent, name); _ } ->
         let parent = from_identifier (parent :> source) in
         let kind = `Class in
-        let path_fragment = ClassName.to_string name in
-        mk ~parent kind path_fragment
+        let name = ClassName.to_string name in
+        mk ~parent kind name
     | { iv = `ClassType (parent, name); _ } ->
         let parent = from_identifier (parent :> source) in
         let kind = `ClassType in
-        let path_fragment = ClassTypeName.to_string name in
-        mk ~parent kind path_fragment
+        let name = ClassTypeName.to_string name in
+        mk ~parent kind name
     | { 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; path_fragment; kind } =
+    let rec loop acc { parent; name; kind } =
       match parent with
-      | None -> (kind, path_fragment) :: acc
-      | Some p -> loop ((kind, path_fragment) :: acc) p
+      | None -> (kind, name) :: acc
+      | Some p -> loop ((kind, name) :: acc) p
     in
     loop [] url
 
   let of_list l =
     let rec inner parent = function
       | [] -> parent
-      | (kind, path_fragment) :: xs ->
-          inner (Some { parent; path_fragment; kind }) xs
+      | (kind, name) :: xs -> inner (Some { parent; name; kind }) xs
     in
     inner None l
 
@@ -243,13 +240,11 @@ module Anchor = struct
 
   type t = { page : Path.t; anchor : string; kind : kind }
 
-  let anchorify_path { Path.parent; path_fragment; kind } =
+  let anchorify_path { Path.parent; name; 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) path_fragment
-        in
+        let anchor = Printf.sprintf "%s-%s" (Path.string_of_kind kind) name in
         { page; anchor; kind = (kind :> kind) }
 
   let add_suffix ~kind { page; anchor; _ } suffix =

src/document/url.mli

@@ -17,7 +17,7 @@ module Path : sig
     | `Page
     | `LeafPage
     | `ModuleType
-    | `Parameter
+    | `Parameter of int
     | `Class
     | `ClassType
     | `File ]
@@ -26,7 +26,7 @@ module Path : sig
 
   val string_of_kind : kind -> string
 
-  type t = { kind : kind; parent : t option; path_fragment : string }
+  type t = { kind : kind; parent : t option; name : string }
 
   type source_pv =
     [ Identifier.Page.t_pv

src/html/generator.ml

@@ -403,20 +403,7 @@ module Page = struct
       items ~config ~resolve (Doctree.PageTitle.render_title p @ preamble)
     in
     let content = (items ~config ~resolve i :> any Html.elt list) in
-    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
+    Tree.make ~config ~header ~toc ~url ~uses_katex url.name content subpages
 end
 
 let render ~config page = Page.page ~config page

src/html/tree.ml

@@ -43,8 +43,7 @@ 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; path_fragment = file }
+            Odoc_document.Url.Path.{ kind = `File; parent = uri; name = file }
           in
           Link.href ~config ~resolve:(Current url)
             (Odoc_document.Url.from_path page)
@@ -128,12 +127,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; { path_fragment = "index"; _ } ] ->
+    | [ x; { name = "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.path_fragment in
+        let parent_name = x.name in
         make_navigation ~up_url [ Html.txt parent_name ]
     | _ ->
         let up_url = href ~config (List.hd (List.tl (List.rev parents))) in
@@ -146,11 +145,11 @@ let page_creator ~config ~url ~uses_katex name header toc content =
                ~f:(fun url' ->
                  [
                    [
-                     (if url = url' then Html.txt url.path_fragment
+                     (if url = url' then Html.txt url.name
                      else
                        Html.a
                          ~a:[ Html.a_href (href ~config url') ]
-                         [ Html.txt url'.path_fragment ]);
+                         [ Html.txt url'.name ]);
                    ];
                  ])
           |> List.flatten

src/latex/generator.ml

@@ -15,9 +15,8 @@ module Link = struct
     match x.parent with
     | Some p ->
         Fmt.pf ppf "%a-%a-%s" flatten_path p Odoc_document.Url.Path.pp_kind
-          x.kind x.path_fragment
-    | None ->
-        Fmt.pf ppf "%a-%s" Odoc_document.Url.Path.pp_kind x.kind x.path_fragment
+          x.kind x.name
+    | None -> Fmt.pf ppf "%a-%s" Odoc_document.Url.Path.pp_kind x.kind x.name
 
   let page p = Format.asprintf "%a" flatten_path p
 

src/manpage/generator.ml

@@ -482,7 +482,7 @@ let page p =
     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.url.path_fragment
+  macro "TH" {|%s 3 "" "Odoc" "OCaml Library"|} p.url.name
   ++ macro "SH" "Name"
   ++ str "%s" (String.concat "." @@ Link.for_printing p.url)
   ++ macro "SH" "Synopsis" ++ vspace ++ item ~nested:false header

src/odoc/bin/main.ml

@@ -477,7 +477,7 @@ module Odoc_html_args = struct
             ~f:(fun acc seg ->
               Some
                 Odoc_document.Url.Path.
-                  { kind = `Page; parent = acc; path_fragment = seg })
+                  { kind = `Page; parent = acc; name = seg })
             l ~init:None
         in
         `Ok

test/generators/html/Functor-F1-argument-1-Arg.html

@@ -1,6 +1,6 @@
 <!DOCTYPE html>
 <html xmlns="http://www.w3.org/1999/xhtml">
- <head><title>Arg (Functor.F1.1-Arg)</title>
+ <head><title>Arg (Functor.F1.Arg)</title>
   <link rel="stylesheet" href="odoc.css"/><meta charset="utf-8"/>
   <meta name="generator" content="odoc %%VERSION%%"/>
   <meta name="viewport" content="width=device-width,initial-scale=1.0"/>
@@ -10,10 +10,10 @@
  <body class="odoc">
   <nav class="odoc-nav"><a href="Functor-F1.html">Up</a> – 
    <a href="Functor.html">Functor</a> &#x00BB; 
-   <a href="Functor-F1.html">F1</a> &#x00BB; 1-Arg
+   <a href="Functor-F1.html">F1</a> &#x00BB; Arg
   </nav>
   <header class="odoc-preamble">
-   <h1>Parameter <code><span>F1.1-Arg</span></code></h1>
+   <h1>Parameter <code><span>F1.Arg</span></code></h1>
   </header>
   <div class="odoc-content">
    <div class="odoc-spec">

test/generators/html/Functor-F2-argument-1-Arg.html

@@ -1,6 +1,6 @@
 <!DOCTYPE html>
 <html xmlns="http://www.w3.org/1999/xhtml">
- <head><title>Arg (Functor.F2.1-Arg)</title>
+ <head><title>Arg (Functor.F2.Arg)</title>
   <link rel="stylesheet" href="odoc.css"/><meta charset="utf-8"/>
   <meta name="generator" content="odoc %%VERSION%%"/>
   <meta name="viewport" content="width=device-width,initial-scale=1.0"/>
@@ -10,10 +10,10 @@
  <body class="odoc">
   <nav class="odoc-nav"><a href="Functor-F2.html">Up</a> – 
    <a href="Functor.html">Functor</a> &#x00BB; 
-   <a href="Functor-F2.html">F2</a> &#x00BB; 1-Arg
+   <a href="Functor-F2.html">F2</a> &#x00BB; Arg
   </nav>
   <header class="odoc-preamble">
-   <h1>Parameter <code><span>F2.1-Arg</span></code></h1>
+   <h1>Parameter <code><span>F2.Arg</span></code></h1>
   </header>
   <div class="odoc-content">
    <div class="odoc-spec">