diff --git a/src/document/sidebar.ml b/src/document/sidebar.ml index 5122b0f90e..a0bf8050aa 100644 --- a/src/document/sidebar.ml +++ b/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 diff --git a/src/utils/odoc_list.ml b/src/utils/odoc_list.ml new file mode 100644 index 0000000000..53ddf484c7 --- /dev/null +++ b/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) diff --git a/src/utils/odoc_utils.ml b/src/utils/odoc_utils.ml index a574797f75..41294e1785 100644 --- a/src/utils/odoc_utils.ml +++ b/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 diff --git a/src/utils/tree.ml b/src/utils/tree.ml new file mode 100644 index 0000000000..2bbc78a141 --- /dev/null +++ b/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 diff --git a/src/utils/tree.mli b/src/utils/tree.mli new file mode 100644 index 0000000000..8f3e558dd1 --- /dev/null +++ b/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