From 7f8c5d9578a08dded87a8da086a17e401ad8a092 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Fri, 8 Nov 2024 18:27:28 +0100 Subject: [PATCH] Refactor change API of Url.from_identifier --- src/document/comment.ml | 16 +-- src/document/generator.ml | 133 +++++++++------------ src/document/sidebar.ml | 12 +- src/document/url.ml | 153 ++++++++++--------------- src/document/url.mli | 26 +---- src/odoc/url.ml | 11 +- src/search/html.ml | 16 +-- src/search/html.mli | 2 +- src/search/json_index/json_display.ml | 17 ++- src/search/json_index/json_display.mli | 5 +- src/search/json_index/json_search.ml | 20 +--- 11 files changed, 152 insertions(+), 259 deletions(-) diff --git a/src/document/comment.ml b/src/document/comment.ml index 9522ec7f6f..70a06b4322 100644 --- a/src/document/comment.ml +++ b/src/document/comment.ml @@ -107,7 +107,7 @@ module Reference = struct let to_ir : ?text:Inline.t -> Reference.t -> Inline.t = fun ?text ref -> match ref with - | `Resolved r -> ( + | `Resolved r -> (* IDENTIFIER MUST BE RENAMED TO DEFINITION. *) let id = Reference.Resolved.identifier r in let rendered = render_resolved r in @@ -119,16 +119,10 @@ module Reference = struct (* Add a tooltip if the content is not the rendered reference. *) match text with None -> None | Some _ -> Some rendered in - match Url.from_identifier ~stop_before:false id with - | Ok url -> - let target = Target.Internal (Resolved url) in - let link = { Link.target; content; tooltip } in - [ inline @@ Inline.Link link ] - | Error (Not_linkable _) -> content - | Error exn -> - (* FIXME: better error message *) - Printf.eprintf "Id.href failed: %S\n%!" (Url.Error.to_string exn); - content) + let url = Url.from_identifier ~stop_before:false id in + let target = Target.Internal (Resolved url) in + let link = { Link.target; content; tooltip } in + [ inline @@ Inline.Link link ] | _ -> ( let s = render_unresolved ref in match text with diff --git a/src/document/generator.ml b/src/document/generator.ml index 308785ff5b..3c29852388 100644 --- a/src/document/generator.ml +++ b/src/document/generator.ml @@ -43,18 +43,15 @@ let unresolved content = O.elt [ inline @@ Link link ] let path_to_id path = - match Url.Anchor.from_identifier (path :> Paths.Identifier.t) with - | Error _ -> None - | Ok url -> Some url + let url = Url.Anchor.from_identifier (path :> Paths.Identifier.t) in + Some url let source_anchor source_loc = - (* Remove when dropping support for OCaml < 4.08 *) - let to_option = function Result.Ok x -> Some x | Result.Error _ -> None in match source_loc with | Some id -> - Url.Anchor.from_identifier - (id : Paths.Identifier.SourceLocation.t :> Paths.Identifier.t) - |> to_option + Some + (Url.Anchor.from_identifier + (id : Paths.Identifier.SourceLocation.t :> Paths.Identifier.t)) | _ -> None let attach_expansion ?(status = `Default) (eq, o, e) page text = @@ -133,7 +130,7 @@ module Make (Syntax : SYNTAX) = struct | `Resolved _ when Paths.Path.is_hidden path -> let txt = Url.render_path path in unresolved [ inline @@ Text txt ] - | `Resolved rp -> ( + | `Resolved rp -> (* If the path is pointing to an opaque module or module type there won't be a page generated - so we stop before; at the parent page, and link instead to the anchor representing @@ -145,12 +142,8 @@ module Make (Syntax : SYNTAX) = struct in let id = Paths.Path.Resolved.identifier rp in let txt = Url.render_path path in - match Url.from_identifier ~stop_before id with - | Ok href -> resolved href [ inline @@ Text txt ] - | Error (Url.Error.Not_linkable _) -> O.txt txt - | Error exn -> - Printf.eprintf "Id.href failed: %S\n%!" (Url.Error.to_string exn); - O.txt txt) + let href = Url.from_identifier ~stop_before id in + resolved href [ inline @@ Text txt ] let dot prefix suffix = prefix ^ "." ^ suffix @@ -194,13 +187,8 @@ module Make (Syntax : SYNTAX) = struct let open Fragment in let id = Resolved.identifier (fragment :> Resolved.t) in let txt = render_resolved_fragment (fragment :> Resolved.t) in - match Url.from_identifier ~stop_before:false id with - | Ok href -> resolved href [ inline @@ Text txt ] - | Error (Not_linkable _) -> unresolved [ inline @@ Text txt ] - | Error exn -> - Printf.eprintf "[FRAG] Id.href failed: %S\n%!" - (Url.Error.to_string exn); - unresolved [ inline @@ Text txt ] + let href = Url.from_identifier ~stop_before:false id in + resolved href [ inline @@ Text txt ] let from_fragment : Fragment.leaf -> text = function | `Resolved r @@ -276,10 +264,8 @@ module Make (Syntax : SYNTAX) = struct in let implementation = match implementation with - | Some (Odoc_model.Lang.Source_info.Resolved id) -> ( - match Url.Anchor.from_identifier (id :> Paths.Identifier.t) with - | Ok url -> Some url - | Error _ -> None) + | Some (Odoc_model.Lang.Source_info.Resolved id) -> + Some (Url.Anchor.from_identifier (id :> Paths.Identifier.t)) | _ -> None in Some (Source_page.Link { implementation; documentation }) @@ -519,26 +505,22 @@ module Make (Syntax : SYNTAX) = struct end = struct let record fields = let field mutable_ id typ = - match Url.from_identifier ~stop_before:true id with - | Error e -> failwith (Url.Error.to_string e) - | Ok url -> - let name = Paths.Identifier.name id in - let attrs = - [ "def"; "record"; Url.Anchor.string_of_kind url.kind ] - in - let cell = - (* O.td ~a:[ O.a_class ["def"; kind ] ] - * [O.a ~a:[O.a_href ("#" ^ anchor); O.a_class ["anchor"]] [] - * ; *) - O.code - ((if mutable_ then O.keyword "mutable" ++ O.txt " " else O.noop) - ++ O.txt name - ++ O.txt Syntax.Type.annotation_separator - ++ type_expr typ - ++ O.txt Syntax.Type.Record.field_separator) - (* ] *) - in - (url, attrs, cell) + let url = Url.from_identifier ~stop_before:true id in + let name = Paths.Identifier.name id in + let attrs = [ "def"; "record"; Url.Anchor.string_of_kind url.kind ] in + let cell = + (* O.td ~a:[ O.a_class ["def"; kind ] ] + * [O.a ~a:[O.a_href ("#" ^ anchor); O.a_class ["anchor"]] [] + * ; *) + O.code + ((if mutable_ then O.keyword "mutable" ++ O.txt " " else O.noop) + ++ O.txt name + ++ O.txt Syntax.Type.annotation_separator + ++ type_expr typ + ++ O.txt Syntax.Type.Record.field_separator) + (* ] *) + in + (url, attrs, cell) in let rows = fields @@ -605,17 +587,13 @@ module Make (Syntax : SYNTAX) = struct let variant cstrs : DocumentedSrc.t = let constructor id args res = - match Url.from_identifier ~stop_before:true id with - | Error e -> failwith (Url.Error.to_string e) - | Ok url -> - let attrs = - [ "def"; "variant"; Url.Anchor.string_of_kind url.kind ] - in - let content = - let doc = constructor id args res in - O.documentedSrc (O.txt "| ") @ doc - in - (url, attrs, content) + let url = Url.from_identifier ~stop_before:true id in + let attrs = [ "def"; "variant"; Url.Anchor.string_of_kind url.kind ] in + let content = + let doc = constructor id args res in + O.documentedSrc (O.txt "| ") @ doc + in + (url, attrs, content) in match cstrs with | [] -> O.documentedSrc (O.txt "|") @@ -641,19 +619,13 @@ module Make (Syntax : SYNTAX) = struct let extension_constructor (t : Odoc_model.Lang.Extension.Constructor.t) = let id = (t.id :> Paths.Identifier.t) in - match Url.from_identifier ~stop_before:true id with - | Error e -> failwith (Url.Error.to_string e) - | Ok url -> - let anchor = Some url in - let attrs = - [ "def"; "variant"; Url.Anchor.string_of_kind url.kind ] - in - let code = - O.documentedSrc (O.txt "| ") @ constructor id t.args t.res - in - let doc = Comment.to_ir t.doc in - let markers = Syntax.Comment.markers in - DocumentedSrc.Nested { anchor; attrs; code; doc; markers } + let url = Url.from_identifier ~stop_before:true id in + let anchor = Some url in + let attrs = [ "def"; "variant"; Url.Anchor.string_of_kind url.kind ] in + let code = O.documentedSrc (O.txt "| ") @ constructor id t.args t.res in + let doc = Comment.to_ir t.doc in + let markers = Syntax.Comment.markers in + DocumentedSrc.Nested { anchor; attrs; code; doc; markers } let extension (t : Odoc_model.Lang.Extension.t) = let prefix = @@ -1386,8 +1358,8 @@ module Make (Syntax : SYNTAX) = struct let content = functor_parameter arg in let attr = [ "parameter" ] in let anchor = - Utils.option_of_result - @@ Url.Anchor.from_identifier (arg.id :> Paths.Identifier.t) + Some + (Url.Anchor.from_identifier (arg.id :> Paths.Identifier.t)) in let doc = [] in [ @@ -1614,11 +1586,10 @@ module Make (Syntax : SYNTAX) = struct let name = let open Odoc_model.Lang.FunctorParameter in let name = Paths.Identifier.name arg.id in - match + let href = Url.from_identifier ~stop_before (arg.id :> Paths.Identifier.t) - with - | Error _ -> O.txt name - | Ok href -> resolved href [ inline @@ Text name ] + in + resolved href [ inline @@ Text name ] in (if Syntax.Mod.functor_keyword then O.keyword "functor" else O.noop) ++ (O.box_hv @@ O.span @@ -1655,12 +1626,11 @@ module Make (Syntax : SYNTAX) = struct let name = let open Odoc_model.Lang.FunctorParameter in let name = Paths.Identifier.name arg.id in - match + let href = Url.from_identifier ~stop_before (arg.id :> Paths.Identifier.t) - with - | Error _ -> O.txt name - | Ok href -> resolved href [ inline @@ Text name ] + in + resolved href [ inline @@ Text name ] in O.box_hv @@ O.txt "(" ++ name @@ -1776,8 +1746,7 @@ module Make (Syntax : SYNTAX) = struct in let content = O.documentedSrc md_def in let anchor = - Utils.option_of_result - @@ Url.Anchor.from_identifier (id :> Paths.Identifier.t) + Some (Url.Anchor.from_identifier (id :> Paths.Identifier.t)) in let attr = [ "modules" ] in let doc = [] in diff --git a/src/document/sidebar.ml b/src/document/sidebar.ml index 3ce033d323..596cee6ab8 100644 --- a/src/document/sidebar.ml +++ b/src/document/sidebar.ml @@ -22,10 +22,7 @@ end = struct | None -> None | Some (index_id, title) -> let path = - match Url.from_identifier ~stop_before:false (index_id :> Id.t) with - | Ok r -> r - | Error _ -> assert false - (* This error case should never happen since [stop_before] is false, and even less since it's a page id *) + Url.from_identifier ~stop_before:false (index_id :> Id.t) in let content = Comment.link_content title in Some (path, sidebar_toc_entry path content) @@ -65,15 +62,12 @@ let of_lang (v : Odoc_index.sidebar) = let item id = let content = [ inline @@ Text (Odoc_model.Paths.Identifier.name id) ] in let path = Url.from_identifier ~stop_before:false (id :> Id.t) in - match path with - | Ok path -> Some (path, sidebar_toc_entry path content) - | Error _ -> None - (* This error case should never happen since [stop_before] is false *) + (path, sidebar_toc_entry path content) in let units = List.map (fun { Odoc_index.units; name } -> - let units = List.filter_map item units in + let units = List.map item units in { name; units }) v.libs in diff --git a/src/document/url.ml b/src/document/url.ml index ee4e36a8f2..b0d0771781 100644 --- a/src/document/url.ml +++ b/src/document/url.ml @@ -66,21 +66,6 @@ let render_path : Path.t -> string = render_path -module Error = struct - type nonrec t = - | Not_linkable of string - | Uncaught_exn of string - (* These should basicaly never happen *) - | Unexpected_anchor of string - - let to_string = function - | Not_linkable s -> Printf.sprintf "Not_linkable %S" s - | Uncaught_exn s -> Printf.sprintf "Uncaught_exn %S" s - | Unexpected_anchor s -> Printf.sprintf "Unexpected_anchor %S" s -end - -open Odoc_utils.ResultMonad - module Path = struct type nonsrc_pv = [ Identifier.Page.t_pv @@ -273,7 +258,7 @@ module Anchor = struct _constructor_ identifiers. *) let suffix_for_constructor x = x - let rec from_identifier : Identifier.t -> (t, Error.t) result = function + let rec from_identifier : Identifier.t -> t = function | { iv = `Module (parent, mod_name); _ } -> let parent = Path.from_identifier (parent :> Path.any) in let kind = `Module in @@ -281,122 +266,111 @@ module Anchor = struct Printf.sprintf "%s-%s" (Path.string_of_kind kind) (ModuleName.to_string mod_name) in - Ok { page = parent; anchor; kind } + { page = parent; anchor; kind } | { iv = `Root _; _ } as p -> let page = Path.from_identifier (p :> Path.any) in - Ok { page; kind = `Module; anchor = "" } + { page; kind = `Module; anchor = "" } | { iv = `Page _; _ } as p -> let page = Path.from_identifier (p :> Path.any) in - Ok { page; kind = `Page; anchor = "" } + { page; kind = `Page; anchor = "" } | { iv = `LeafPage _; _ } as p -> let page = Path.from_identifier (p :> Path.any) in - Ok { page; kind = `LeafPage; anchor = "" } + { page; kind = `LeafPage; anchor = "" } (* For all these identifiers, page names and anchors are the same *) | { iv = `Parameter _ | `Result _ | `ModuleType _ | `Class _ | `ClassType _; _; } as p -> - Ok (anchorify_path @@ Path.from_identifier p) + anchorify_path @@ Path.from_identifier p | { iv = `Type (parent, type_name); _ } -> let page = Path.from_identifier (parent :> Path.any) in let kind = `Type in - Ok - { - page; - anchor = - Format.asprintf "%a-%s" pp_kind kind - (TypeName.to_string type_name); - kind; - } + { + page; + anchor = + Format.asprintf "%a-%s" pp_kind kind (TypeName.to_string type_name); + kind; + } | { iv = `Extension (parent, name); _ } -> let page = Path.from_identifier (parent :> Path.any) in let kind = `Extension in - Ok - { - page; - anchor = - Format.asprintf "%a-%s" pp_kind kind - (ExtensionName.to_string name); - kind; - } + { + page; + anchor = + Format.asprintf "%a-%s" pp_kind kind (ExtensionName.to_string name); + kind; + } | { iv = `ExtensionDecl (parent, name, _); _ } -> let page = Path.from_identifier (parent :> Path.any) in let kind = `ExtensionDecl in - Ok - { - page; - anchor = - Format.asprintf "%a-%s" pp_kind kind - (ExtensionName.to_string name); - kind; - } + { + page; + anchor = + Format.asprintf "%a-%s" pp_kind kind (ExtensionName.to_string name); + kind; + } | { iv = `Exception (parent, name); _ } -> let page = Path.from_identifier (parent :> Path.any) in let kind = `Exception in - Ok - { - page; - anchor = - Format.asprintf "%a-%s" pp_kind kind - (ExceptionName.to_string name); - kind; - } + { + page; + anchor = + Format.asprintf "%a-%s" pp_kind kind (ExceptionName.to_string name); + kind; + } | { iv = `Value (parent, name); _ } -> let page = Path.from_identifier (parent :> Path.any) in let kind = `Val in - Ok - { - page; - anchor = - Format.asprintf "%a-%s" pp_kind kind (ValueName.to_string name); - kind; - } + { + page; + anchor = + Format.asprintf "%a-%s" pp_kind kind (ValueName.to_string name); + kind; + } | { iv = `Method (parent, name); _ } -> let str_name = MethodName.to_string name in let page = Path.from_identifier (parent :> Path.any) in let kind = `Method in - Ok - { page; anchor = Format.asprintf "%a-%s" pp_kind kind str_name; kind } + { page; anchor = Format.asprintf "%a-%s" pp_kind kind str_name; kind } | { iv = `InstanceVariable (parent, name); _ } -> let str_name = InstanceVariableName.to_string name in let page = Path.from_identifier (parent :> Path.any) in let kind = `Val in - Ok - { page; anchor = Format.asprintf "%a-%s" pp_kind kind str_name; kind } + { page; anchor = Format.asprintf "%a-%s" pp_kind kind str_name; kind } | { iv = `Constructor (parent, name); _ } -> - from_identifier (parent :> Identifier.t) >>= fun page -> + let page = from_identifier (parent :> Identifier.t) in let kind = `Constructor in let suffix = suffix_for_constructor (ConstructorName.to_string name) in - Ok (add_suffix ~kind page suffix) + add_suffix ~kind page suffix | { iv = `Field (parent, name); _ } -> - from_identifier (parent :> Identifier.t) >>= fun page -> + let page = from_identifier (parent :> Identifier.t) in let kind = `Field in let suffix = FieldName.to_string name in - Ok (add_suffix ~kind page suffix) + add_suffix ~kind page suffix | { iv = `Label (parent, anchor); _ } -> ( let str_name = LabelName.to_string anchor in (* [Identifier.LabelParent.t] contains datatypes. [`CoreType] can't happen, [`Type] may not happen either but just in case, use the grand-parent. *) match parent with - | { iv = `Type (gp, _); _ } -> Ok (mk ~kind:`Section gp str_name) + | { iv = `Type (gp, _); _ } -> mk ~kind:`Section gp str_name | { iv = #Path.nonsrc_pv; _ } as p -> - Ok (mk ~kind:`Section (p :> Path.any) str_name)) + mk ~kind:`Section (p :> Path.any) str_name) | { iv = `SourceLocation (parent, loc); _ } -> let page = Path.from_identifier (parent :> Path.any) in - Ok { page; kind = `SourceAnchor; anchor = DefName.to_string loc } + { page; kind = `SourceAnchor; anchor = DefName.to_string loc } | { iv = `SourceLocationInternal (parent, loc); _ } -> let page = Path.from_identifier (parent :> Path.any) in - Ok { page; kind = `SourceAnchor; anchor = LocalName.to_string loc } + { page; kind = `SourceAnchor; anchor = LocalName.to_string loc } | { iv = `SourceLocationMod parent; _ } -> let page = Path.from_identifier (parent :> Path.any) in - Ok { page; kind = `SourceAnchor; anchor = "" } + { page; kind = `SourceAnchor; anchor = "" } | { iv = `SourcePage _; _ } as p -> let page = Path.from_identifier (p :> Path.any) in - Ok { page; kind = `Page; anchor = "" } + { page; kind = `Page; anchor = "" } | { iv = `AssetFile _; _ } as p -> let page = Path.from_identifier p in - Ok { page; kind = `File; anchor = "" } + { page; kind = `File; anchor = "" } let polymorphic_variant ~type_ident elt = let name_of_type_constr te = @@ -412,18 +386,16 @@ module Anchor = struct invalid_arg "DocOckHtml.Url.Polymorphic_variant_decl.name_of_type_constr" in - match from_identifier type_ident with - | Error e -> failwith (Error.to_string e) - | Ok url -> ( - match elt with - | Odoc_model.Lang.TypeExpr.Polymorphic_variant.Type te -> - let kind = `Type in - let suffix = name_of_type_constr te in - add_suffix ~kind url suffix - | Constructor { name; _ } -> - let kind = `Constructor in - let suffix = suffix_for_constructor name in - add_suffix ~kind url suffix) + let url = from_identifier type_ident in + match elt with + | Odoc_model.Lang.TypeExpr.Polymorphic_variant.Type te -> + let kind = `Type in + let suffix = name_of_type_constr te in + add_suffix ~kind url suffix + | Constructor { name; _ } -> + let kind = `Constructor in + let suffix = suffix_for_constructor name in + add_suffix ~kind url suffix (** The anchor looks like [extension-decl-"Path.target_type"-FirstConstructor]. *) @@ -447,12 +419,11 @@ let from_path page = let from_identifier ~stop_before x = match x with | { Identifier.iv = #Path.any_pv; _ } as p when not stop_before -> - Ok (from_path @@ Path.from_identifier p) + from_path @@ Path.from_identifier p | p -> Anchor.from_identifier p let from_asset_identifier p = from_path @@ Path.from_identifier p let kind id = - match Anchor.from_identifier id with - | Error e -> failwith (Error.to_string e) - | Ok { kind; _ } -> kind + let { Anchor.kind; _ } = Anchor.from_identifier id in + kind diff --git a/src/document/url.mli b/src/document/url.mli index f69c1c57c9..b7361e9cc4 100644 --- a/src/document/url.mli +++ b/src/document/url.mli @@ -1,16 +1,5 @@ -open Result open Odoc_model.Paths -module Error : sig - type nonrec t = - | Not_linkable of string - | Uncaught_exn of string - (* These should basicaly never happen *) - | Unexpected_anchor of string - - val to_string : t -> string -end - module Path : sig type kind = [ `Module @@ -90,7 +79,7 @@ module Anchor : sig e.g. "module", "module-type", "exception", ... *) } - val from_identifier : Identifier.t -> (t, Error.t) result + val from_identifier : Identifier.t -> t val polymorphic_variant : type_ident:Identifier.t -> @@ -110,7 +99,7 @@ type t = Anchor.t val from_path : Path.t -> t -val from_identifier : stop_before:bool -> Identifier.t -> (t, Error.t) result +val from_identifier : stop_before:bool -> Identifier.t -> t (** [from_identifier] turns an identifier to an url. Some identifiers can be accessed in different ways. For instance, @@ -120,14 +109,11 @@ val from_identifier : stop_before:bool -> Identifier.t -> (t, Error.t) result The [stop_before] boolean controls that: with [~stop_before:true], the url will point to the parent page when applicable. - There are several wrong ways to use [from_identifier]: - - Using [~stop_before:false] with a module that does not contain an - expansion, such as a module alias. This will return [Ok url] but [url] - leads to a 404. - - Calling it with an unlinkable id, such as a core type. This will return - an [Error _] value. + There is a pitfall with [from_identifier]: Using [~stop_before:false] with + a module that does not contain an expansion, such as a module alias. This + will return a [url] leading to a 404 page. - Please, reader, go and fix this API. Thanks. *) + It would be nice to enforce no 404 by the type system. *) val from_asset_identifier : Identifier.AssetFile.t -> t diff --git a/src/odoc/url.ml b/src/odoc/url.ml index 95c6e09e77..6b60874e94 100644 --- a/src/odoc/url.ml +++ b/src/odoc/url.ml @@ -26,19 +26,16 @@ let resolve url_to_string directories reference = Odoc_xref2.Errors.Tools_error.pp_reference_lookup_error e in Error (`Msg error) - | Ok (resolved_reference, _) -> ( + | Ok (resolved_reference, _) -> let identifier = Odoc_model.Paths.Reference.Resolved.identifier resolved_reference in let url = Odoc_document.Url.from_identifier ~stop_before:false identifier in - match url with - | Error e -> Error (`Msg (Odoc_document.Url.Error.to_string e)) - | Ok url -> - let href = url_to_string url in - print_endline href; - Ok ())) + let href = url_to_string url in + print_endline href; + Ok ()) let reference_to_url_html { Html_page.html_config = config; _ } root_url = let url_to_string url = diff --git a/src/search/html.ml b/src/search/html.ml index 9e47a02b9e..da016bd55d 100644 --- a/src/search/html.ml +++ b/src/search/html.ml @@ -19,16 +19,12 @@ let url { Entry.id; kind; doc = _ } = shorten the match. *) match kind with Doc _ -> false | _ -> true in - match Odoc_document.Url.from_identifier ~stop_before id with - | Ok url -> - let config = - Odoc_html.Config.v ~search_result:true ~semantic_uris:false - ~indent:false ~flat:false ~open_details:false ~as_json:false ~remap:[] - () - in - let url = Odoc_html.Link.href ~config ~resolve:(Base "") url in - Result.Ok url - | Error _ as e -> e + let url = Odoc_document.Url.from_identifier ~stop_before id in + let config = + Odoc_html.Config.v ~search_result:true ~semantic_uris:false ~indent:false + ~flat:false ~open_details:false ~as_json:false ~remap:[] () + in + Odoc_html.Link.href ~config ~resolve:(Base "") url let map_option f = function Some x -> Some (f x) | None -> None diff --git a/src/search/html.mli b/src/search/html.mli index 2134584808..32862220b6 100644 --- a/src/search/html.mli +++ b/src/search/html.mli @@ -5,7 +5,7 @@ type html = Html_types.div_content Tyxml.Html.elt val of_entry : Entry.t -> html list -val url : Entry.t -> (string, Odoc_document.Url.Error.t) Result.result +val url : Entry.t -> string (** The below is intended for search engine that do not use the Json output but Odoc as a library. Most search engine will use their own representation diff --git a/src/search/json_index/json_display.ml b/src/search/json_index/json_display.ml index e269291cab..d2171ee43b 100644 --- a/src/search/json_index/json_display.ml +++ b/src/search/json_index/json_display.ml @@ -1,13 +1,10 @@ open Odoc_search let of_entry entry h = - match Html.url entry with - | Result.Ok url -> - let html = - h - |> List.map (fun html -> - Format.asprintf "%a" (Tyxml.Html.pp_elt ()) html) - |> String.concat "" - in - Result.Ok (`Object [ ("url", `String url); ("html", `String html) ]) - | Error _ as e -> e + let url = Html.url entry in + let html = + h + |> List.map (fun html -> Format.asprintf "%a" (Tyxml.Html.pp_elt ()) html) + |> String.concat "" + in + `Object [ ("url", `String url); ("html", `String html) ] diff --git a/src/search/json_index/json_display.mli b/src/search/json_index/json_display.mli index df72e9d198..18e4cfbe6b 100644 --- a/src/search/json_index/json_display.mli +++ b/src/search/json_index/json_display.mli @@ -1,6 +1,3 @@ open Odoc_search -val of_entry : - Odoc_index.Entry.t -> - Html.html list -> - (Odoc_html.Json.json, Odoc_document.Url.Error.t) Result.result +val of_entry : Odoc_index.Entry.t -> Html.html list -> Odoc_html.Json.json diff --git a/src/search/json_index/json_search.ml b/src/search/json_index/json_search.ml index 7a8dd13eb7..102bbbd144 100644 --- a/src/search/json_index/json_search.ml +++ b/src/search/json_index/json_search.ml @@ -179,13 +179,10 @@ let of_entry ({ Entry.id; doc; kind } as entry) html occurrences = ] | None -> [] in - match Json_display.of_entry entry html with - | Result.Ok display -> - Result.Ok - (`Object - ([ ("id", j_id); ("doc", doc); ("kind", kind); ("display", display) ] - @ occurrences)) - | Error _ as e -> e + let display = Json_display.of_entry entry html in + `Object + ([ ("id", j_id); ("doc", doc); ("kind", kind); ("display", display) ] + @ occurrences) let output_json ppf first entries = let output_json json = @@ -196,13 +193,8 @@ let output_json ppf first entries = (fun first (entry, html, occurrences) -> let json = of_entry entry html occurrences in if not first then Format.fprintf ppf ","; - match json with - | Ok json -> - output_json json; - false - | Error e -> - Printf.eprintf "%S" (Odoc_document.Url.Error.to_string e); - true) + output_json json; + false) first entries let unit ?occurrences ppf u =