Remove RootPage constructor

Instead use `Page(None,name). This change allows pages without parents
to be leaf pages, which again helps with tests.

Author: jonludlam

src/document/doctree.ml

@@ -69,7 +69,7 @@ end = struct
     { url = mkurl anchor; text; children }
 
   let compute page ~on_sub t =
-    let mkurl anchor = { Url.Anchor.page; anchor; kind = `Page } in
+    let mkurl anchor = { Url.Anchor.page; anchor; kind = `LeafPage } in
     Rewire.walk ~classify:(classify ~on_sub) ~node:(node mkurl) t
 end
 

src/document/generator.ml

@@ -1637,8 +1637,7 @@ module Make (Syntax : SYNTAX) = struct
 
     let page (t : Odoc_model.Lang.Page.t) : Page.t =
       let name =
-        match t.name with
-        | `RootPage name | `Page (_, name) | `LeafPage (_, name) -> name
+        match t.name 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

src/document/url.ml

@@ -76,18 +76,18 @@ module Path = struct
 
   type kind =
     [ `Module
-    | `ContainerPage
     | `Page
+    | `LeafPage
     | `ModuleType
     | `Argument
     | `Class
     | `ClassType
     | `File ]
 
   let string_of_kind : kind -> string = function
-    | `ContainerPage -> "container-page"
-    | `Module -> "module"
     | `Page -> "page"
+    | `Module -> "module"
+    | `LeafPage -> "leaf-page"
     | `ModuleType -> "module-type"
     | `Argument -> "argument"
     | `Class -> "class"
@@ -110,20 +110,24 @@ module Path = struct
         let kind = `Module in
         let page = ModuleName.to_string unit_name in
         mk ?parent kind page
-    | `RootPage page_name ->
-        let kind = `ContainerPage in
-        let page = PageName.to_string page_name in
-        mk kind page
     | `Page (parent, page_name) ->
-        let parent = from_identifier (parent :> source) in
-        let kind = `ContainerPage in
+        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
+        mk ?parent kind page
     | `LeafPage (parent, page_name) ->
-        let parent = from_identifier (parent :> source) in
-        let kind = `Page in
+        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
+        mk ?parent kind page
     | `Module (parent, mod_name) ->
         let parent = from_identifier (parent :> source) in
         let kind = `Module in
@@ -242,15 +246,12 @@ module Anchor = struct
     | `Root _ as p ->
         let page = Path.from_identifier (p :> Path.source) in
         Ok { page; kind = `Module; anchor = "" }
-    | `RootPage _ as p ->
-        let page = Path.from_identifier (p :> Path.source) in
-        Ok { page; kind = `ContainerPage; anchor = "" }
     | `Page _ as p ->
         let page = Path.from_identifier (p :> Path.source) in
-        Ok { page; kind = `ContainerPage; anchor = "" }
+        Ok { page; kind = `Page; anchor = "" }
     | `LeafPage _ as p ->
         let page = Path.from_identifier (p :> Path.source) in
-        Ok { page; kind = `Page; anchor = "" }
+        Ok { page; kind = `LeafPage; anchor = "" }
     (* For all these identifiers, page names and anchors are the same *)
     | (`Parameter _ | `Result _ | `ModuleType _ | `Class _ | `ClassType _) as p
       ->

src/document/url.mli

@@ -14,8 +14,8 @@ end
 module Path : sig
   type kind =
     [ `Module
-    | `ContainerPage
     | `Page
+    | `LeafPage
     | `ModuleType
     | `Argument
     | `Class

src/html/link.ml

@@ -8,23 +8,23 @@ module Path = struct
 
   let segment_to_string (kind, name) =
     match kind with
-    | `Module | `ContainerPage -> name
+    | `Module | `Page -> name
     | _ -> Format.asprintf "%a-%s" Url.Path.pp_kind kind name
 
-  let is_leaf_page url = url.Url.Path.kind = `Page
+  let is_leaf_page url = url.Url.Path.kind = `LeafPage
 
   let get_dir_and_file url =
     let l = Url.Path.to_list url in
     let is_dir =
-      if !flat then function `ContainerPage -> true | _ -> false
-      else function `Page -> false | `File -> false | _ -> true
+      if !flat then function `Page -> true | _ -> false
+      else function `LeafPage -> false | `File -> false | _ -> true
     in
     let dir, file = Url.Path.split ~is_dir l in
     let dir = List.map segment_to_string dir in
     let file =
       match file with
       | [] -> "index.html"
-      | [ (`Page, name) ] -> name ^ ".html"
+      | [ (`LeafPage, name) ] -> name ^ ".html"
       | [ (`File, name) ] -> name
       | xs ->
           assert !flat;

src/latex/generator.ml

@@ -27,7 +27,7 @@ module Link = struct
 
   let rec is_class_or_module_path (url : Odoc_document.Url.Path.t) =
     match url.kind with
-    | `Module | `Page | `Class | `ContainerPage -> (
+    | `Module | `LeafPage | `Class | `Page -> (
         match url.parent with
         | None -> true
         | Some url -> is_class_or_module_path url)
@@ -42,7 +42,7 @@ module Link = struct
   let get_dir_and_file url =
     let open Odoc_document in
     let l = Url.Path.to_list url in
-    let is_dir = function `ContainerPage -> true | _ -> false in
+    let is_dir = function `Page -> true | _ -> false in
     let dir, file = Url.Path.split ~is_dir l in
     let segment_to_string (_kind, name) = name in
     let dir = List.map segment_to_string dir in

src/manpage/link.ml

@@ -4,23 +4,22 @@ let for_printing url = List.map snd @@ Url.Path.to_list url
 
 let segment_to_string (kind, name) =
   match kind with
-  | `Module | `ContainerPage | `Page | `Class -> name
+  | `Module | `Page | `LeafPage | `Class -> name
   | _ -> Format.asprintf "%a-%s" Odoc_document.Url.Path.pp_kind kind name
 
 let as_filename (url : Url.Path.t) =
   let components = Url.Path.to_list url in
   let dir, path =
-    Url.Path.split
-      ~is_dir:(function `ContainerPage -> true | _ -> false)
-      components
+    Url.Path.split ~is_dir:(function `Page -> true | _ -> false) components
   in
   let dir = List.map segment_to_string dir in
   let path = String.concat "." (List.map segment_to_string path) in
-  Fpath.(v (String.concat dir_sep (dir @ [ path ])) + ".3o")
+  let str_path = String.concat Fpath.dir_sep (dir @ [ path ]) in
+  Fpath.(v str_path + ".3o")
 
 let rec is_class_or_module_path (url : Url.Path.t) =
   match url.kind with
-  | `Module | `Page | `ContainerPage | `Class -> (
+  | `Module | `LeafPage | `Page | `Class -> (
       match url.parent with
       | None -> true
       | Some url -> is_class_or_module_path url)

src/model/paths.ml

@@ -21,7 +21,6 @@ module Identifier = struct
 
   let rec name_aux : t -> string = function
     | `Root (_, name) -> ModuleName.to_string name
-    | `RootPage name -> PageName.to_string name
     | `Page (_, name) -> PageName.to_string name
     | `LeafPage (_, name) -> PageName.to_string name
     | `Module (_, name) -> ModuleName.to_string name
@@ -51,7 +50,6 @@ module Identifier = struct
       | `Result i -> label_parent_aux (i :> any)
       | `CoreType _ | `CoreException _ -> assert false
       | `Root _ as p -> (p :> label_parent)
-      | `RootPage _ as p -> (p :> label_parent)
       | `Page _ as p -> (p :> label_parent)
       | `LeafPage _ as p -> (p :> label_parent)
       | `Module (p, _)

src/model/paths_types.ml

@@ -2,11 +2,11 @@ open Names
 (** {1 Paths} *)
 
 module Identifier = struct
-  type container_page =
-    [ `RootPage of PageName.t | `Page of container_page * PageName.t ]
+  type container_page = [ `Page of container_page option * PageName.t ]
   (** @canonical Odoc_model.Paths.Identifier.ContainerPage.t *)
 
-  type page = [ container_page | `LeafPage of container_page * PageName.t ]
+  type page =
+    [ container_page | `LeafPage of container_page option * PageName.t ]
   (** @canonical Odoc_model.Paths.Identifier.Page.t *)
 
   type odoc_id = [ page | `Root of container_page option * ModuleName.t ]

src/model/root.ml

@@ -64,11 +64,13 @@ let hash : t -> int = Hashtbl.hash
 let to_string t =
   let rec pp fmt (id : Paths.Identifier.OdocId.t) =
     match id with
-    | `RootPage p -> Format.fprintf fmt "%a" Names.PageName.fmt p
-    | `LeafPage (parent, name) | `Page (parent, name) ->
-        Format.fprintf fmt "%a::%a" pp
-          (parent :> Paths.Identifier.OdocId.t)
-          Names.PageName.fmt name
+    | `LeafPage (parent, name) | `Page (parent, name) -> (
+        match parent with
+        | Some p ->
+            Format.fprintf fmt "%a::%a" pp
+              (p :> Paths.Identifier.OdocId.t)
+              Names.PageName.fmt name
+        | None -> Format.fprintf fmt "%a" Names.PageName.fmt name)
     | `Root (Some parent, name) ->
         Format.fprintf fmt "%a::%a" pp
           (parent :> Paths.Identifier.OdocId.t)

src/model/semantics.ml

@@ -387,7 +387,7 @@ let section_heading :
 
 let validate_first_page_heading status ast_element =
   match status.parent_of_sections with
-  | `RootPage name | `Page (_, name) | `LeafPage (_, name) -> (
+  | `Page (_, name) | `LeafPage (_, name) -> (
       match ast_element with
       | { Location.value = `Heading (_, _, _); _ } -> ()
       | _invalid_ast_element ->
@@ -437,7 +437,7 @@ let top_level_block_elements status ast_elements =
   let top_heading_level =
     (* Non-page documents have a generated title. *)
     match status.parent_of_sections with
-    | `RootPage _ | `Page _ | `LeafPage _ -> None
+    | `Page _ | `LeafPage _ -> None
     | _parent_with_generated_title -> Some 0
   in
   traverse ~top_heading_level [] ast_elements

src/model_desc/paths_desc.ml

@@ -61,17 +61,16 @@ module General_paths = struct
   let rec identifier : Paths.Identifier.t t =
     Variant
       (function
-      | `RootPage name -> C ("`RootPage", name, Names.pagename)
       | `Page (parent, name) ->
           C
             ( "`Page",
-              ((parent :> id_t), name),
-              Pair (identifier, Names.pagename) )
+              ((parent :> id_t option), name),
+              Pair (Option identifier, Names.pagename) )
       | `LeafPage (parent, name) ->
           C
             ( "`LeafPage",
-              ((parent :> id_t), name),
-              Pair (identifier, Names.pagename) )
+              ((parent :> id_t option), name),
+              Pair (Option identifier, Names.pagename) )
       | `Root (parent, name) ->
           C
             ( "`Root",

src/odoc/bin/main.ml

@@ -446,7 +446,7 @@ module Odoc_html = Make_renderer (struct
             ~f:(fun acc seg ->
               Some
                 Odoc_document.Url.Path.
-                  { kind = `ContainerPage; parent = acc; name = seg })
+                  { kind = `Page; parent = acc; name = seg })
             l ~init:None
         in
         `Ok
@@ -604,15 +604,18 @@ module Depends = struct
   module Link = struct
     let rec fmt_page pp page =
       match page with
-      | `RootPage name ->
-          Format.fprintf pp "%a" Odoc_model.Names.PageName.fmt name
-      | `Page (parent, name) ->
-          Format.fprintf pp "%a/%a" fmt_page parent
+      | `Page (parent_opt, name) ->
+          Format.fprintf pp "%a%a" fmt_parent_opt parent_opt
             Odoc_model.Names.PageName.fmt name
-      | `LeafPage (parent, name) ->
-          Format.fprintf pp "%a/%a" fmt_page parent
+      | `LeafPage (parent_opt, name) ->
+          Format.fprintf pp "%a%a" fmt_parent_opt parent_opt
             Odoc_model.Names.PageName.fmt name
 
+    and fmt_parent_opt pp parent_opt =
+      match parent_opt with
+      | None -> ()
+      | Some p -> Format.fprintf pp "%a/" fmt_page p
+
     let list_dependencies input_file =
       let open Or_error in
       Depends.for_rendering_step (Fs.Directory.of_string input_file)

src/odoc/compile.ml

@@ -50,7 +50,7 @@ let parent resolver parent_cli_spec =
     | _ -> Error (`Msg "Expecting page as parent")
   in
   let extract_parent = function
-    | (`RootPage _ | `Page _) as container -> Ok container
+    | `Page _ as container -> Ok container
     | _ -> Error (`Msg "Specified parent is not a parent of this file")
   in
   match parent_cli_spec with
@@ -59,7 +59,7 @@ let parent resolver parent_cli_spec =
       find_parent r >>= fun page ->
       extract_parent page.name >>= fun parent ->
       Ok (Explicit (parent, page.children))
-  | CliPackage package -> Ok (Package (`RootPage (PageName.make_std package)))
+  | CliPackage package -> Ok (Package (`Page (None, PageName.make_std package)))
   | CliNoparent -> Ok Noparent
 
 let resolve_imports resolver imports =
@@ -158,12 +158,13 @@ let mld ~parent_spec ~output ~children ~warnings_options input =
       else Error (`Msg "Specified parent is not a parent of this file")
     in
     match (parent_spec, children) with
-    | Explicit (p, cs), [] -> check cs @@ `LeafPage (p, page_name)
-    | Explicit (p, cs), _ -> check cs @@ `Page (p, page_name)
-    | Package parent, [] -> Ok (`LeafPage (parent, page_name))
+    | Explicit (p, cs), [] -> check cs @@ `LeafPage (Some p, page_name)
+    | Explicit (p, cs), _ -> check cs @@ `Page (Some p, page_name)
+    | Package parent, [] -> Ok (`LeafPage (Some parent, page_name))
     | Package parent, _ ->
-        Ok (`Page (parent, page_name)) (* This is a bit odd *)
-    | Noparent, _ -> Ok (`RootPage page_name)
+        Ok (`Page (Some parent, page_name)) (* This is a bit odd *)
+    | Noparent, [] -> Ok (`LeafPage (None, page_name))
+    | Noparent, _ -> Ok (`Page (None, page_name))
   in
   name >>= fun name ->
   let root =

src/odoc/html_fragment.ml

@@ -3,7 +3,7 @@ open Or_error
 let from_mld ~xref_base_uri ~resolver ~output ~warnings_options input =
   (* Internal names, they don't have effect on the output. *)
   let page_name = "__fragment_page__" in
-  let id = `RootPage (Odoc_model.Names.PageName.make_std page_name) in
+  let id = `Page (None, Odoc_model.Names.PageName.make_std page_name) in
   let input_s = Fs.File.to_string input in
   let digest = Digest.file input_s in
   let root =

src/xref2/component.ml

@@ -1198,7 +1198,7 @@ module Fmt = struct
         Format.fprintf ppf "%a.%s" model_identifier
           (p :> Odoc_model.Paths.Identifier.t)
           (ExtensionName.to_string name)
-    | `Page (_, name) | `LeafPage (_, name) | `RootPage name ->
+    | `Page (_, name) | `LeafPage (_, name) ->
         Format.fprintf ppf "%s" (PageName.to_string name)
 
   and model_fragment ppf (f : Odoc_model.Paths.Fragment.t) =