Define Tree and Forest modules for sidebars and index

src/document/sidebar.ml

@@ -14,7 +14,7 @@ module Toc : sig
   val to_sidebar :
     ?fallback:string -> (Url.Path.t * Inline.one -> Block.one) -> t -> Block.t
 end = struct
-  type t = Item of (Url.Path.t * Inline.one) option * t list
+  type t = (Url.Path.t * Inline.one) option Tree.t
 
   open Odoc_model.Sidebar
   open Odoc_model.Paths.Identifier
@@ -37,7 +37,7 @@ end = struct
                   let content = Comment.link_content title in
                   Some (path, sidebar_toc_entry id content)
                 in
-                Some (Item (payload, []))
+                Some { Tree.node = payload; children = [] }
             | id, PageToc.Dir dir -> Some (of_lang ~parent_id:(Some id) dir))
           content
       in
@@ -49,11 +49,12 @@ end = struct
             let content = Comment.link_content title in
             Some (path, sidebar_toc_entry parent_id content)
       in
-      Item (payload, entries)
+      { Tree.node = payload; children = entries }
     in
     of_lang ~parent_id:None dir
 
-  let rec to_sidebar ?(fallback = "root") convert (Item (name, content)) =
+  let rec to_sidebar ?(fallback = "root") convert
+      { Tree.node = name; children = content } =
     let name =
       match name with
       | Some v -> convert v

src/utils/odoc_utils.ml

@@ -104,3 +104,6 @@ module Fun = struct
         finally_no_exn ();
         raise work_exn
 end
+
+module Tree = Tree
+module Forest = Tree.Forest

src/utils/tree.ml

@@ -0,0 +1,51 @@
+type 'a tree = { node : 'a; children : 'a forest }
+and 'a forest = 'a tree list
+
+module type S = sig
+  type 'a t
+
+  val fold_left : f:('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc
+  val iter : f:('a -> unit) -> 'a t -> unit
+  val map : f:('a -> 'b) -> 'a t -> 'b t
+end
+
+type 'a t = 'a tree
+
+let leaf node = { node; children = [] }
+
+let rec fold_left ~f acc { node; children } =
+  let acc = f acc node in
+  fold_left_forest ~f acc children
+
+and fold_left_forest ~f acc forest = List.fold_left (fold_left ~f) acc forest
+
+let rec iter ~f { node; children } =
+  let () = f node in
+  iter_forest ~f children
+
+and iter_forest ~f forest = List.iter (iter ~f) forest
+
+let rec map ~f { node; children } =
+  let node = f node in
+  let children = map_forest ~f children in
+  { node; children }
+
+and map_forest ~f forest = List.map (map ~f) forest
+
+let rec filter_map ~f { node; children } =
+  match f node with
+  | None -> None
+  | Some node ->
+      let children = filter_map_forest ~f children in
+      Some { node; children }
+
+and filter_map_forest ~f forest = List.filter_map (filter_map ~f) forest
+
+module Forest = struct
+  type 'a t = 'a forest
+
+  let fold_left = fold_left_forest
+  let iter = iter_forest
+  let map = map_forest
+  let filter_map = filter_map_forest
+end

src/utils/tree.mli

@@ -0,0 +1,20 @@
+type 'a tree = { node : 'a; children : 'a forest }
+and 'a forest = 'a tree list
+
+val leaf : 'a -> 'a tree
+
+module type S = sig
+  type 'a t
+
+  val fold_left : f:('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc
+  val iter : f:('a -> unit) -> 'a t -> unit
+  val map : f:('a -> 'b) -> 'a t -> 'b t
+end
+
+include S with type 'a t = 'a tree
+
+module Forest : sig
+  include S with type 'a t = 'a forest
+
+  val filter_map : f:('a -> 'b option) -> 'a t -> 'b t
+end