Compatibility: use a central utils module

Signed-off-by: Paul-Elliot <[email protected]>

src/document/generator.ml

@@ -23,12 +23,6 @@ open O.Infix
 
 let tag tag t = O.span ~attr:tag t
 
-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 label t =
   match t with
   | Odoc_model.Lang.TypeExpr.Label s -> tag "label" (O.txt s)
@@ -297,7 +291,7 @@ module Make (Syntax : SYNTAX) = struct
       let mapper (info, loc) =
         match info_of_info info with Some x -> Some (x, loc) | None -> None
       in
-      let infos = filter_map [] mapper infos in
+      let infos = Odoc_utils.List.filter_map mapper infos in
       let syntax_info =
         List.map (fun (ty, loc) -> (Source_page.Syntax ty, loc)) syntax_info
       in

src/document/sidebar.ml

@@ -88,7 +88,7 @@ let of_lang (v : Odoc_model.Lang.Sidebar.t) =
         let hierarchy = Hierarchy.make pages |> Hierarchy.remove_common_root in
         Some { name = page_name; pages = hierarchy }
     in
-    List.filter_map page_hierarchy v.pages
+    Odoc_utils.List.filter_map page_hierarchy v.pages
   in
   let units =
     let item id =

src/document/url.ml

@@ -1,4 +1,3 @@
-open Result
 open Odoc_model.Paths
 open Odoc_model.Names
 module Root = Odoc_model.Root
@@ -80,7 +79,7 @@ module Error = struct
     | Unexpected_anchor s -> Printf.sprintf "Unexpected_anchor %S" s
 end
 
-let ( >>= ) x f = match x with Ok x -> f x | Error _ as e -> e
+open Odoc_utils.ResultMonad
 
 module Path = struct
   type nonsrc_pv =

src/html/utils.ml

@@ -1,8 +1,5 @@
 (* Shared utility functions *)
 
-(* = Option.fold *)
-let fold_option ~none ~some = function Some x -> some x | None -> none
-
 let optional_elt f ?a = function [] -> [] | l -> [ f ?a l ]
 
 module Json = struct

src/latex/generator.ml

@@ -89,12 +89,6 @@ let list kind pp ppf x =
 
 let escape_entity = function "#45" -> "-" | "gt" -> ">" | s -> s
 
-let filter_map f x =
-  List.rev
-  @@ List.fold_left
-       (fun acc x -> match f x with Some x -> x :: acc | None -> acc)
-       [] x
-
 let elt_size (x : elt) =
   match x with
   | Txt _ | Internal_ref _ | External_ref _ | Label _ | Style _ | Inlined_code _
@@ -118,7 +112,9 @@ let layout_table = function
         | Empty, _ -> None
         | (Small | Large | Huge), x -> Some x
       in
-      let filter_row row = filter_map filter_empty @@ List.combine mask row in
+      let filter_row row =
+        Odoc_utils.List.filter_map filter_empty @@ List.combine mask row
+      in
       let row_size = List.fold_left max Empty mask in
       [ Layout_table { row_size; tbl = List.map filter_row m } ]
 

src/odoc/html_page.ml

@@ -21,15 +21,9 @@ type args = { html_config : Odoc_html.Config.t; assets : Fpath.t list }
 let render { html_config; assets = _ } sidebar page =
   Odoc_html.Generator.render ~config:html_config ~sidebar page
 
-let list_filter_map f lst =
-  List.rev
-  @@ List.fold_left
-       (fun acc x -> match f x with None -> acc | Some x -> x :: acc)
-       [] lst
-
 let asset_documents parent_id children asset_paths =
   let asset_names =
-    list_filter_map
+    Odoc_utils.List.filter_map
       (function Lang.Page.Asset_child name -> Some name | _ -> None)
       children
   in
@@ -57,7 +51,7 @@ let asset_documents parent_id children asset_paths =
            (Paths.Identifier.name parent_id)
            (Fs.File.to_string asset)))
     unmatched;
-  list_filter_map
+  Odoc_utils.List.filter_map
     (fun (name, path) ->
       match path with
       | None ->

src/odoc/rendering.ml

@@ -119,7 +119,7 @@ let render_document renderer ~sidebar ~output:root_dir ~extra_suffix ~extra doc
     | Asset { url; _ } -> url
   in
   let sidebar =
-    Option.map (fun sb -> Odoc_document.Sidebar.to_block sb url) sidebar
+    Odoc_utils.Option.map (fun sb -> Odoc_document.Sidebar.to_block sb url) sidebar
   in
   let pages = renderer.Renderer.render extra sidebar doc in
   Renderer.traverse pages ~f:(fun filename content ->

src/odoc/resolver.ml

@@ -418,12 +418,6 @@ type t = {
   open_modules : string list;
 }
 
-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 all_roots ?root named_roots =
   let all_files =
     match Named_roots.all_of ?root named_roots ~ext:"odocl" with
@@ -433,7 +427,7 @@ let all_roots ?root named_roots =
   let load page =
     match Odoc_file.load_root page with Error _ -> None | Ok root -> Some root
   in
-  filter_map [] load all_files
+  Odoc_utils.List.filter_map load all_files
 
 let all_pages ?root ({ pages; _ } : t) =
   let filter (root : Odoc_model.Root.t) =
@@ -448,7 +442,7 @@ let all_pages ?root ({ pages; _ } : t) =
   in
   match pages with
   | None -> []
-  | Some pages -> filter_map [] filter @@ all_roots ?root pages
+  | Some pages -> Odoc_utils.List.filter_map filter @@ all_roots ?root pages
 
 let all_units ~library ({ libs; _ } : t) =
   let filter (root : Odoc_model.Root.t) =
@@ -463,7 +457,8 @@ let all_units ~library ({ libs; _ } : t) =
   in
   match libs with
   | None -> []
-  | Some libs -> filter_map [] filter @@ all_roots ~root:library libs
+  | Some libs ->
+      Odoc_utils.List.filter_map filter @@ all_roots ~root:library libs
 
 type roots = {
   page_roots : (string * Fs.Directory.t) list;

src/utils/dune

@@ -1,3 +1,4 @@
 (library
  (name odoc_utils)
- (public_name odoc.odoc_utils))
+ (public_name odoc.odoc_utils)
+ (libraries result))

src/utils/odoc_utils.ml

@@ -1,3 +1,47 @@
+(** The [result] type and a bind operator. This module is meant to be opened. *)
+module ResultMonad = struct
+  (** Re-export for compat *)
+  type ('a, 'b) result = ('a, 'b) Result.result = Ok of 'a | Error of 'b
+
+  let map_error f = function Ok _ as ok -> ok | Error e -> Error (f e)
+
+  let of_option ~error = function Some x -> Ok x | None -> Error error
+
+  let bind m f = match m with Ok x -> f x | Error _ as e -> e
+
+  let ( >>= ) = bind
+end
+
+(** A bind operator for the [option] type. This module is meant to be opened. *)
+module OptionMonad = struct
+  (* The error case become [None], the error value is ignored. *)
+  let of_result = function Result.Ok x -> Some x | Error _ -> None
+
+  let return x = Some x
+
+  let bind m f = match m with Some x -> f x | None -> None
+
+  let ( >>= ) = bind
+end
+
+module EitherMonad = struct
+  type ('a, 'b) t = Left of 'a | Right of 'b
+
+  let return x = Right x
+
+  let return_left x = Left x
+
+  let bind m f = match m with Right x -> f x | Left y -> Left y
+
+  let bind_left m f = match m with Left x -> f x | Right y -> Right y
+
+  let ( >>= ) = bind
+
+  let of_option ~left = function Some x -> Right x | None -> Left left
+
+  let of_result = function Result.Ok x -> Right x | Error y -> Left y
+end
+
 module List = struct
   let rec concat_map ?sep ~f = function
     | [] -> []
@@ -6,4 +50,16 @@ module List = struct
         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
 end
+
+module Option = struct
+  let map f = function None -> None | Some x -> Some (f x)
+  end

src/xref2/compile.ml

@@ -145,7 +145,7 @@ and class_type env c =
   let open ClassType in
   let expansion =
     match
-      let open Utils.OptionMonad in
+      let open Odoc_utils.OptionMonad in
       Env.(lookup_by_id s_class_type) c.id env >>= fun (`ClassType (_, c')) ->
       Tools.class_signature_of_class_type env c' >>= fun sg ->
       let cs =
@@ -211,7 +211,7 @@ and class_ env parent c =
   let container = (parent :> Id.LabelParent.t) in
   let expansion =
     match
-      let open Utils.OptionMonad in
+      let open Odoc_utils.OptionMonad in
       Env.(lookup_by_id s_class) c.id env >>= fun (`Class (_, c')) ->
       Tools.class_signature_of_class env c' >>= fun sg ->
       let cs =
@@ -401,7 +401,7 @@ and include_ : Env.t -> Include.t -> Include.t * Env.t =
   let decl = Component.Of_Lang.(include_decl (empty ()) i.decl) in
   let get_expansion () =
     match
-      let open Utils.ResultMonad in
+      let open Odoc_utils.ResultMonad in
       match decl with
       | Alias p ->
           Tools.expansion_of_module_path env ~strengthen:true p >>= fun exp ->
@@ -466,7 +466,7 @@ and functor_parameter_parameter :
   { a with expr = module_type_expr env (a.id :> Id.Signature.t) a.expr }
 
 and module_type_expr_sub id ~fragment_root (sg_res, env, subs) lsub =
-  let open Utils.ResultMonad in
+  let open Odoc_utils.ResultMonad in
   match sg_res with
   | Error _ -> (sg_res, env, lsub :: subs)
   | Ok sg -> (
@@ -679,7 +679,7 @@ and module_type_expr :
     ModuleType.expr ->
     ModuleType.expr =
  fun env id ?(expand_paths = true) expr ->
-  let open Utils.ResultMonad in
+  let open Odoc_utils.ResultMonad in
   let get_expansion cur e =
     match cur with
     | Some e -> Some (simple_expansion env id e)

src/xref2/dune

@@ -5,7 +5,7 @@
   (backend landmarks --auto))
  (instrumentation
   (backend bisect_ppx))
- (libraries odoc_model))
+ (libraries odoc_model odoc_utils))
 
 (rule
  (with-stdout-to

src/xref2/expand_tools.ml

@@ -1,4 +1,4 @@
-open Utils.ResultMonad
+open Odoc_utils.ResultMonad
 open Odoc_model
 
 let handle_expansion env id expansion =

src/xref2/link.ml

@@ -20,7 +20,7 @@ let synopsis_from_comment (docs : Component.CComment.docs) =
   | _ -> None
 
 let synopsis_of_module env (m : Component.Module.t) =
-  let open Utils.ResultMonad in
+  let open Odoc_utils.ResultMonad in
   match synopsis_from_comment m.doc with
   | Some _ as s -> s
   | None -> (
@@ -585,7 +585,7 @@ and simple_expansion :
 and module_ : Env.t -> Module.t -> Module.t =
  fun env m ->
   let open Module in
-  let open Utils.ResultMonad in
+  let open Odoc_utils.ResultMonad in
   let sg_id = (m.id :> Id.Signature.t) in
   if m.hidden then m
   else
@@ -830,7 +830,7 @@ and module_type_expr :
     Env.t -> Id.Signature.t -> ModuleType.expr -> ModuleType.expr =
  fun env id expr ->
   let open ModuleType in
-  let open Utils.ResultMonad in
+  let open Odoc_utils.ResultMonad in
   let do_expn cur (e : Paths.Path.ModuleType.t option) =
     match (cur, e) with
     | Some e, _ ->

src/xref2/ref_tools.ml

@@ -1,7 +1,7 @@
 open Odoc_model.Paths
 open Odoc_model.Names
 open Reference
-open Utils.ResultMonad
+open Odoc_utils.ResultMonad
 
 type module_lookup_result =
   Resolved.Module.t * Cpath.Resolved.module_ * Component.Module.t

src/xref2/shape_tools.cppo.ml

@@ -4,7 +4,7 @@ open Odoc_model.Paths
 open Odoc_model.Names
 module Kind = Shape.Sig_component_kind
 
-let ( >>= ) m f = match m with Some x -> f x | None -> None
+open Odoc_utils.OptionMonad
 
 type t = Shape.t * Odoc_model.Paths.Identifier.SourceLocation.t Shape.Uid.Map.t