From 10a2e6f09936fffb76af286afc98616dc9c54e0b Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Mon, 6 May 2024 09:19:04 +0200 Subject: [PATCH 1/4] Add test for IDs for search entries of standalone comments Exhibit a bug! Signed-off-by: Paul-Elliot --- test/search/id_standalone_comments.t/main.ml | 11 +++++++++++ test/search/id_standalone_comments.t/run.t | 20 ++++++++++++++++++++ 2 files changed, 31 insertions(+) create mode 100644 test/search/id_standalone_comments.t/main.ml create mode 100644 test/search/id_standalone_comments.t/run.t diff --git a/test/search/id_standalone_comments.t/main.ml b/test/search/id_standalone_comments.t/main.ml new file mode 100644 index 0000000000..87db5f6840 --- /dev/null +++ b/test/search/id_standalone_comments.t/main.ml @@ -0,0 +1,11 @@ +let _ = 1 + +(** standalone 1 *) + +module X = struct + let _ = 1 + + (** standalone 2 *) +end + +(** standalone 3 *) diff --git a/test/search/id_standalone_comments.t/run.t b/test/search/id_standalone_comments.t/run.t new file mode 100644 index 0000000000..e11fd67e11 --- /dev/null +++ b/test/search/id_standalone_comments.t/run.t @@ -0,0 +1,20 @@ +Compile the files + + $ ocamlc -c main.ml -bin-annot -I . + +Compile and link the documentation + + $ odoc compile -I . main.cmt + $ odoc link -I . main.odoc + + $ odoc compile-index main.odocl + +Let's have a look at the links generated for standalone comments search entries: + + $ cat index.json | jq -r '.[] | select(.kind.kind | contains("Doc")) | "\(.doc) -> \(.display.url)"' + standalone 1 -> Main/index.html + standalone 2 -> Main/X/index.html + standalone 3 -> Main/X/index.html + +There is a problem with "standalone 3": it should link to Main/index.html, not Main/X/index.html +This is a bug! From bce79c703c1d8c3c204a8c0c5d405b61dd286c87 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Tue, 20 Feb 2024 14:54:17 +0100 Subject: [PATCH 2/4] Fix wrong id being given to doc comments Standalone documentation comments currently do not have an id. This id was carried as the accumulator of the field, which yielded wrong results! Signed-off-by: Paul-Elliot --- src/model/fold.ml | 76 +++++++++++++--------- src/model/fold.mli | 62 ++++++++++++++---- src/search/entry.ml | 6 +- src/search/entry.mli | 3 +- src/search/json_index/json_search.ml | 32 ++------- test/search/html_search.t/run.t | 28 ++++---- test/search/id_standalone_comments.t/run.t | 6 +- 7 files changed, 124 insertions(+), 89 deletions(-) diff --git a/src/model/fold.ml b/src/model/fold.ml index 0aff4964f2..f6f740ee6c 100644 --- a/src/model/fold.ml +++ b/src/model/fold.ml @@ -11,20 +11,24 @@ type item = | Class of Class.t | Extension of Extension.t | ModuleType of ModuleType.t - | Doc of Comment.docs_or_stop + | Doc of Paths.Identifier.LabelParent.t * Comment.docs_or_stop let rec unit ~f acc u = let acc = f acc (CompilationUnit u) in - match u.content with Module m -> signature ~f acc m | Pack _ -> acc + match u.content with + | Module m -> signature ~f (u.id :> Paths.Identifier.LabelParent.t) acc m + | Pack _ -> acc and page ~f acc p = let open Page in - docs ~f acc (`Docs p.content) + docs ~f (p.name :> Paths.Identifier.LabelParent.t) acc (`Docs p.content) -and signature ~f acc (s : Signature.t) = - List.fold_left (signature_item ~f) acc s.items +and signature ~f id acc (s : Signature.t) = + List.fold_left + (signature_item ~f (id :> Paths.Identifier.LabelParent.t)) + acc s.items -and signature_item ~f acc s_item = +and signature_item ~f id acc s_item = match s_item with | Module (_, m) -> module_ ~f acc m | ModuleType mt -> module_type ~f acc mt @@ -38,12 +42,12 @@ and signature_item ~f acc s_item = | Value v -> value ~f acc v | Class (_, cl) -> class_ ~f acc cl | ClassType (_, clt) -> class_type ~f acc clt - | Include i -> include_ ~f acc i - | Comment d -> docs ~f acc d + | Include i -> include_ ~f id acc i + | Comment d -> docs ~f id acc d -and docs ~f acc d = f acc (Doc d) +and docs ~f id acc d = f acc (Doc (id, d)) -and include_ ~f acc inc = signature ~f acc inc.expansion.content +and include_ ~f id acc inc = signature ~f id acc inc.expansion.content and class_type ~f acc ct = (* This check is important because [is_hidden] does not work on children of @@ -53,18 +57,21 @@ and class_type ~f acc ct = if Paths.Identifier.is_hidden ct.id then acc else let acc = f acc (ClassType ct) in - match ct.expansion with None -> acc | Some cs -> class_signature ~f acc cs + match ct.expansion with + | None -> acc + | Some cs -> + class_signature ~f (ct.id :> Paths.Identifier.LabelParent.t) acc cs -and class_signature ~f acc ct_expr = - List.fold_left (class_signature_item ~f) acc ct_expr.items +and class_signature ~f id acc ct_expr = + List.fold_left (class_signature_item ~f id) acc ct_expr.items -and class_signature_item ~f acc item = +and class_signature_item ~f id acc item = match item with | Method m -> f acc (Method m) | InstanceVariable _ -> acc | Constraint _ -> acc | Inherit _ -> acc - | Comment d -> docs ~f acc d + | Comment d -> docs ~f id acc d and class_ ~f acc cl = if Paths.Identifier.is_hidden cl.id then acc @@ -72,7 +79,10 @@ and class_ ~f acc cl = let acc = f acc (Class cl) in match cl.expansion with | None -> acc - | Some cl_signature -> class_signature ~f acc cl_signature + | Some cl_signature -> + class_signature ~f + (cl.id :> Paths.Identifier.LabelParent.t) + acc cl_signature and exception_ ~f acc exc = if Paths.Identifier.is_hidden exc.id then acc else f acc (Exception exc) @@ -88,8 +98,10 @@ and module_ ~f acc m = let acc = f acc (Module m) in match m.type_ with | Alias (_, None) -> acc - | Alias (_, Some s_e) -> simple_expansion ~f acc s_e - | ModuleType mte -> module_type_expr ~f acc mte + | Alias (_, Some s_e) -> + simple_expansion ~f (m.id :> Paths.Identifier.LabelParent.t) acc s_e + | ModuleType mte -> + module_type_expr ~f (m.id :> Paths.Identifier.LabelParent.t) acc mte and type_decl ~f acc td = if Paths.Identifier.is_hidden td.id then acc else f acc (TypeDecl td) @@ -100,27 +112,33 @@ and module_type ~f acc mt = let acc = f acc (ModuleType mt) in match mt.expr with | None -> acc - | Some mt_expr -> module_type_expr ~f acc mt_expr + | Some mt_expr -> + module_type_expr ~f + (mt.id :> Paths.Identifier.LabelParent.t) + acc mt_expr -and simple_expansion ~f acc s_e = +and simple_expansion ~f id acc s_e = match s_e with - | Signature sg -> signature ~f acc sg + | Signature sg -> signature ~f id acc sg | Functor (p, s_e) -> let acc = functor_parameter ~f acc p in - simple_expansion ~f acc s_e + simple_expansion ~f id acc s_e -and module_type_expr ~f acc mte = +and module_type_expr ~f id acc mte = match mte with - | Signature s -> signature ~f acc s + | Signature s -> signature ~f id acc s | Functor (fp, mt_expr) -> let acc = functor_parameter ~f acc fp in - module_type_expr ~f acc mt_expr - | With { w_expansion = Some sg; _ } -> simple_expansion ~f acc sg - | TypeOf { t_expansion = Some sg; _ } -> simple_expansion ~f acc sg - | Path { p_expansion = Some sg; _ } -> simple_expansion ~f acc sg + module_type_expr ~f id acc mt_expr + | With { w_expansion = Some sg; _ } -> simple_expansion ~f id acc sg + | TypeOf { t_expansion = Some sg; _ } -> simple_expansion ~f id acc sg + | Path { p_expansion = Some sg; _ } -> simple_expansion ~f id acc sg | Path { p_expansion = None; _ } -> acc | With { w_expansion = None; _ } -> acc | TypeOf { t_expansion = None; _ } -> acc and functor_parameter ~f acc fp = - match fp with Unit -> acc | Named n -> module_type_expr ~f acc n.expr + match fp with + | Unit -> acc + | Named n -> + module_type_expr ~f (n.id :> Paths.Identifier.LabelParent.t) acc n.expr diff --git a/src/model/fold.mli b/src/model/fold.mli index 6e1710060e..39364341dd 100644 --- a/src/model/fold.mli +++ b/src/model/fold.mli @@ -17,23 +17,54 @@ type item = | Class of Class.t | Extension of Extension.t | ModuleType of ModuleType.t - | Doc of Comment.docs_or_stop + | Doc of Paths.Identifier.LabelParent.t * Comment.docs_or_stop -(** Bellow are the folding functions. For items that may contain +(** Below are the folding functions. For items that may contain others, such as [signature], it folds recursively on the - sub-items. It does not recurse into internal items. *) + sub-items. It does not recurse into internal items. + + The LabelParent identifier is used to give an id to the doc entries. *) val unit : f:('a -> item -> 'a) -> 'a -> Compilation_unit.t -> 'a val page : f:('a -> item -> 'a) -> 'a -> Page.t -> 'a -val signature : f:('a -> item -> 'a) -> 'a -> Signature.t -> 'a -val signature_item : f:('a -> item -> 'a) -> 'a -> Signature.item -> 'a -val docs : f:('a -> item -> 'a) -> 'a -> Comment.docs_or_stop -> 'a -val include_ : f:('a -> item -> 'a) -> 'a -> Include.t -> 'a +val signature : + f:('a -> item -> 'a) -> + Paths.Identifier.LabelParent.t -> + 'a -> + Signature.t -> + 'a +val signature_item : + f:('a -> item -> 'a) -> + Paths.Identifier.LabelParent.t -> + 'a -> + Signature.item -> + 'a +val docs : + f:('a -> item -> 'a) -> + Paths.Identifier.LabelParent.t -> + 'a -> + Comment.docs_or_stop -> + 'a +val include_ : + f:('a -> item -> 'a) -> + Paths.Identifier.LabelParent.t -> + 'a -> + Include.t -> + 'a val class_type : f:('a -> item -> 'a) -> 'a -> ClassType.t -> 'a -val class_signature : f:('a -> item -> 'a) -> 'a -> ClassSignature.t -> 'a +val class_signature : + f:('a -> item -> 'a) -> + Paths.Identifier.LabelParent.t -> + 'a -> + ClassSignature.t -> + 'a val class_signature_item : - f:('a -> item -> 'a) -> 'a -> ClassSignature.item -> 'a + f:('a -> item -> 'a) -> + Paths.Identifier.LabelParent.t -> + 'a -> + ClassSignature.item -> + 'a val class_ : f:('a -> item -> 'a) -> 'a -> Class.t -> 'a val exception_ : f:('a -> item -> 'a) -> 'a -> Exception.t -> 'a val type_extension : f:('a -> item -> 'a) -> 'a -> Extension.t -> 'a @@ -42,6 +73,15 @@ val module_ : f:('a -> item -> 'a) -> 'a -> Module.t -> 'a val type_decl : f:('a -> item -> 'a) -> 'a -> TypeDecl.t -> 'a val module_type : f:('a -> item -> 'a) -> 'a -> ModuleType.t -> 'a val simple_expansion : - f:('a -> item -> 'a) -> 'a -> ModuleType.simple_expansion -> 'a -val module_type_expr : f:('a -> item -> 'a) -> 'a -> ModuleType.expr -> 'a + f:('a -> item -> 'a) -> + Paths.Identifier.LabelParent.t -> + 'a -> + ModuleType.simple_expansion -> + 'a +val module_type_expr : + f:('a -> item -> 'a) -> + Paths.Identifier.LabelParent.t -> + 'a -> + ModuleType.expr -> + 'a val functor_parameter : f:('a -> item -> 'a) -> 'a -> FunctorParameter.t -> 'a diff --git a/src/search/entry.ml b/src/search/entry.ml index 0fd9e1c8f7..41edb3df43 100644 --- a/src/search/entry.ml +++ b/src/search/entry.ml @@ -146,7 +146,7 @@ and entries_of_doc id d = | `Math_block _ -> [ entry ~id ~doc:[ d ] ~kind:(Doc MathBlock) ] | `Table _ -> [] -let entries_of_item id (x : Odoc_model.Fold.item) = +let entries_of_item (x : Odoc_model.Fold.item) = match x with | CompilationUnit u -> ( match u.content with @@ -219,5 +219,5 @@ let entries_of_item id (x : Odoc_model.Fold.item) = (entry_of_extension_constructor te.type_path te.type_params) te.constructors) | ModuleType mt -> [ entry ~id:mt.id ~doc:mt.doc ~kind:ModuleType ] - | Doc `Stop -> [] - | Doc (`Docs d) -> entries_of_docs id d + | Doc (_, `Stop) -> [] + | Doc (id, `Docs d) -> entries_of_docs id d diff --git a/src/search/entry.mli b/src/search/entry.mli index 52e9f9a470..b44a0b98af 100644 --- a/src/search/entry.mli +++ b/src/search/entry.mli @@ -61,5 +61,4 @@ type t = { kind : kind; } -val entries_of_item : - Odoc_model.Paths.Identifier.Any.t -> Odoc_model.Fold.item -> t list +val entries_of_item : Odoc_model.Fold.item -> t list diff --git a/src/search/json_index/json_search.ml b/src/search/json_index/json_search.ml index 03e770f884..a77952251e 100644 --- a/src/search/json_index/json_search.ml +++ b/src/search/json_index/json_search.ml @@ -193,42 +193,20 @@ let output_json ppf first entries = first entries let unit ppf u = - let f (first, id) i = - let entries = Entry.entries_of_item id i in + let f first i = + let entries = Entry.entries_of_item i in let entries = List.map (fun entry -> (entry, Html.of_entry entry)) entries in - let id = - match i with - | CompilationUnit u -> (u.id :> Odoc_model.Paths.Identifier.t) - | TypeDecl _ -> id - | Module m -> (m.id :> Odoc_model.Paths.Identifier.t) - | Value _ -> id - | Exception _ -> id - | ClassType ct -> (ct.id :> Odoc_model.Paths.Identifier.t) - | Method _ -> id - | Class c -> (c.id :> Odoc_model.Paths.Identifier.t) - | Extension _ -> id - | ModuleType mt -> (mt.id :> Odoc_model.Paths.Identifier.t) - | Doc _ -> id - in let first = output_json ppf first entries in - (first, id) - in - let _first = - Odoc_model.Fold.unit ~f - ( true, - (u.Odoc_model.Lang.Compilation_unit.id :> Odoc_model.Paths.Identifier.t) - ) - u + first in + let _first = Odoc_model.Fold.unit ~f true u in () let page ppf (page : Odoc_model.Lang.Page.t) = let f first i = - let entries = - Entry.entries_of_item (page.name :> Odoc_model.Paths.Identifier.t) i - in + let entries = Entry.entries_of_item i in let entries = List.map (fun entry -> (entry, Html.of_entry entry)) entries in diff --git a/test/search/html_search.t/run.t b/test/search/html_search.t/run.t index 755ec401b3..f41bb156a0 100644 --- a/test/search/html_search.t/run.t +++ b/test/search/html_search.t/run.t @@ -87,23 +87,23 @@ The index file, one entry per line: {"id":[{"kind":"Root","name":"Main"},{"kind":"Type","name":"tdzdz"},{"kind":"Constructor","name":"A"}],"doc":"","kind":{"kind":"Constructor","args":{"kind":"Tuple","vals":["int","int"]},"res":"tdzdz"},"display":{"url":"page/Main/index.html#type-tdzdz.A","html":"consMain.tdzdz.A : int * int -> tdzdz
"}} {"id":[{"kind":"Root","name":"Main"},{"kind":"Type","name":"tdzdz"},{"kind":"Constructor","name":"B"}],"doc":"Bliiiiiiiiiii","kind":{"kind":"Constructor","args":{"kind":"Tuple","vals":["int list","int"]},"res":"tdzdz"},"display":{"url":"page/Main/index.html#type-tdzdz.B","html":"consMain.tdzdz.B : int list * int -> tdzdz

Bliiiiiiiiiii

"}} {"id":[{"kind":"Root","name":"J"}],"doc":"a paragraph two","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/J/index.html","html":"docJ

a paragraph two

"}} + {"id":[{"kind":"Root","name":"Main"}],"doc":"x + 1","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/index.html","html":"docMain

x + 1

"}} + {"id":[{"kind":"Root","name":"Main"}],"doc":"a paragraph two","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/index.html","html":"docMain

a paragraph two

"}} + {"id":[{"kind":"Root","name":"Main"}],"doc":"a paragraph","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/index.html","html":"docMain

a paragraph

"}} + {"id":[{"kind":"Root","name":"Main"}],"doc":"and another","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/index.html","html":"docMain

and another

"}} + {"id":[{"kind":"Root","name":"Main"}],"doc":"and this is a paragraph","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/index.html","html":"docMain

and this is a paragraph

"}} + {"id":[{"kind":"Root","name":"Main"}],"doc":"blibli","kind":{"kind":"Doc","subkind":"CodeBlock"},"display":{"url":"page/Main/index.html","html":"docMain
blibli
"}} + {"id":[{"kind":"Root","name":"Main"}],"doc":"verbatim","kind":{"kind":"Doc","subkind":"Verbatim"},"display":{"url":"page/Main/index.html","html":"docMain
verbatim
"}} {"id":[{"kind":"Page","name":"page"}],"doc":"A paragraph","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/index.html","html":"docpage

A paragraph

"}} {"id":[{"kind":"Page","name":"page"}],"doc":"a list of things","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/index.html","html":"docpage

a list of things

"}} {"id":[{"kind":"Page","name":"page"}],"doc":"bliblib","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/index.html","html":"docpage

bliblib

"}} {"id":[{"kind":"Page","name":"page"}],"doc":"and code","kind":{"kind":"Doc","subkind":"CodeBlock"},"display":{"url":"page/index.html","html":"docpage
and code
"}} {"id":[{"kind":"Page","name":"page"}],"doc":"some verbatim","kind":{"kind":"Doc","subkind":"Verbatim"},"display":{"url":"page/index.html","html":"docpage
some verbatim
"}} {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"I"}],"doc":"x + 1","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/I/index.html","html":"docMain.I

x + 1

"}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"I"}],"doc":"x + 1","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/I/index.html","html":"docMain.I

x + 1

"}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"I"}],"doc":"a paragraph two","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/I/index.html","html":"docMain.I

a paragraph two

"}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"I"}],"doc":"a paragraph","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/I/index.html","html":"docMain.I

a paragraph

"}} {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"I"}],"doc":"a paragraph","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/I/index.html","html":"docMain.I

a paragraph

"}} {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"I"}],"doc":"and another","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/I/index.html","html":"docMain.I

and another

"}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"I"}],"doc":"and another","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/I/index.html","html":"docMain.I

and another

"}} {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"I"}],"doc":"blibli","kind":{"kind":"Doc","subkind":"CodeBlock"},"display":{"url":"page/Main/I/index.html","html":"docMain.I
blibli
"}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"I"}],"doc":"blibli","kind":{"kind":"Doc","subkind":"CodeBlock"},"display":{"url":"page/Main/I/index.html","html":"docMain.I
blibli
"}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"I"}],"doc":"verbatim","kind":{"kind":"Doc","subkind":"Verbatim"},"display":{"url":"page/Main/I/index.html","html":"docMain.I
verbatim
"}} {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"I"}],"doc":"verbatim","kind":{"kind":"Doc","subkind":"Verbatim"},"display":{"url":"page/Main/I/index.html","html":"docMain.I
verbatim
"}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"X"}],"doc":"and this is a paragraph","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/X/index.html","html":"docMain.X

and this is a paragraph

"}} {"id":[{"kind":"Root","name":"Main"},{"kind":"Label","name":"this-is-a-title"}],"doc":"this is a title","kind":{"kind":"Doc","subkind":"Heading"},"display":{"url":"page/Main/index.html#this-is-a-title","html":"docMain.this-is-a-title

this is a title

"}} {"id":[{"kind":"Page","name":"page"},{"kind":"Label","name":"a-title"}],"doc":"A title","kind":{"kind":"Doc","subkind":"Heading"},"display":{"url":"page/index.html#a-title","html":"docpage.a-title

A title

"}} {"id":[{"kind":"Root","name":"J"}],"doc":"a paragraph one","kind":{"kind":"Module"},"display":{"url":"page/J/index.html","html":"modJ

a paragraph one

"}} @@ -179,6 +179,13 @@ themselves). Root-J Root-J.Value-uu Root-Main + Root-Main + Root-Main + Root-Main + Root-Main + Root-Main + Root-Main + Root-Main Root-Main.Label-this-is-a-title Root-Main.Module-I Root-Main.Module-I @@ -186,18 +193,11 @@ themselves). Root-Main.Module-I Root-Main.Module-I Root-Main.Module-I - Root-Main.Module-I - Root-Main.Module-I - Root-Main.Module-I - Root-Main.Module-I - Root-Main.Module-I - Root-Main.Module-I Root-Main.Module-I.Value-x Root-Main.Module-I.Value-y Root-Main.Module-M Root-Main.Module-M.Type-t Root-Main.Module-X - Root-Main.Module-X Root-Main.Module-X.Value-c Root-Main.Type-t Root-Main.Type-tdzdz diff --git a/test/search/id_standalone_comments.t/run.t b/test/search/id_standalone_comments.t/run.t index e11fd67e11..2e16e73254 100644 --- a/test/search/id_standalone_comments.t/run.t +++ b/test/search/id_standalone_comments.t/run.t @@ -14,7 +14,7 @@ Let's have a look at the links generated for standalone comments search entries: $ cat index.json | jq -r '.[] | select(.kind.kind | contains("Doc")) | "\(.doc) -> \(.display.url)"' standalone 1 -> Main/index.html standalone 2 -> Main/X/index.html - standalone 3 -> Main/X/index.html + standalone 3 -> Main/index.html -There is a problem with "standalone 3": it should link to Main/index.html, not Main/X/index.html -This is a bug! +The entries link to the pages that contain the standalone comment (they do not +have an ID, so they cannot be linked directly). From df9f40bc7f9b1a21ee254fe3a25ac750df579f4c Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Fri, 3 May 2024 09:57:21 +0200 Subject: [PATCH 3/4] Do not expose intermediate fold functions Signed-off-by: Paul-Elliot --- src/model/fold.mli | 42 ------------------------------------------ 1 file changed, 42 deletions(-) diff --git a/src/model/fold.mli b/src/model/fold.mli index 39364341dd..1b6bd414b2 100644 --- a/src/model/fold.mli +++ b/src/model/fold.mli @@ -28,43 +28,13 @@ type item = val unit : f:('a -> item -> 'a) -> 'a -> Compilation_unit.t -> 'a val page : f:('a -> item -> 'a) -> 'a -> Page.t -> 'a -val signature : - f:('a -> item -> 'a) -> - Paths.Identifier.LabelParent.t -> - 'a -> - Signature.t -> - 'a -val signature_item : - f:('a -> item -> 'a) -> - Paths.Identifier.LabelParent.t -> - 'a -> - Signature.item -> - 'a val docs : f:('a -> item -> 'a) -> Paths.Identifier.LabelParent.t -> 'a -> Comment.docs_or_stop -> 'a -val include_ : - f:('a -> item -> 'a) -> - Paths.Identifier.LabelParent.t -> - 'a -> - Include.t -> - 'a val class_type : f:('a -> item -> 'a) -> 'a -> ClassType.t -> 'a -val class_signature : - f:('a -> item -> 'a) -> - Paths.Identifier.LabelParent.t -> - 'a -> - ClassSignature.t -> - 'a -val class_signature_item : - f:('a -> item -> 'a) -> - Paths.Identifier.LabelParent.t -> - 'a -> - ClassSignature.item -> - 'a val class_ : f:('a -> item -> 'a) -> 'a -> Class.t -> 'a val exception_ : f:('a -> item -> 'a) -> 'a -> Exception.t -> 'a val type_extension : f:('a -> item -> 'a) -> 'a -> Extension.t -> 'a @@ -72,16 +42,4 @@ val value : f:('a -> item -> 'a) -> 'a -> Value.t -> 'a val module_ : f:('a -> item -> 'a) -> 'a -> Module.t -> 'a val type_decl : f:('a -> item -> 'a) -> 'a -> TypeDecl.t -> 'a val module_type : f:('a -> item -> 'a) -> 'a -> ModuleType.t -> 'a -val simple_expansion : - f:('a -> item -> 'a) -> - Paths.Identifier.LabelParent.t -> - 'a -> - ModuleType.simple_expansion -> - 'a -val module_type_expr : - f:('a -> item -> 'a) -> - Paths.Identifier.LabelParent.t -> - 'a -> - ModuleType.expr -> - 'a val functor_parameter : f:('a -> item -> 'a) -> 'a -> FunctorParameter.t -> 'a From 073ae6033d8a3bff8db71d777790055bd2937fd9 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Fri, 3 May 2024 10:03:54 +0200 Subject: [PATCH 4/4] Add changelog for #1118 Signed-off-by: Paul-Elliot --- CHANGES.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGES.md b/CHANGES.md index a43e884acc..baab008aba 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -38,6 +38,7 @@ - Fixed 404 links from search results (@panglesd, #1108) - Fixed title content not being picked up across pages when rendering references (#1116, @panglesd) +- Fix wrong links to standalone comments in search results (#1118, @panglesd) # 2.4.0