From 5c158d11d848a8e8161ab0f631eac8a6c974f910 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Thu, 13 Jul 2023 16:58:15 +0200 Subject: [PATCH] fix compatibility Signed-off-by: Paul-Elliot --- src/document/generator.ml | 2 +- src/document/utils.ml | 8 ++++++++ src/document/utils.mli | 1 + src/odoc/indexing.ml | 4 +++- src/search/entry.ml | 18 ++++++++++++++---- src/search/generator.ml | 29 ++++++++++++++++------------- 6 files changed, 43 insertions(+), 19 deletions(-) diff --git a/src/document/generator.ml b/src/document/generator.ml index 2405f7bc3a..7417e049a9 100644 --- a/src/document/generator.ml +++ b/src/document/generator.ml @@ -1763,7 +1763,7 @@ module Make (Syntax : SYNTAX) = struct | None -> None in let search_assets = - List.filter_map + Utils.filter_map (function | `Resolved (`Identifier id) -> Some Url.(from_path @@ Path.from_identifier id) diff --git a/src/document/utils.ml b/src/document/utils.ml index e3b5d861e4..69d6311f2a 100644 --- a/src/document/utils.ml +++ b/src/document/utils.ml @@ -1,5 +1,13 @@ let option_of_result = function Result.Ok x -> Some x | Result.Error _ -> None +let filter_map f = + let rec aux accu = function + | [] -> List.rev accu + | x :: l -> ( + match f x with None -> aux accu l | Some v -> aux (v :: accu) l) + in + aux [] + let rec flatmap ?sep ~f = function | [] -> [] | [ x ] -> f x diff --git a/src/document/utils.mli b/src/document/utils.mli index 4ead7e29aa..a8d1aff429 100644 --- a/src/document/utils.mli +++ b/src/document/utils.mli @@ -1,3 +1,4 @@ +val filter_map : ('a -> 'b option) -> 'a list -> 'b list val option_of_result : ('a, 'b) Result.result -> 'a option val flatmap : ?sep:'a list -> f:('b -> 'a list) -> 'b list -> 'a list val skip_until : p:('a -> bool) -> 'a list -> 'a list diff --git a/src/odoc/indexing.ml b/src/odoc/indexing.ml index 3926a48778..edd4045a2f 100644 --- a/src/odoc/indexing.ml +++ b/src/odoc/indexing.ml @@ -1,9 +1,11 @@ open Odoc_search open Or_error +let map_result f = function Ok v -> Ok (f v) | Error _ as e -> e + let handle_file file ~unit ~page = Odoc_file.load file - |> Result.map @@ fun unit' -> + |> map_result @@ fun unit' -> match unit' with | { Odoc_file.content = Unit_content (unit', _); _ } when not unit'.hidden -> diff --git a/src/search/entry.ml b/src/search/entry.ml index 216c976705..2003f524d5 100644 --- a/src/search/entry.ml +++ b/src/search/entry.ml @@ -1,6 +1,15 @@ open Odoc_model.Lang open Odoc_model.Paths +let list_concat_map f l = + let rec aux f acc = function + | [] -> List.rev acc + | x :: l -> + let xs = f x in + aux f (List.rev_append xs acc) l + in + aux f [] l + type type_decl_entry = { canonical : Path.Type.t option; equation : TypeDecl.Equation.t; @@ -118,14 +127,14 @@ let entry_of_field id_parent params (field : TypeDecl.Field.t) = entry ~id:field.id ~doc:field.doc ~kind let rec entries_of_docs id (d : Odoc_model.Comment.docs) = - List.concat_map (entries_of_doc id) d + list_concat_map (entries_of_doc id) d and entries_of_doc id d = match d.value with | `Paragraph _ -> [ entry ~id ~doc:[ d ] ~kind:(Doc Paragraph) ] | `Tag _ -> [] | `List (_, ds) -> - List.concat_map (entries_of_docs id) (ds :> Odoc_model.Comment.docs list) + list_concat_map (entries_of_docs id) (ds :> Odoc_model.Comment.docs list) | `Heading (_, lbl, _) -> [ entry ~id:lbl ~doc:[ d ] ~kind:(Doc Heading) ] | `Modules _ -> [] | `Code_block (_, _, o) -> @@ -171,8 +180,9 @@ let entries_of_item id (x : Odoc_model.Fold.item) = [ entry ~id:v.id ~doc:v.doc ~kind ] | Exception exc -> let res = - Option.value exc.res - ~default:(TypeExpr.Constr (Odoc_model.Predefined.exn_path, [])) + match exc.res with + | None -> TypeExpr.Constr (Odoc_model.Predefined.exn_path, []) + | Some x -> x in let kind = Exception { args = exc.args; res } in [ entry ~id:exc.id ~doc:exc.doc ~kind ] diff --git a/src/search/generator.ml b/src/search/generator.ml index 3b35fac957..5a7c485f92 100644 --- a/src/search/generator.ml +++ b/src/search/generator.ml @@ -4,6 +4,8 @@ open Odoc_model open Lang open Printf +let map_option f = function Some x -> Some (f x) | None -> None + let type_from_path : Paths.Path.Type.t -> string = fun path -> match path with @@ -79,19 +81,19 @@ let display_constructor_args args = | _ :: _ :: _ -> Some TypeExpr.(Tuple args) | [ arg ] -> Some arg | _ -> None) - |> Option.map type_expr + |> map_option type_expr | TypeDecl.Constructor.Record fields -> Some (Render.text_of_record fields) let constructor_rhs ~args ~res = let args = display_constructor_args args in - let res = Option.map type_expr res in + let res = map_option type_expr res in match (args, res) with | None, None -> "" | None, Some res -> " : " ^ res | Some args, None -> " of " ^ args | Some args, Some res -> " : " ^ args ^ " -> " ^ res -let field_rhs Entry.{ mutable_ = _; type_; parent_type = _ } = +let field_rhs ({ mutable_ = _; type_; parent_type = _ } : Entry.field_entry) = " : " ^ type_expr type_ let typedecl_params ?(delim = `parens) params = @@ -121,7 +123,7 @@ let typedecl_params ?(delim = `parens) params = let type_decl_constraint (typ, typ') = "constraint" ^ " " ^ type_expr typ ^ " = " ^ type_expr typ' -let typedecl_params_of_entry Entry.{ kind; _ } = +let typedecl_params_of_entry ({ kind; _ } : Entry.t) = match kind with | Entry.TypeDecl { canonical = _; equation; representation = _ } -> typedecl_params equation.params @@ -139,17 +141,17 @@ let typedecl_repr ~private_ (repr : TypeDecl.Representation.t) = | Extensible -> ".." | Variant constructors -> constructors - |> List.map (fun TypeDecl.Constructor.{ id; args; res; _ } -> + |> List.map (fun ({ id; args; res; _ } : TypeDecl.Constructor.t) -> constructor ~id ~args ~res) |> String.concat " | " | Record record -> Render.text_of_record record -let typedecl_rhs Entry.{ equation; representation; _ } = - let TypeDecl.Equation.{ private_; manifest; constraints; _ } = equation in +let typedecl_rhs ({ equation; representation; _ } : Entry.type_decl_entry) = + let ({ private_; manifest; constraints; _ } : TypeDecl.Equation.t) = + equation + in let repr = - representation - |> Option.map (typedecl_repr ~private_) - |> Option.value ~default:"" + match representation with Some r -> typedecl_repr ~private_ r | None -> "" in let manifest = match manifest with None -> "" | Some typ -> " = " ^ type_expr typ @@ -162,7 +164,8 @@ let typedecl_rhs Entry.{ equation; representation; _ } = in match repr ^ manifest ^ constraints with "" -> None | r -> Some r -let constructor_rhs Entry.{ args; res } = constructor_rhs ~args ~res:(Some res) +let constructor_rhs ({ args; res } : Entry.constructor_entry) = + constructor_rhs ~args ~res:(Some res) (** Kinds *) @@ -264,7 +267,7 @@ let html_of_doc doc = let html_string_of_doc doc = doc |> html_of_doc |> Format.asprintf "%a" (Html.pp_elt ()) let html_of_entry (entry : Entry.t) = - let Entry.{ id; doc; kind } = entry in + let ({ id; doc; kind } : Entry.t) = entry in let rhs = rhs_of_kind kind in let prefix_name, name = title_of_id id in let doc = html_string_of_doc doc in @@ -272,4 +275,4 @@ let html_of_entry (entry : Entry.t) = let typedecl_params = typedecl_params_of_entry entry in html_of_strings ~kind ~prefix_name ~name ~rhs ~doc ~typedecl_params -let with_html entry = Entry.{ entry; html = html_of_entry entry } +let with_html entry : Entry.with_html = { entry; html = html_of_entry entry }