From 998b7875d74dce4467c404099a2d19693abf2721 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Fri, 13 Dec 2024 11:49:49 +0100 Subject: [PATCH] Use Comment.elements in document and index --- src/document/comment.ml | 4 +-- src/document/generator.ml | 38 +++++++++++++--------------- src/document/sidebar.ml | 2 +- src/index/entry.ml | 2 +- src/index/entry.mli | 4 +-- src/index/skeleton.ml | 32 +++++++++++------------ src/index/skeleton_of.ml | 13 +++------- src/odoc/html_fragment.ml | 2 +- src/search/html.mli | 4 +-- src/search/json_index/json_search.ml | 2 +- src/search/text.ml | 4 +-- src/search/text.mli | 2 +- 12 files changed, 51 insertions(+), 58 deletions(-) diff --git a/src/document/comment.ml b/src/document/comment.ml index da8bb53af2..532472979b 100644 --- a/src/document/comment.ml +++ b/src/document/comment.ml @@ -413,8 +413,8 @@ let standalone docs = Utils.flatmap ~f:item_element @@ List.map (fun x -> x.Odoc_model.Location_.value) docs -let to_ir (docs : Comment.docs) = +let to_ir (docs : Comment.elements) = Utils.flatmap ~f:block_element - @@ List.map (fun x -> x.Odoc_model.Location_.value) docs.elements + @@ List.map (fun x -> x.Odoc_model.Location_.value) docs let has_doc docs = docs <> [] diff --git a/src/document/generator.ml b/src/document/generator.ml index b751147f44..e69c981dce 100644 --- a/src/document/generator.ml +++ b/src/document/generator.ml @@ -530,10 +530,9 @@ module Make (Syntax : SYNTAX) = struct field fld.mutable_ (fld.id :> Paths.Identifier.t) fld.type_ in let anchor = Some url in - let rhs = Comment.to_ir fld.doc in - let doc = - if not (Comment.has_doc fld.doc.elements) then [] else rhs - in + let doc = fld.doc.elements in + let rhs = Comment.to_ir doc in + let doc = if not (Comment.has_doc doc) then [] else rhs in let markers = Syntax.Comment.markers in DocumentedSrc.Documented { anchor; attrs; code; doc; markers }) in @@ -610,10 +609,9 @@ module Make (Syntax : SYNTAX) = struct cstr.args cstr.res in let anchor = Some url in - let rhs = Comment.to_ir cstr.doc in - let doc = - if not (Comment.has_doc cstr.doc.elements) then [] else rhs - in + let doc = cstr.doc.elements in + let rhs = Comment.to_ir doc in + let doc = if not (Comment.has_doc doc) then [] else rhs in let markers = Syntax.Comment.markers in DocumentedSrc.Nested { anchor; attrs; code; doc; markers }) in @@ -625,7 +623,7 @@ module Make (Syntax : SYNTAX) = struct 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 doc = Comment.to_ir t.doc.elements in let markers = Syntax.Comment.markers in DocumentedSrc.Nested { anchor; attrs; code; doc; markers } @@ -646,7 +644,7 @@ module Make (Syntax : SYNTAX) = struct in let attr = [ "type"; "extension" ] in let anchor = Some (Url.Anchor.extension_decl t) in - let doc = Comment.to_ir t.doc in + let doc = Comment.to_ir t.doc.elements in let source_anchor = (* Take the anchor from the first constructor only for consistency with regular variants. *) @@ -666,7 +664,7 @@ module Make (Syntax : SYNTAX) = struct in let attr = [ "exception" ] in let anchor = path_to_id t.id in - let doc = Comment.to_ir t.doc in + let doc = Comment.to_ir t.doc.elements in let source_anchor = source_anchor t.source_loc in Item.Declaration { attr; anchor; doc; content; source_anchor } @@ -710,7 +708,7 @@ module Make (Syntax : SYNTAX) = struct else O.txt " " ++ O.keyword "of" ++ O.sp ++ params)), match doc with | { elements = []; _ } -> None - | _ -> Some (Comment.to_ir doc) )) + | _ -> Some (Comment.to_ir doc.elements) )) in let markers = Syntax.Comment.markers in try @@ -881,7 +879,7 @@ module Make (Syntax : SYNTAX) = struct in let attr = "type" :: (if is_substitution then [ "subst" ] else []) in let anchor = path_to_id t.id in - let doc = Comment.to_ir t.doc in + let doc = Comment.to_ir t.doc.elements in let source_anchor = source_anchor t.source_loc in Item.Declaration { attr; anchor; doc; content; source_anchor } end @@ -909,7 +907,7 @@ module Make (Syntax : SYNTAX) = struct in let attr = [ "value" ] @ extra_attr in let anchor = path_to_id t.id in - let doc = Comment.to_ir t.doc in + let doc = Comment.to_ir t.doc.elements in let source_anchor = source_anchor t.source_loc in Item.Declaration { attr; anchor; doc; content; source_anchor } end @@ -1010,7 +1008,7 @@ module Make (Syntax : SYNTAX) = struct in let attr = [ "method" ] in let anchor = path_to_id t.id in - let doc = Comment.to_ir t.doc in + let doc = Comment.to_ir t.doc.elements in Item.Declaration { attr; anchor; doc; content; source_anchor = None } let instance_variable (t : Odoc_model.Lang.InstanceVariable.t) = @@ -1029,7 +1027,7 @@ module Make (Syntax : SYNTAX) = struct in let attr = [ "value"; "instance-variable" ] in let anchor = path_to_id t.id in - let doc = Comment.to_ir t.doc in + let doc = Comment.to_ir t.doc.elements in Item.Declaration { attr; anchor; doc; content; source_anchor = None } let inherit_ (ih : Lang.ClassSignature.Inherit.t) = @@ -1043,7 +1041,7 @@ module Make (Syntax : SYNTAX) = struct in let attr = [ "inherit" ] in let anchor = None in - let doc = Comment.to_ir ih.doc in + let doc = Comment.to_ir ih.doc.elements in Item.Declaration { attr; anchor; doc; content; source_anchor = None } let constraint_ (cst : Lang.ClassSignature.Constraint.t) = @@ -1052,7 +1050,7 @@ module Make (Syntax : SYNTAX) = struct in let attr = [] in let anchor = None in - let doc = Comment.to_ir cst.doc in + let doc = Comment.to_ir cst.doc.elements in Item.Declaration { attr; anchor; doc; content; source_anchor = None } let class_signature (c : Lang.ClassSignature.t) = @@ -1314,7 +1312,7 @@ module Make (Syntax : SYNTAX) = struct in let attr = [ "module-substitution" ] in let anchor = path_to_id t.id in - let doc = Comment.to_ir t.doc in + let doc = Comment.to_ir t.doc.elements in Item.Declaration { attr; anchor; doc; content; source_anchor = None } and module_type_substitution (t : Odoc_model.Lang.ModuleTypeSubstitution.t) @@ -1724,7 +1722,7 @@ module Make (Syntax : SYNTAX) = struct synopsis because no page is generated to render it and we'd loose the full documentation. The documentation from the expansion is not used. *) - Comment.to_ir t.doc + Comment.to_ir t.doc.elements in Item.Include { attr; anchor; doc; content; source_anchor = None } end diff --git a/src/document/sidebar.ml b/src/document/sidebar.ml index 4ac5cfc5de..98eed7e9af 100644 --- a/src/document/sidebar.ml +++ b/src/document/sidebar.ml @@ -94,7 +94,7 @@ end = struct | Page { short_title = None; _ } -> let title = let open Odoc_model in - match Comment.find_zero_heading entry.doc.elements with + match Comment.find_zero_heading entry.doc with | Some t -> t | None -> let name = diff --git a/src/index/entry.ml b/src/index/entry.ml index fb746e920b..b81b6ca9f6 100644 --- a/src/index/entry.ml +++ b/src/index/entry.ml @@ -62,7 +62,7 @@ type kind = type t = { id : Odoc_model.Paths.Identifier.Any.t; - doc : Odoc_model.Comment.docs; + doc : Odoc_model.Comment.elements; kind : kind; } diff --git a/src/index/entry.mli b/src/index/entry.mli index bd51cf742e..b2704f5367 100644 --- a/src/index/entry.mli +++ b/src/index/entry.mli @@ -60,12 +60,12 @@ type kind = type t = { id : Odoc_model.Paths.Identifier.Any.t; - doc : Odoc_model.Comment.docs; + doc : Odoc_model.Comment.elements; kind : kind; } val entry : id:[< Odoc_model.Paths.Identifier.Any.t_pv ] Odoc_model.Paths.Identifier.id -> - doc:Odoc_model.Comment.docs -> + doc:Odoc_model.Comment.elements -> kind:kind -> t diff --git a/src/index/skeleton.ml b/src/index/skeleton.ml index 669e7065e6..921275ec27 100644 --- a/src/index/skeleton.ml +++ b/src/index/skeleton.ml @@ -6,13 +6,12 @@ open Odoc_utils type t = Entry.t Tree.t module Entry = struct + open Odoc_model.Comment + let of_comp_unit (u : Compilation_unit.t) = let has_expansion = true in let doc = - match u.content with - | Pack _ -> - { Odoc_model.Comment.elements = []; suppress_warnings = false } - | Module m -> m.doc + match u.content with Pack _ -> [] | Module m -> m.doc.elements in Entry.entry ~id:u.id ~doc ~kind:(Module { has_expansion }) @@ -20,7 +19,7 @@ module Entry = struct let has_expansion = match m.type_ with Alias (_, None) -> false | _ -> true in - Entry.entry ~id:m.id ~doc:m.doc ~kind:(Module { has_expansion }) + Entry.entry ~id:m.id ~doc:m.doc.elements ~kind:(Module { has_expansion }) let of_module_type (mt : ModuleType.t) = let has_expansion = @@ -35,7 +34,8 @@ module Entry = struct | _ -> false) | _ -> true in - Entry.entry ~id:mt.id ~doc:mt.doc ~kind:(ModuleType { has_expansion }) + Entry.entry ~id:mt.id ~doc:mt.doc.elements + ~kind:(ModuleType { has_expansion }) let of_type_decl (td : TypeDecl.t) = let kind = @@ -46,7 +46,7 @@ module Entry = struct representation = td.representation; } in - Entry.entry ~id:td.id ~doc:td.doc ~kind + Entry.entry ~id:td.id ~doc:td.doc.elements ~kind let varify_params = List.mapi (fun i param -> @@ -67,7 +67,7 @@ module Entry = struct params ) in let kind = Entry.Constructor { args; res } in - Entry.entry ~id:c.id ~doc:c.doc ~kind + Entry.entry ~id:c.id ~doc:c.doc.elements ~kind let of_field id_parent params (field : TypeDecl.Field.t) = let params = varify_params params in @@ -81,7 +81,7 @@ module Entry = struct Entry.Field { mutable_ = field.mutable_; type_ = field.type_; parent_type } in - Entry.entry ~id:field.id ~doc:field.doc ~kind + Entry.entry ~id:field.id ~doc:field.doc.elements ~kind let of_exception (exc : Exception.t) = let res = @@ -93,11 +93,11 @@ module Entry = struct | Some x -> x in let kind = Entry.Exception { args = exc.args; res } in - Entry.entry ~id:exc.id ~doc:exc.doc ~kind + Entry.entry ~id:exc.id ~doc:exc.doc.elements ~kind let of_value (v : Value.t) = let kind = Entry.Value { value = v.value; type_ = v.type_ } in - Entry.entry ~id:v.id ~doc:v.doc ~kind + Entry.entry ~id:v.id ~doc:v.doc.elements ~kind let of_extension_constructor type_path params (v : Extension.Constructor.t) = let res = @@ -108,26 +108,26 @@ module Entry = struct TypeExpr.Constr (type_path, params) in let kind = Entry.ExtensionConstructor { args = v.args; res } in - Entry.entry ~id:v.id ~doc:v.doc ~kind + Entry.entry ~id:v.id ~doc:v.doc.elements ~kind let of_class (cl : Class.t) = let kind = Entry.Class { virtual_ = cl.virtual_; params = cl.params } in - Entry.entry ~id:cl.id ~doc:cl.doc ~kind + Entry.entry ~id:cl.id ~doc:cl.doc.elements ~kind let of_class_type (ct : ClassType.t) = let kind = Entry.Class_type { virtual_ = ct.virtual_; params = ct.params } in - Entry.entry ~id:ct.id ~doc:ct.doc ~kind + Entry.entry ~id:ct.id ~doc:ct.doc.elements ~kind let of_method (m : Method.t) = let kind = Entry.Method { virtual_ = m.virtual_; private_ = m.private_; type_ = m.type_ } in - Entry.entry ~id:m.id ~doc:m.doc ~kind + Entry.entry ~id:m.id ~doc:m.doc.elements ~kind - let of_docs id doc = Entry.entry ~id ~doc ~kind:Doc + let of_docs id doc = Entry.entry ~id ~doc:doc.elements ~kind:Doc end let if_non_hidden id f = diff --git a/src/index/skeleton_of.ml b/src/index/skeleton_of.ml index 86fae97b3c..27a8e80e1d 100644 --- a/src/index/skeleton_of.ml +++ b/src/index/skeleton_of.ml @@ -39,18 +39,15 @@ let compare_entry (t1 : t) (t2 : t) = try_ Astring.String.compare by_name @@ fun () -> 0 let rec t_of_in_progress (dir : In_progress.in_progress) : t = - let empty_doc = { Comment.elements = []; suppress_warnings = false } in - let entry_of_page page = let kind = Entry.Page page.Lang.Page.frontmatter in - let doc = page.content in + let doc = page.content.elements in let id = page.name in Entry.entry ~kind ~doc ~id in let entry_of_impl id = let kind = Entry.Impl in - let doc = empty_doc in - Entry.entry ~kind ~doc ~id + Entry.entry ~kind ~doc:[] ~id in let children_order, index = match In_progress.index dir with @@ -63,16 +60,14 @@ let rec t_of_in_progress (dir : In_progress.in_progress) : t = match In_progress.root_dir dir with | Some id -> let kind = Entry.Dir in - let doc = empty_doc in - Entry.entry ~kind ~doc ~id + Entry.entry ~kind ~doc:[] ~id | None -> let id = (* root dir must have an index page *) Id.Mk.leaf_page (None, Names.PageName.make_std "index") in let kind = Entry.Dir in - let doc = empty_doc in - Entry.entry ~kind ~doc ~id + Entry.entry ~kind ~doc:[] ~id in (None, entry) in diff --git a/src/odoc/html_fragment.ml b/src/odoc/html_fragment.ml index 454e45f440..741f2e822e 100644 --- a/src/odoc/html_fragment.ml +++ b/src/odoc/html_fragment.ml @@ -34,7 +34,7 @@ let from_mld ~xref_base_uri ~resolver ~output ~warnings_options input = Odoc_xref2.Link.resolve_page ~filename:input_s env page |> Odoc_model.Error.handle_warnings ~warnings_options >>= fun resolved -> - let page = Odoc_document.Comment.to_ir resolved.content in + let page = Odoc_document.Comment.to_ir resolved.content.elements in let config = Odoc_html.Config.v ~semantic_uris:false ~indent:false ~flat:false ~open_details:false ~as_json:false ~remap:[] () diff --git a/src/search/html.mli b/src/search/html.mli index 0a069e6506..1533d14a73 100644 --- a/src/search/html.mli +++ b/src/search/html.mli @@ -27,11 +27,11 @@ val names_of_id : Paths.Identifier.t -> string * string The tuple is intended to be given respectively to the [prefix_name] and [name] arguments of {!Odoc_html_frontend.of_strings}. *) -val of_doc : Comment.docs -> html +val of_doc : Comment.elements -> html (** [of_doc d] returns the HTML associated of the documentation comment [d], generated correctly for search (no links or anchors). *) -val html_string_of_doc : Comment.docs -> string +val html_string_of_doc : Comment.elements -> string (** [html_string_of_doc d] is the same as {!of_doc} converted to a string. *) diff --git a/src/search/json_index/json_search.ml b/src/search/json_index/json_search.ml index ec2a9a4a92..fa45dea50b 100644 --- a/src/search/json_index/json_search.ml +++ b/src/search/json_index/json_search.ml @@ -81,7 +81,7 @@ let rec of_id x = let of_id n = `Array (List.rev @@ of_id (n :> Odoc_model.Paths.Identifier.t)) -let of_doc (doc : Odoc_model.Comment.docs) = +let of_doc (doc : Odoc_model.Comment.elements) = let txt = Text.of_doc doc in `String txt diff --git a/src/search/text.ml b/src/search/text.ml index 6aef8bf37e..3ef043edfb 100644 --- a/src/search/text.ml +++ b/src/search/text.ml @@ -41,8 +41,8 @@ module Of_comments = struct let get_value x = x.Odoc_model.Location_.value - let rec string_of_doc (doc : Odoc_model.Comment.docs) = - doc.elements |> List.map get_value + let rec string_of_doc (doc : Odoc_model.Comment.elements) = + doc |> List.map get_value |> List.map s_of_block_element |> String.concat "\n" diff --git a/src/search/text.mli b/src/search/text.mli index 7ed6f2e7a7..0bedba25b4 100644 --- a/src/search/text.mli +++ b/src/search/text.mli @@ -4,6 +4,6 @@ val of_type : Odoc_model.Lang.TypeExpr.t -> string -val of_doc : Odoc_model.Comment.docs -> string +val of_doc : Odoc_model.Comment.elements -> string val of_record : Odoc_model.Lang.TypeDecl.Field.t list -> string