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_list.ml

@@ -0,0 +1,29 @@
+include List
+
+let rec concat_map ?sep ~f = function
+  | [] -> []
+  | [ x ] -> f x
+  | x :: xs -> (
+      let hd = f x in
+      let tl = concat_map ?sep ~f xs in
+      match sep with None -> hd @ tl | Some sep -> hd @ (sep :: tl))
+
+let rec filter_map acc f = function
+  | hd :: tl ->
+      let acc = match f hd with Some x -> x :: acc | None -> acc in
+      filter_map acc f tl
+  | [] -> List.rev acc
+
+let filter_map f x = filter_map [] f x
+
+(** @raise [Failure] if the list is empty. *)
+let rec last = function
+  | [] -> failwith "Odoc_utils.List.last"
+  | [ x ] -> x
+  | _ :: tl -> last tl
+
+(* From ocaml/ocaml *)
+let rec find_map f = function
+  | [] -> None
+  | x :: l -> (
+      match f x with Some _ as result -> result | None -> find_map f l)

src/utils/odoc_utils.ml

@@ -45,37 +45,7 @@ module EitherMonad = struct
   let of_result = function Result.Ok x -> Right x | Error y -> Left y
 end
 
-module List = struct
-  include List
-
-  let rec concat_map ?sep ~f = function
-    | [] -> []
-    | [ x ] -> f x
-    | x :: xs -> (
-        let hd = f x in
-        let tl = concat_map ?sep ~f xs in
-        match sep with None -> hd @ tl | Some sep -> hd @ (sep :: tl))
-
-  let rec filter_map acc f = function
-    | hd :: tl ->
-        let acc = match f hd with Some x -> x :: acc | None -> acc in
-        filter_map acc f tl
-    | [] -> List.rev acc
-
-  let filter_map f x = filter_map [] f x
-
-  (** @raise [Failure] if the list is empty. *)
-  let rec last = function
-    | [] -> failwith "Odoc_utils.List.last"
-    | [ x ] -> x
-    | _ :: tl -> last tl
-
-  (* From ocaml/ocaml *)
-  let rec find_map f = function
-    | [] -> None
-    | x :: l -> (
-        match f x with Some _ as result -> result | None -> find_map f l)
-end
+module List = Odoc_list
 
 module Option = struct
   let map f = function None -> None | Some x -> Some (f x)
@@ -104,3 +74,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,53 @@
+module List = Odoc_list
+
+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