Sidebar: better handling of missing page index

We use the id name (corresponding to the directory name) for the page title.

There is one case where we don't have access to an id:
```
$ odoc compile --output_dir _odoc --parent-id "" file.mld
$ odoc link _odoc/page-file.mld
$ odoc sidebar-generate -P _odoc/
```

The parent id of page `file` is `None` and we do not have an `index.mld` with
the same parent...

See also the test

src/document/sidebar.ml

@@ -2,10 +2,6 @@ open Odoc_utils
 open Types
 module Id = Odoc_model.Paths.Identifier
 
-let sidebar_toc_entry href content =
-  let target = Target.(Internal (Resolved href)) in
-  inline @@ Inline.Link { target; content; tooltip = None }
-
 module Toc : sig
   type t
 
@@ -15,21 +11,28 @@ module Toc : sig
 
   val to_block : prune:bool -> Url.Path.t -> t -> Block.t
 end = struct
-  type t = (Url.t * Inline.one) option Tree.t
+  type t = (Url.t option * Inline.one) Tree.t
 
-  let of_page_hierarchy (dir : Odoc_index.Page_hierarchy.t) =
+  let of_page_hierarchy (dir : Odoc_index.Page_hierarchy.t) : t =
     let f index =
+      let path_of_id id =
+        match Url.from_identifier ~stop_before:false (id :> Id.t) with
+        | Ok r -> r
+        | Error _ -> assert false
+        (* This error case should never happen since [stop_before] is false, and even less since it's a page id *)
+      in
       match index with
-      | None -> None
-      | Some (index_id, title) ->
-          let path =
-            match Url.from_identifier ~stop_before:false (index_id :> Id.t) with
-            | Ok r -> r
-            | Error _ -> assert false
-            (* This error case should never happen since [stop_before] is false, and even less since it's a page id *)
-          in
+      | Odoc_index.Page_hierarchy.Missing_index None ->
+          (None, inline @@ Text "Root")
+      | Odoc_index.Page_hierarchy.Missing_index (Some id) ->
+          let path = path_of_id id in
+          (Some path, inline @@ Text (Id.name id))
+      | Page (id, title) ->
+          let path = path_of_id id in
           let content = Comment.link_content title in
-          Some (path, sidebar_toc_entry path content)
+          let target = Target.Internal (Target.Resolved path) in
+          let i = inline @@ Inline.Link { target; content; tooltip = None } in
+          (Some path, i)
     in
     Tree.map ~f dir
 
@@ -45,31 +48,28 @@ end = struct
     | { anchor = ""; page = { parent = Some parent; _ }; _ } -> parent
     | { page; _ } -> page
 
-  let to_block ~prune (current_url : Url.Path.t) tree =
-    let block_tree_of_t (current_url : Url.Path.t) tree =
+  let to_block ~prune (current_url : Url.Path.t) (tree : t) =
+    let block_tree_of_t (current_url : Url.Path.t) (tree : t) =
       (* When transforming the tree, we use a filter_map to remove the nodes that
          are irrelevant for the current url. However, we always want to keep the
          root. So we apply the filter_map starting from the first children. *)
-      let convert ((url : Url.t), b) =
+      let convert ((url : Url.t option), b) =
         let link =
-          if url.page = current_url && Astring.String.equal url.anchor "" then
-            { b with Inline.attr = [ "current_unit" ] }
-          else b
+          match url with
+          | Some url ->
+              if url.page = current_url && Astring.String.equal url.anchor ""
+              then { b with Inline.attr = [ "current_unit" ] }
+              else b
+          | None -> b
         in
         Types.block @@ Inline [ link ]
       in
       let f name =
         match name with
-        | Some ((url, _) as v)
-          when (not prune) || is_prefix (parent url) current_url ->
-            Some (convert v)
-        | _ -> None
-      in
-      let root_entry =
-        match tree.Tree.node with
-        | Some v -> convert v
-        | None -> block (Block.Inline [ inline (Text "root") ])
+        | Some url, _ when prune && is_prefix (parent url) current_url -> None
+        | v -> Some (convert v)
       in
+      let root_entry = convert tree.Tree.node in
       { Tree.node = root_entry; children = Forest.filter_map ~f tree.children }
     in
     let rec block_of_block_tree { Tree.node = name; children = content } =
@@ -85,25 +85,26 @@ end = struct
     let block_tree = block_tree_of_t current_url tree in
     block_of_block_tree block_tree
 
-  let of_skeleton ({ node = entry; children } : Odoc_index.Entry.t Tree.t) =
+  let of_skeleton ({ node = entry; children } : Odoc_index.Entry.t Tree.t) : t =
     let map_entry entry =
       let stop_before =
         match entry.Odoc_index.Entry.kind with
         | ModuleType { has_expansion } | Module { has_expansion } ->
             not has_expansion
         | _ -> false
       in
-      let path = Url.from_identifier ~stop_before entry.id in
       let name = Odoc_model.Paths.Identifier.name entry.id in
-      match path with
+      match Url.from_identifier ~stop_before entry.id with
       | Ok path ->
           let content =
             let target = Target.Internal (Resolved path) in
             inline
               (Link { target; content = [ inline (Text name) ]; tooltip = None })
           in
-          Some (path, content)
-      | Error _ -> None
+          (Some path, content)
+      | Error _ -> assert false
+      (* Should not happen since we are careful with the [stop_before]
+         argument *)
     in
     let f entry =
       match entry.Odoc_index.Entry.kind with

src/index/page_hierarchy.ml

@@ -75,16 +75,18 @@ let dir_index ((parent_id, _) as dir) =
   | Some payload -> Some (payload, index_id, payload.title)
   | None -> None
 
-type index = Id.Page.t * title
+type index =
+  | Page of Id.Page.t * title
+  | Missing_index of Id.ContainerPage.t option
 
-type t = index option Odoc_utils.Tree.t
+type t = index Odoc_utils.Tree.t
 
 let rec t_of_in_progress (dir : in_progress) : t =
   let children_order, index =
     match dir_index dir with
     | Some ({ children_order; _ }, index_id, index_title) ->
-        (children_order, Some (index_id, index_title))
-    | None -> (None, None)
+        (children_order, Page (index_id, index_title))
+    | None -> (None, Missing_index (fst dir))
   in
   let pp_content fmt (id, _) =
     match id.Id.iv with
@@ -102,7 +104,7 @@ let rec t_of_in_progress (dir : in_progress) : t =
         leafs dir
         |> List.map (fun (id, payload) ->
                let id :> Id.Page.t = id in
-               (id, Tree.leaf (Some (id, payload))))
+               (id, Tree.leaf (Page (id, payload))))
       in
       let dirs =
         dirs dir
@@ -181,7 +183,7 @@ let rec t_of_in_progress (dir : in_progress) : t =
 
 let rec remove_common_root (v : t) =
   match v with
-  | { Tree.children = [ v ]; node = None } -> remove_common_root v
+  | { Tree.children = [ v ]; node = Missing_index _ } -> remove_common_root v
   | _ -> v
 
 let of_list l =

src/index/page_hierarchy.mli

@@ -6,9 +6,11 @@ open Odoc_utils
 
 type title = Comment.link_content
 
-type index = Identifier.Page.t * title
+type index =
+  | Page of Paths.Identifier.Page.t * title
+  | Missing_index of Paths.Identifier.ContainerPage.t option
 
-type t = index option Tree.t
+type t = index Tree.t
 
 val of_list :
   (Identifier.LeafPage.t * title * Frontmatter.children_order option) list -> t

test/parent_id/missing_indexes.t/run.t

@@ -11,12 +11,14 @@
 
   $ odoc html-generate --index index.odoc-index --indent --output-dir _html _odoc/page-foo.odocl
 
-Baz is missing.
-  $ cat _html/foo.html | grep Documentation -A 7
+Missing index for Baz makes it unclickable but use the ID for the name.
+Root is used for the missing index in the unnamed root directory.
+  $ cat _html/foo.html | grep Documentation -A 8
       <b>Documentation</b>
       <ul class="odoc-pages">
-       <li>root
+       <li>Root
         <ul><li><a href="bar.html">Bar</a></li>
+         <li>baz<ul><li><a href="baz/bli.html">Bli</a></li></ul></li>
          <li><a href="#" class="current_unit">Foo</a></li>
         </ul>
        </li>