diff --git a/CHANGES.md b/CHANGES.md index 10bf17bdce..13922b0177 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -37,6 +37,8 @@ --open (@jonludlam, #1104} - Fix top comment not being taken from includes often enough (@panglesd, #1117) - Fixed 404 links from search results (@panglesd, #1108) +- Fixed title content not being picked up across pages when rendering references + (#1116, @panglesd) # 2.4.0 diff --git a/src/odoc/url.ml b/src/odoc/url.ml index ee8c52f043..6894ead43f 100644 --- a/src/odoc/url.ml +++ b/src/odoc/url.ml @@ -25,7 +25,7 @@ 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 diff --git a/src/xref2/link.ml b/src/xref2/link.ml index 5370b1d516..e716b10e1a 100644 --- a/src/xref2/link.ml +++ b/src/xref2/link.ml @@ -225,20 +225,16 @@ let rec comment_inline_element : `Styled (s, List.map (with_location (comment_inline_element env)) ls) | `Reference (r, content) as orig -> ( match Ref_tools.resolve_reference env r |> Error.raise_warnings with - | Ok x -> + | Ok (ref_, c) -> let content = (* In case of labels, use the heading text as reference text if it's not specified. *) - match (content, x) with - | [], `Identifier ({ iv = #Id.Label.t_pv; _ } as i) -> ( - match Env.lookup_by_id Env.s_label i env with - | Some (`Label (_, lbl)) -> - Odoc_model.Comment.link_content_of_inline_elements - lbl.Component.Label.text - | None -> []) + match (content, c) with + | [], Some content -> + Comment.link_content_of_inline_elements content | content, _ -> content in - `Reference (`Resolved x, content) + `Reference (`Resolved ref_, content) | Error e -> Errors.report ~what:(`Reference r) ~tools_error:(`Reference e) `Resolve; @@ -309,7 +305,7 @@ and comment_tag env parent ~loc:_ (x : Comment.tag) = `Param (name, comment_nestable_block_element_list env parent content) | `Raise ((`Reference (r, reference_content) as orig), content) -> ( match Ref_tools.resolve_reference env r |> Error.raise_warnings with - | Ok x -> + | Ok (x, _) -> `Raise ( `Reference (`Resolved x, reference_content), comment_nestable_block_element_list env parent content ) diff --git a/src/xref2/ref_tools.ml b/src/xref2/ref_tools.ml index 850f82982f..89b1c2e8eb 100644 --- a/src/xref2/ref_tools.ml +++ b/src/xref2/ref_tools.ml @@ -338,9 +338,9 @@ module L = struct type t = Resolved.Label.t - let in_env env name : t ref_result = - env_lookup_by_name Env.s_label name env >>= fun (`Label (id, _)) -> - Ok (`Identifier id) + let in_env env name : (t * _) ref_result = + env_lookup_by_name Env.s_label name env >>= fun (`Label (id, lbl)) -> + Ok (`Identifier id, lbl.text) let in_page _env (`P (_, p)) name = let rec find = function @@ -350,9 +350,9 @@ module L = struct ( _, ({ Odoc_model.Paths.Identifier.iv = `Label (_, name'); _ } as label), - _ ) + content ) when name = LabelName.to_string name' -> - Ok (`Identifier label) + Ok (`Identifier label, content) | _ -> find tl) | [] -> Error (`Find_by_name (`Page, name)) in @@ -360,16 +360,19 @@ module L = struct let of_component _env ~parent_ref label = Ok - (`Label - ( (parent_ref :> Resolved.LabelParent.t), - Ident.Name.typed_label label.Component.Label.label )) + ( `Label + ( (parent_ref :> Resolved.LabelParent.t), + Ident.Name.typed_label label.Component.Label.label ), + label.text ) let in_label_parent env (parent : label_parent_lookup_result) name = match parent with - | `S (p, _, sg) -> + | `S (p, _, sg) -> ( find_ambiguous ~kind:`Label Find.label_in_sig sg (LabelName.to_string name) - >>= fun _ -> Ok (`Label ((p :> Resolved.LabelParent.t), name)) + >>= function + | `FLabel lbl -> + Ok (`Label ((p :> Resolved.LabelParent.t), name), lbl.text)) | (`T _ | `C _ | `CT _) as r -> wrong_kind_error [ `S; `Page ] r | `P _ as page -> in_page env page (LabelName.to_string name) end @@ -742,7 +745,9 @@ let resolve_class_signature_reference env (r : ClassSignature.t) = (***) -let resolved1 r = Ok (r :> Resolved.t) +let resolved1 r = Ok ((r :> Resolved.t), None) + +let resolved_with_text (r, txt) = Ok ((r :> Reference.Resolved.t), Some txt) let resolved3 (r, _, _) = resolved1 r @@ -772,7 +777,7 @@ let resolve_reference_dot_sg env ~parent_path ~parent_ref ~parent_sg name = | `FClassType (name, ct) -> CT.of_component env ct ~parent_ref name >>= resolved2 | `FValue (name, _) -> V.of_component env ~parent_ref name >>= resolved1 - | `FLabel label -> L.of_component env ~parent_ref label >>= resolved1 + | `FLabel label -> L.of_component env ~parent_ref label >>= resolved_with_text | `FExn (name, _) -> EX.of_component env ~parent_ref name >>= resolved1 | `FExt _ -> EC.of_component env ~parent_ref name >>= resolved1 | `In_type (typ_name, _, r) -> ( @@ -784,7 +789,7 @@ let resolve_reference_dot_sg env ~parent_path ~parent_ref ~parent_sg name = Error (`Find_by_name (`Any, name)) let resolve_reference_dot_page env page name = - L.in_page env page name >>= resolved1 + L.in_page env page name >>= resolved_with_text let resolve_reference_dot_type env ~parent_ref t name = find Find.any_in_type t name >>= function @@ -812,13 +817,19 @@ let resolve_reference = fun env r -> match r with | `Root (name, `TUnknown) -> ( - let identifier id = Ok (`Identifier (id :> Identifier.t)) in + let identifier ?text id = Ok (`Identifier (id :> Identifier.t), text) in env_lookup_by_name Env.s_any name env >>= function | `Module (_, _) as e -> resolved (M.of_element env e) | `ModuleType (_, _) as e -> resolved (MT.of_element env e) | `Value (id, _) -> identifier id | `Type (id, _) -> identifier id - | `Label (id, _) -> identifier id + | `Label (id, _) -> + let text = + match Env.lookup_by_id Env.s_label id env with + | Some (`Label (_, lbl)) -> Some lbl.Component.Label.text + | None -> None + in + identifier ?text id | `Class (id, _) -> identifier id | `ClassType (id, _) -> identifier id | `Constructor (id, _) -> identifier id @@ -827,7 +838,7 @@ let resolve_reference = | `ExtensionDecl (id, _) -> identifier id | `Field (id, _) -> identifier id | `Page (id, _) -> identifier id) - | `Resolved r -> Ok r + | `Resolved r -> Ok (r, None) | `Root (name, (`TModule | `TChildModule)) -> M.in_env env name >>= resolved | `Module (parent, name) -> resolve_signature_reference env parent >>= fun p -> @@ -854,10 +865,10 @@ let resolve_reference = | `Value (parent, name) -> resolve_signature_reference env parent >>= fun p -> V.in_signature env p name >>= resolved1 - | `Root (name, `TLabel) -> L.in_env env name >>= resolved1 + | `Root (name, `TLabel) -> L.in_env env name >>= resolved_with_text | `Label (parent, name) -> resolve_label_parent_reference env parent >>= fun p -> - L.in_label_parent env p name >>= resolved1 + L.in_label_parent env p name >>= resolved_with_text | `Root (name, (`TPage | `TChildPage)) -> Page.in_env env name >>= resolved2 | `Dot (parent, name) -> resolve_reference_dot env parent name | `Root (name, `TConstructor) -> CS.in_env env name >>= resolved1 diff --git a/src/xref2/ref_tools.mli b/src/xref2/ref_tools.mli index c6608379e1..dd9b15b9fe 100644 --- a/src/xref2/ref_tools.mli +++ b/src/xref2/ref_tools.mli @@ -12,4 +12,7 @@ val resolve_module_reference : module_lookup_result ref_result Odoc_model.Error.with_warnings val resolve_reference : - Env.t -> t -> Resolved.t ref_result Odoc_model.Error.with_warnings + Env.t -> + t -> + (Resolved.t * Odoc_model.Comment.paragraph option) ref_result + Odoc_model.Error.with_warnings diff --git a/test/generators/html/Ocamlary.html b/test/generators/html/Ocamlary.html index 149a8044bc..7cd023c1bc 100644 --- a/test/generators/html/Ocamlary.html +++ b/test/generators/html/Ocamlary.html @@ -259,11 +259,11 @@

EmptySig

For a good time, see - - subSig + A Labeled Section Header Inside of a Signature or - - subSig + Another Labeled Section Header Inside of a Signature or SuperSig.EmptySig @@ -2796,12 +2796,12 @@

But also to things in submodules:

And just to make sure we do not mess up: