diff --git a/src/document/comment.ml b/src/document/comment.ml index be0ff78d28..f8c42f82dc 100644 --- a/src/document/comment.ml +++ b/src/document/comment.ml @@ -234,16 +234,19 @@ let module_references ms = let rec nestable_block_element : Comment.nestable_block_element -> Block.one = fun content -> + let label { Odoc_model.Paths.Identifier.iv = `Label (_, label); _ } = + Odoc_model.Names.LabelName.to_string label + in match content with - | `Paragraph p -> paragraph p - | `Code_block (lang_tag, code) -> + | `Paragraph (lbl, p) -> paragraph ~label:(label lbl) p + | `Code_block (lbl, lang_tag, code) -> let lang_tag = match lang_tag with None -> default_lang_tag | Some t -> t in - block + block ~label:(label lbl) @@ Source (lang_tag, source_of_code (Odoc_model.Location_.value code)) - | `Math_block s -> block @@ Math s - | `Verbatim s -> block @@ Verbatim s + | `Math_block (lbl, s) -> block ~label:(label lbl) @@ Math s + | `Verbatim (lbl, s) -> block ~label:(label lbl) @@ Verbatim s | `Modules ms -> module_references ms | `List (kind, items) -> let kind = @@ -252,17 +255,20 @@ let rec nestable_block_element : Comment.nestable_block_element -> Block.one = | `Ordered -> Block.Ordered in let f = function - | [ { Odoc_model.Location_.value = `Paragraph content; _ } ] -> - [ block @@ Block.Inline (inline_element_list content) ] + | [ { Odoc_model.Location_.value = `Paragraph (lbl, content); _ } ] -> + [ + block ~label:(label lbl) + @@ Block.Inline (inline_element_list content); + ] | item -> nestable_block_element_list item in let items = List.map f items in block @@ Block.List (kind, items) -and paragraph : Comment.paragraph -> Block.one = function +and paragraph ?label : Comment.paragraph -> Block.one = function | [ { value = `Raw_markup (target, s); _ } ] -> - block @@ Block.Raw_markup (target, s) - | p -> block @@ Block.Paragraph (inline_element_list p) + block ?label @@ Block.Raw_markup (target, s) + | p -> block ?label @@ Block.Paragraph (inline_element_list p) and nestable_block_element_list elements = elements diff --git a/src/document/generator.ml b/src/document/generator.ml index 21a29a964d..eff7742b20 100644 --- a/src/document/generator.ml +++ b/src/document/generator.ml @@ -1805,7 +1805,7 @@ module Make (Syntax : SYNTAX) = struct in let page_of_dir (dir : SourceDir.t) (dir_children, file_children) = let url = Url.Path.source_dir_from_identifier dir in - let block ?(attr = []) desc = Block.{ attr; desc } in + let block ?(attr = []) desc = Block.{ attr; desc; label = None } in let inline ?(attr = []) desc = Inline.[ { attr; desc } ] in let header = let title = inline (Text (SourceDir.name dir)) in @@ -1837,7 +1837,9 @@ module Make (Syntax : SYNTAX) = struct (name, url) in let items = - let text ?(attr = []) desc = Item.Text [ { attr; desc } ] in + let text ?(attr = []) desc = + Item.Text [ { attr; desc; label = None } ] + in let list l = Block.List (Block.Unordered, l) in let list_of_children = let dir_list = diff --git a/src/document/types.ml b/src/document/types.ml index 0ae2588098..ce5615cfe4 100644 --- a/src/document/types.ml +++ b/src/document/types.ml @@ -78,7 +78,7 @@ and Block : sig type t = one list - and one = { attr : Class.t; desc : desc } + and one = { attr : Class.t; desc : desc; label : string option } and desc = | Inline of Inline.t @@ -187,4 +187,4 @@ end let inline ?(attr = []) desc = Inline.{ attr; desc } -let block ?(attr = []) desc = Block.{ attr; desc } +let block ?(attr = []) ?label desc = Block.{ attr; desc; label } diff --git a/src/html/generator.ml b/src/html/generator.ml index 9e89a071c4..8c02d27597 100644 --- a/src/html/generator.ml +++ b/src/html/generator.ml @@ -181,7 +181,10 @@ let rec block ~config ~resolve (l : Block.t) : flow Html.elt list = let as_flow x = (x : phrasing Html.elt list :> flow Html.elt list) in let one (t : Block.one) = let mk_block ?(extra_class = []) mk content = - let a = Some (class_ (extra_class @ t.attr)) in + let id = + match t.label with None -> [] | Some label -> [ Html.a_id label ] + in + let a = Some (id @ class_ (extra_class @ t.attr)) in [ mk ?a content ] in match t.desc with diff --git a/src/model/comment.ml b/src/model/comment.ml index a95eff2123..595a8a7bdf 100644 --- a/src/model/comment.ml +++ b/src/model/comment.ml @@ -42,10 +42,10 @@ type module_reference = { resolved during linking. *) type nestable_block_element = - [ `Paragraph of paragraph - | `Code_block of string option * string with_location - | `Math_block of string - | `Verbatim of string + [ `Paragraph of Identifier.Label.t * paragraph + | `Code_block of Identifier.Label.t * string option * string with_location + | `Math_block of Identifier.Label.t * string + | `Verbatim of Identifier.Label.t * string | `Modules of module_reference list | `List of [ `Unordered | `Ordered ] * nestable_block_element with_location list list @@ -86,8 +86,7 @@ type heading_attrs = { type block_element = [ nestable_block_element - | `Heading of - heading_attrs * Identifier.Label.t * inline_element with_location list + | `Heading of heading_attrs * Identifier.Label.t * paragraph | `Tag of tag ] type docs = block_element with_location list @@ -97,7 +96,7 @@ type docs_or_stop = [ `Docs of docs | `Stop ] (** The synopsis is the first element of a comment if it is a paragraph. Otherwise, there is no synopsis. *) let synopsis = function - | { Location_.value = `Paragraph p; _ } :: _ -> Some p + | { Location_.value = `Paragraph (_, p); _ } :: _ -> Some p | _ -> None let rec link_content_of_inline_element : diff --git a/src/model/predefined.ml b/src/model/predefined.ml index 7ab6a54c70..18bb1958ef 100644 --- a/src/model/predefined.ml +++ b/src/model/predefined.ml @@ -270,20 +270,27 @@ let floatarray_decl = |> List.rev_map (fun s -> [ `Space; `Word s ]) |> List.flatten |> List.tl |> List.rev in + let label = + Paths.Identifier.Mk.label + ( Paths.Identifier.Mk.root (None, ModuleName.make_std "Array"), + LabelName.make_std "1" ) + in let doc = [ `Paragraph - (words [ "This"; "type"; "is"; "used"; "to"; "implement"; "the" ] - @ [ - `Space; - `Reference - ( `Module - (`Root ("Array", `TModule), ModuleName.make_std "Floatarray"), - [] ); - `Space; - ] - @ words [ "module."; "It"; "should"; "not"; "be"; "used"; "directly." ] - |> List.map (Location_.at predefined_location)); + ( label, + words [ "This"; "type"; "is"; "used"; "to"; "implement"; "the" ] + @ [ + `Space; + `Reference + ( `Module + (`Root ("Array", `TModule), ModuleName.make_std "Floatarray"), + [] ); + `Space; + ] + @ words + [ "module."; "It"; "should"; "not"; "be"; "used"; "directly." ] + |> List.map (Location_.at predefined_location) ); ] |> List.map (Location_.at predefined_location) in diff --git a/src/model/semantics.ml b/src/model/semantics.ml index 9770fed63a..d10c9ddd53 100644 --- a/src/model/semantics.ml +++ b/src/model/semantics.ml @@ -216,6 +216,21 @@ let rec inline_element : and inline_elements status elements = List.map (inline_element status) elements +let generate_label = + let current_label = ref 0 in + fun kind status -> + let lbl = + match kind with + | `Paragraph -> "p" + | `Code_block -> "code" + | `Verbatim -> "v" + | `Math_block -> "math" + in + let name = Format.sprintf "%s%d" lbl !current_label in + incr current_label; + Paths.Identifier.Mk.label + (status.parent_of_sections, Names.LabelName.make_std name) + let rec nestable_block_element : status -> Odoc_parser.Ast.nestable_block_element with_location -> @@ -223,16 +238,23 @@ let rec nestable_block_element : fun status element -> match element with | { value = `Paragraph content; location } -> - Location.at location (`Paragraph (inline_elements status content)) + let content = inline_elements status content in + let label = generate_label `Paragraph status in + Location.at location (`Paragraph (label, content)) | { value = `Code_block (metadata, code); location } -> let lang_tag = match metadata with | Some ({ Location.value; _ }, _) -> Some value | None -> None in - Location.at location (`Code_block (lang_tag, code)) - | { value = `Math_block s; location } -> Location.at location (`Math_block s) - | { value = `Verbatim _; _ } as element -> element + let label = generate_label `Code_block status in + Location.at location (`Code_block (label, lang_tag, code)) + | { value = `Math_block s; location } -> + let label = generate_label `Verbatim status in + Location.at location (`Math_block (label, s)) + | { value = `Verbatim v; location } -> + let label = generate_label `Math_block status in + Location.at location (`Verbatim (label, v)) | { value = `Modules modules; location } -> let modules = List.fold_left @@ -381,9 +403,10 @@ let section_heading : | `None, _any_level -> Error.raise_warning (headings_not_allowed location); let text = (text :> Comment.inline_element with_location list) in + let label = generate_label `Paragraph status in let element = Location.at location - (`Paragraph [ Location.at location (`Styled (`Bold, text)) ]) + (`Paragraph (label, [ Location.at location (`Styled (`Bold, text)) ])) in (top_heading_level, element) | `No_titles, 0 -> diff --git a/src/model_desc/comment_desc.ml b/src/model_desc/comment_desc.ml index 28ee873228..17cf7f53c2 100644 --- a/src/model_desc/comment_desc.ml +++ b/src/model_desc/comment_desc.ml @@ -18,10 +18,10 @@ type general_inline_element = and general_link_content = general_inline_element with_location list type general_block_element = - [ `Paragraph of general_link_content - | `Code_block of string option * string with_location - | `Math_block of string - | `Verbatim of string + [ `Paragraph of Identifier.Label.t * general_link_content + | `Code_block of Identifier.Label.t * string option * string with_location + | `Math_block of Identifier.Label.t * string + | `Verbatim of Identifier.Label.t * string | `Modules of Comment.module_reference list | `List of [ `Unordered | `Ordered ] * general_block_element with_location list list @@ -105,11 +105,11 @@ let rec block_element : general_block_element t = in Variant (function - | `Paragraph x -> C ("`Paragraph", x, link_content) - | `Code_block (x1, x2) -> + | `Paragraph (_, x) -> C ("`Paragraph", x, link_content) + | `Code_block (_, x1, x2) -> C ("`Code_block", (x1, ignore_loc x2), Pair (Option string, string)) - | `Math_block x -> C ("`Math_block", x, string) - | `Verbatim x -> C ("`Verbatim", x, string) + | `Math_block (_, x) -> C ("`Math_block", x, string) + | `Verbatim (_, x) -> C ("`Verbatim", x, string) | `Modules x -> C ("`Modules", x, List module_reference) | `List (x1, x2) -> C ("`List", (x1, (x2 :> general_docs list)), Pair (list_kind, List docs)) diff --git a/src/xref2/component.ml b/src/xref2/component.ml index bca7b69a26..c2af08507a 100644 --- a/src/xref2/component.ml +++ b/src/xref2/component.ml @@ -462,9 +462,21 @@ end = Substitution and CComment : sig + type nestable_block_element = + [ `Paragraph of Label.t * Odoc_model.Comment.paragraph + | `Code_block of + Label.t * string option * string Odoc_model.Comment.with_location + | `Math_block of Label.t * string + | `Verbatim of Label.t * string + | `Modules of Odoc_model.Comment.module_reference list + | `List of + [ `Unordered | `Ordered ] + * nestable_block_element Odoc_model.Comment.with_location list list ] + type block_element = - [ Odoc_model.Comment.nestable_block_element - | `Heading of Label.t + [ nestable_block_element + | `Heading of + Odoc_model.Comment.heading_attrs * Label.t * Odoc_model.Comment.paragraph | `Tag of Odoc_model.Comment.tag ] type docs = block_element Odoc_model.Comment.with_location list @@ -474,11 +486,14 @@ end = CComment and Label : sig + (** In order to generate content for links without content *) + type content = Heading of Odoc_model.Comment.paragraph | NestableBlock + type t = { - attrs : Odoc_model.Comment.heading_attrs; label : Ident.label; - text : Odoc_model.Comment.paragraph; + content : content; location : Odoc_model.Location_.span; + (** In order to check for ambiguous labels *) } end = Label @@ -2412,16 +2427,51 @@ module Of_Lang = struct in { items; removed = []; compiled = sg.compiled; doc = docs ident_map sg.doc } - and block_element _ b : + and nestable_block_element map + (b : Odoc_model.Comment.nestable_block_element Comment.with_location) = + let mk_label label location = + { + Label.label = Ident.Of_Identifier.label label; + location; + content = NestableBlock; + } + in + match b with + | { Odoc_model.Location_.value = `Paragraph (label, text); location } -> + let label = mk_label label location in + let para = `Paragraph (label, text) in + Odoc_model.Location_.same b para + | { value = `Code_block (label, l, s); location } -> + let label = mk_label label location in + let cb = `Code_block (label, l, s) in + Odoc_model.Location_.same b cb + | { value = `Math_block (label, s); location } -> + let label = mk_label label location in + let mb = `Math_block (label, s) in + Odoc_model.Location_.same b mb + | { value = `Verbatim (label, s); location } -> + let label = mk_label label location in + let v = `Verbatim (label, s) in + Odoc_model.Location_.same b v + | { value = `List (ord, items); _ } -> + let items = List.map (List.map (nestable_block_element map)) items in + let l = `List (ord, items) in + Odoc_model.Location_.same b l + | { value = `Modules _; _ } as n -> n + + and block_element map b : CComment.block_element Odoc_model.Comment.with_location = match b with | { Odoc_model.Location_.value = `Heading (attrs, label, text); location } -> let label = Ident.Of_Identifier.label label in Odoc_model.Location_.same b - (`Heading { Label.attrs; label; text; location }) + (`Heading + (attrs, { Label.label; content = Heading text; location }, text)) | { value = `Tag _; _ } as t -> t - | { value = #Odoc_model.Comment.nestable_block_element; _ } as n -> n + | { value = #Odoc_model.Comment.nestable_block_element; _ } as n -> + (nestable_block_element map n + :> CComment.block_element Odoc_model.Comment.with_location) and docs ident_map d = List.map (block_element ident_map) d diff --git a/src/xref2/component.mli b/src/xref2/component.mli index 483cb0c676..bdad6fd2d1 100644 --- a/src/xref2/component.mli +++ b/src/xref2/component.mli @@ -432,9 +432,21 @@ and Substitution : sig end and CComment : sig + type nestable_block_element = + [ `Paragraph of Label.t * Odoc_model.Comment.paragraph + | `Code_block of + Label.t * string option * string Odoc_model.Comment.with_location + | `Math_block of Label.t * string + | `Verbatim of Label.t * string + | `Modules of Odoc_model.Comment.module_reference list + | `List of + [ `Unordered | `Ordered ] + * nestable_block_element Odoc_model.Comment.with_location list list ] + type block_element = - [ Odoc_model.Comment.nestable_block_element - | `Heading of Label.t + [ nestable_block_element + | `Heading of + Odoc_model.Comment.heading_attrs * Label.t * Odoc_model.Comment.paragraph | `Tag of Odoc_model.Comment.tag ] type docs = block_element Odoc_model.Comment.with_location list @@ -443,11 +455,14 @@ and CComment : sig end and Label : sig + (** In order to generate content for links without content *) + type content = Heading of Odoc_model.Comment.paragraph | NestableBlock + type t = { - attrs : Odoc_model.Comment.heading_attrs; label : Ident.label; - text : Odoc_model.Comment.paragraph; + content : content; location : Odoc_model.Location_.span; + (** In order to check for ambiguous labels *) } end diff --git a/src/xref2/env.ml b/src/xref2/env.ml index 6a277a36ae..e5fbb7698a 100644 --- a/src/xref2/env.ml +++ b/src/xref2/env.ml @@ -228,7 +228,7 @@ let add_to_elts kind identifier component env = ids = ElementsById.add identifier component env.ids; } -let add_label identifier heading env = +let add_label identifier (heading : Component.Label.t) env = assert env.linking; let comp = `Label (identifier, heading) in let name = Identifier.name identifier in @@ -259,13 +259,31 @@ let add_label identifier heading env = ids = ElementsById.add identifier comp env.ids; } -let add_docs (docs : Comment.docs) env = +let rec add_docs (docs : Comment.docs) env = assert env.linking; List.fold_left (fun env -> function - | { Location_.value = `Heading (attrs, id, text); location } -> + | { Location_.value = `Heading (_attrs, id, text); location } -> let label = Ident.Of_Identifier.label id in - add_label id { Component.Label.attrs; label; text; location } env + add_label id + { Component.Label.label; content = Heading text; location } + env + | { + Location_.value = + ( `Paragraph (id, _) + | `Code_block (id, _, _) + | `Math_block (id, _) + | `Verbatim (id, _) ); + location; + } -> + let label = Ident.Of_Identifier.label id in + add_label id + { Component.Label.label; content = NestableBlock; location } + env + | { Location_.value = `List (_, l); location = _ } -> + List.fold_left + (fun env docs -> add_docs (docs :> Comment.docs) env) + env l | _ -> env) env docs @@ -276,7 +294,7 @@ let add_cdocs p (docs : Component.CComment.docs) env = List.fold_left (fun env element -> match element.Location_.value with - | `Heading h -> + | `Heading (_attrs, h, _text) -> let (`LLabel (name, _)) = h.Component.Label.label in let label = Paths.Identifier.Mk.label (Paths.Identifier.label_parent p, name) diff --git a/src/xref2/find.ml b/src/xref2/find.ml index 354a022bdc..0e3a97177f 100644 --- a/src/xref2/find.ml +++ b/src/xref2/find.ml @@ -211,7 +211,8 @@ let any_in_comment d name = match xs with | elt :: rest -> ( match elt.Odoc_model.Location_.value with - | `Heading lbl when Ident.Name.label lbl.Label.label = name -> + | `Heading (_attrs, lbl, _text) + when Ident.Name.label lbl.Label.label = name -> Some (`FLabel lbl) | _ -> inner rest) | [] -> None diff --git a/src/xref2/lang_of.ml b/src/xref2/lang_of.ml index 4d838d4404..af80fb2d3f 100644 --- a/src/xref2/lang_of.ml +++ b/src/xref2/lang_of.ml @@ -1039,26 +1039,66 @@ and exception_ map parent id (e : Component.Exception.t) : res = Opt.map (type_expr map (parent :> Identifier.Parent.t)) e.res; } -and block_element parent - (d : Component.CComment.block_element Odoc_model.Location_.with_location) : - Odoc_model.Comment.block_element Odoc_model.Location_.with_location = +and nestable_block_element parent + (d : + Component.CComment.nestable_block_element + Odoc_model.Location_.with_location) : + Odoc_model.Comment.nestable_block_element Odoc_model.Location_.with_location + = + let mk_label h = + let { Component.Label.label; content = _; location = _ } = h in + try Identifier.Mk.label (parent, Ident.Name.typed_label label) + with Not_found -> + Format.fprintf Format.err_formatter "Failed to find id: %a\n" Ident.fmt + label; + raise Not_found + in let value = match d.Odoc_model.Location_.value with - | `Heading h -> - let { Component.Label.attrs; label; text; location = _ } = h in - let label = - try Identifier.Mk.label (parent, Ident.Name.typed_label label) - with Not_found -> - Format.fprintf Format.err_formatter "Failed to find id: %a\n" - Ident.fmt label; - raise Not_found + | `Paragraph (h, text) -> + let label = mk_label h in + `Paragraph (label, text) + | `Code_block (h, l, s) -> + let label = mk_label h in + `Code_block (label, l, s) + | `Math_block (h, s) -> + let label = mk_label h in + `Math_block (label, s) + | `Verbatim (h, s) -> + let label = mk_label h in + `Verbatim (label, s) + | `List (ord, li) -> + let li = + List.map (List.map (fun x -> nestable_block_element parent x)) li in - `Heading (attrs, label, text) - | `Tag t -> `Tag t - | #Odoc_model.Comment.nestable_block_element as n -> n + `List (ord, li) + | `Modules _ as n -> n in { d with Odoc_model.Location_.value } +and block_element parent + (d : Component.CComment.block_element Odoc_model.Location_.with_location) : + Odoc_model.Comment.block_element Odoc_model.Location_.with_location = + match d.Odoc_model.Location_.value with + | `Heading (attrs, h, text) -> + let { Component.Label.label; content = _; location = _ } = h in + let label = + try Identifier.Mk.label (parent, Ident.Name.typed_label label) + with Not_found -> + Format.fprintf Format.err_formatter "Failed to find id: %a\n" + Ident.fmt label; + raise Not_found + in + let value = `Heading (attrs, label, text) in + { d with Odoc_model.Location_.value } + | `Tag t -> + let value = `Tag t in + { d with Odoc_model.Location_.value } + | #Component.CComment.nestable_block_element as value -> + let e = { d with Odoc_model.Location_.value } in + (nestable_block_element parent e + :> Odoc_model.Comment.block_element Odoc_model.Location_.with_location) + and docs : Identifier.LabelParent.t -> Component.CComment.docs -> diff --git a/src/xref2/link.ml b/src/xref2/link.ml index 5f896fc17a..5d21b98e6d 100644 --- a/src/xref2/link.ml +++ b/src/xref2/link.ml @@ -13,9 +13,7 @@ let locations env id locs = (** Equivalent to {!Comment.synopsis}. *) let synopsis_from_comment (docs : Component.CComment.docs) = match docs with - | ({ value = #Comment.nestable_block_element; _ } as e) :: _ -> - (* Only the first element is considered. *) - Comment.synopsis [ e ] + | { value = `Paragraph (_, text); _ } :: _ -> Some text | _ -> None let synopsis_of_module env (m : Component.Module.t) = @@ -45,10 +43,23 @@ let ambiguous_label_warning label_name labels = Location_.pp_span_start fmt x.Component.Label.location in Lookup_failures.report_warning - "@[<2>Label '%s' is ambiguous. The other occurences are:@ %a@]" label_name + "@[<2>Label '%s' is ambiguous. The other occurrences are:@ %a@]" label_name (Format.pp_print_list ~pp_sep:Format.pp_force_newline pp_label_loc) labels +let ambiguous_labels ~loc env + ({ Odoc_model.Paths.Identifier.iv = `Label (_, label_name); _ } as id) = + (* Looking for an identical identifier but a different location. *) + let conflicting (`Label (id', comp)) = + Id.equal id id' + && not (Location_.span_equal comp.Component.Label.location loc) + in + let label_name = Names.LabelName.to_string label_name in + match Env.lookup_by_name Env.s_label label_name env with + | Ok lbl when conflicting lbl -> [ lbl ] + | Error (`Ambiguous (hd, tl)) -> List.filter conflicting (hd :: tl) + | Ok _ | Error `Not_found -> [] + (** Raise a warning when a label explicitly set by the user collides. This warning triggers even if one of the colliding labels have been automatically generated. *) @@ -57,19 +68,24 @@ let check_ambiguous_label ~loc env ({ Odoc_model.Paths.Identifier.iv = `Label (_, label_name); _ } as id), _ ) = if attrs.Comment.heading_label_explicit then - (* Looking for an identical identifier but a different location. *) - let conflicting (`Label (id', comp)) = - Id.equal id id' - && not (Location_.span_equal comp.Component.Label.location loc) - in let label_name = Names.LabelName.to_string label_name in - match Env.lookup_by_name Env.s_label label_name env with - | Ok lbl when conflicting lbl -> ambiguous_label_warning label_name [ lbl ] - | Error (`Ambiguous (hd, tl)) -> ( - match List.filter conflicting (hd :: tl) with - | [] -> () - | xs -> ambiguous_label_warning label_name xs) - | Ok _ | Error `Not_found -> () + match ambiguous_labels ~loc env id with + | [] -> () + | lbls -> ambiguous_label_warning label_name lbls + +let disambiguate_label ~loc env + ({ Odoc_model.Paths.Identifier.iv = `Label (lbl_parent, label_name); _ } as + id) = + let label_name = Names.LabelName.to_string label_name in + let need_new_label label = ambiguous_labels ~loc env label != [] in + let rec give_new_label n = + let new_label = + Paths.Identifier.Mk.label + (lbl_parent, Names.LabelName.make_std (label_name ^ string_of_int n)) + in + if need_new_label new_label then give_new_label (n + 1) else new_label + in + if need_new_label id then give_new_label 0 else id let expansion_needed self target = let self = (self :> Paths.Path.Resolved.t) in @@ -212,9 +228,11 @@ let rec comment_inline_element : 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 + | Some (`Label (_, lbl)) -> ( + match lbl.content with + | Heading text -> + Odoc_model.Comment.link_content_of_inline_elements text + | NestableBlock -> []) | None -> []) | content, _ -> content in @@ -232,11 +250,21 @@ and resolve_external_synopsis env synopsis = let env = Env.inherit_resolver env in paragraph env synopsis -and comment_nestable_block_element env parent ~loc:_ +and comment_nestable_block_element env parent ~loc (x : Comment.nestable_block_element) = match x with - | `Paragraph elts -> `Paragraph (paragraph env elts) - | (`Code_block _ | `Math_block _ | `Verbatim _) as x -> x + | `Paragraph (lbl, elts) -> + let lbl = disambiguate_label ~loc env lbl in + `Paragraph (lbl, paragraph env elts) + | `Code_block (lbl, l, s) -> + let lbl = disambiguate_label ~loc env lbl in + `Code_block (lbl, l, s) + | `Math_block (lbl, s) -> + let lbl = disambiguate_label ~loc env lbl in + `Math_block (lbl, s) + | `Verbatim (lbl, s) -> + let lbl = disambiguate_label ~loc env lbl in + `Verbatim (lbl, s) | `List (x, ys) -> `List ( x, diff --git a/src/xref2/ref_tools.ml b/src/xref2/ref_tools.ml index 6143fb41f1..15fa3562a1 100644 --- a/src/xref2/ref_tools.ml +++ b/src/xref2/ref_tools.ml @@ -113,8 +113,16 @@ let ambiguous_label_warning name (labels : Component.Element.any list) = let ambiguous_warning name (results : [< Component.Element.any ] list) = let results = (results :> Component.Element.any list) in - if List.for_all (function `Label _ -> true | _ -> false) results then - ambiguous_label_warning name results + if + List.for_all + (function + | `Label + (_, { Component.Label.label = _; content = Heading _; location = _ }) + -> + true + | _ -> false) + results + then ambiguous_label_warning name results else ambiguous_generic_ref_warning name (List.map ref_kind_of_element results) let env_lookup_by_name ?(kind = `Any) scope name env = diff --git a/test/generators/html/Alerts-Top1.html b/test/generators/html/Alerts-Top1.html index a917f9c94e..6b5183f84b 100644 --- a/test/generators/html/Alerts-Top1.html +++ b/test/generators/html/Alerts-Top1.html @@ -12,7 +12,8 @@ Alerts » Top1
-

Module Alerts.Top1

Top-comment.

+

Module Alerts.Top1

+

Top-comment.

diff --git a/test/generators/html/Alerts-Top2.html b/test/generators/html/Alerts-Top2.html index d7b6f91821..f384b055c6 100644 --- a/test/generators/html/Alerts-Top2.html +++ b/test/generators/html/Alerts-Top2.html @@ -12,7 +12,8 @@ Alerts » Top2
-

Module Alerts.Top2

Top-comment.

+

Module Alerts.Top2

+

Top-comment.

diff --git a/test/generators/html/Alerts.html b/test/generators/html/Alerts.html index e26cb370a4..2de5f2b947 100644 --- a/test/generators/html/Alerts.html +++ b/test/generators/html/Alerts.html @@ -29,7 +29,8 @@

Module Alerts

    -
  • deprecated

    b.

    +
  • deprecated +

    b.

diff --git a/test/generators/html/Alias-X.html b/test/generators/html/Alias-X.html index 465fe6eb1f..40ca313753 100644 --- a/test/generators/html/Alias-X.html +++ b/test/generators/html/Alias-X.html @@ -22,8 +22,8 @@

Module Alias.X

-

Module Foo__X documentation. This should appear in the documentation - for the alias to this module 'X' +

Module Foo__X documentation. This should appear in the + documentation for the alias to this module 'X'

diff --git a/test/generators/html/Bugs.html b/test/generators/html/Bugs.html index 735988e182..a10102b163 100644 --- a/test/generators/html/Bugs.html +++ b/test/generators/html/Bugs.html @@ -32,7 +32,7 @@

Module Bugs

-

Triggers an assertion failure when +

Triggers an assertion failure when https://github.com/ocaml/odoc/issues/101 is not fixed. diff --git a/test/generators/html/Bugs_post_406.html b/test/generators/html/Bugs_post_406.html index 836c834bd4..18beab0b00 100644 --- a/test/generators/html/Bugs_post_406.html +++ b/test/generators/html/Bugs_post_406.html @@ -10,8 +10,9 @@

Module Bugs_post_406

-

Let-open in class types, https://github.com/ocaml/odoc/issues/543 - This was added to the language in 4.06 +

Let-open in class types, + https://github.com/ocaml/odoc/issues/543 This was added to the language + in 4.06

diff --git a/test/generators/html/Class_comments-class-c.html b/test/generators/html/Class_comments-class-c.html index fe6e33762a..f1e6a14272 100644 --- a/test/generators/html/Class_comments-class-c.html +++ b/test/generators/html/Class_comments-class-c.html @@ -22,7 +22,7 @@

Class Class_comments.c

x -

Inherit.

+

Inherit.

@@ -31,8 +31,8 @@

Class Class_comments.c

'a = int -

Constraint.

-

Floating comment.

+

Constraint.

+

Floating comment.

diff --git a/test/generators/html/External.html b/test/generators/html/External.html index a2806fc060..2f70317fe7 100644 --- a/test/generators/html/External.html +++ b/test/generators/html/External.html @@ -20,7 +20,7 @@

Module External

unit -> unit -

Foo bar.

+

Foo bar.

diff --git a/test/generators/html/Include2-X.html b/test/generators/html/Include2-X.html index 5e147f4b74..aadb22b85f 100644 --- a/test/generators/html/Include2-X.html +++ b/test/generators/html/Include2-X.html @@ -12,7 +12,8 @@

Module Include2.X

-

Comment about X that should not appear when including X below.

+

Comment about X that should not appear when including X below. +

diff --git a/test/generators/html/Include2-Y.html b/test/generators/html/Include2-Y.html index 6ddb4bf0e4..e67176e75c 100644 --- a/test/generators/html/Include2-Y.html +++ b/test/generators/html/Include2-Y.html @@ -12,7 +12,7 @@

Module Include2.Y

-

Top-comment of Y.

+

Top-comment of Y.

diff --git a/test/generators/html/Include2-Y_include_doc.html b/test/generators/html/Include2-Y_include_doc.html index 4b65326afc..0e75b88494 100644 --- a/test/generators/html/Include2-Y_include_doc.html +++ b/test/generators/html/Include2-Y_include_doc.html @@ -17,8 +17,8 @@

Module Include2.Y_include_doc

-

Doc attached to include Y. Y's top-comment - shouldn't appear here. +

Doc attached to include Y. Y + 's top-comment shouldn't appear here.

diff --git a/test/generators/html/Include2-Y_include_synopsis.html b/test/generators/html/Include2-Y_include_synopsis.html index a1039bbe30..dea9cedfaa 100644 --- a/test/generators/html/Include2-Y_include_synopsis.html +++ b/test/generators/html/Include2-Y_include_synopsis.html @@ -13,8 +13,8 @@

Module Include2.Y_include_synopsis

-

The include Y below should have the synopsis from - Y's top-comment attached to it. +

The include Y below should have the synopsis + from Y's top-comment attached to it.

diff --git a/test/generators/html/Include2.html b/test/generators/html/Include2.html index 55526916aa..782c2f79bf 100644 --- a/test/generators/html/Include2.html +++ b/test/generators/html/Include2.html @@ -40,7 +40,9 @@

Module Include2

-

Comment about X that should not appear when including X below.

+

Comment about X that should not appear when including + X below. +

diff --git a/test/generators/html/Include_sections-module-type-Something.html b/test/generators/html/Include_sections-module-type-Something.html index ffd1e615c2..6238588901 100644 --- a/test/generators/html/Include_sections-module-type-Something.html +++ b/test/generators/html/Include_sections-module-type-Something.html @@ -13,7 +13,7 @@

Module type Include_sections.Something

-

A module type.

+

A module type.

Something 1 -

foo

+

foo

@@ -44,11 +44,11 @@

Something 2
val bar : unit -

foo bar

+

foo bar

Something 1-bis -

Some text.

+

Some text.

diff --git a/test/generators/html/Include_sections.html b/test/generators/html/Include_sections.html index 2bfc6ac8e8..b24a7d1b7b 100644 --- a/test/generators/html/Include_sections.html +++ b/test/generators/html/Include_sections.html @@ -47,49 +47,49 @@

Module Include_sections

A module type.

-

Let's include +

Let's include Something once

Something 1 -

foo

+

foo

Something 2

Something 1-bis -

Some text.

+

Some text.

Second include

-

Let's include +

Let's include Something a second time: the heading level should be shift here.

Something 1 -

foo

+

foo

Something 2

Something 1-bis -

Some text.

+

Some text.

Third include -

Shifted some more.

+

Shifted some more.

Something 1 -

foo

+

foo

Something 2

Something 1-bis -

Some text.

-

And let's include it again, but without inlining it this time: - the ToC shouldn't grow. +

Some text.

+

And let's include it again, but without inlining it this + time: the ToC shouldn't grow.

@@ -109,7 +109,7 @@

Something 1 -

foo

+

foo

@@ -123,11 +123,11 @@

val bar : unit -

foo bar

+

foo bar

Something 1-bis -

Some text.

+

Some text.

diff --git a/test/generators/html/Interlude.html b/test/generators/html/Interlude.html index 5350059fc6..cc96a30f00 100644 --- a/test/generators/html/Interlude.html +++ b/test/generators/html/Interlude.html @@ -10,24 +10,25 @@

Module Interlude

-

This is the comment associated to the module.

+

This is the comment associated to the module.

-

Some separate stray text at the top of the module.

+

Some separate stray text at the top of the module.

val foo : unit -

Foo.

+

Foo.

-

Some stray text that is not associated with any signature item.

-

It has multiple paragraphs.

-

A separate block of stray text, adjacent to the preceding one.

+

Some stray text that is not associated with any signature item. +

It has multiple paragraphs.

+

A separate block of stray text, adjacent to the preceding one. +

val bar : unit -

Bar.

+

Bar.

@@ -48,7 +49,7 @@

Module Interlude

val items : unit
-

Stray text at the bottom of the module.

+

Stray text at the bottom of the module.

diff --git a/test/generators/html/Labels.html b/test/generators/html/Labels.html index f01fe5dffe..eb8ec9f6f8 100644 --- a/test/generators/html/Labels.html +++ b/test/generators/html/Labels.html @@ -177,7 +177,7 @@

Attached to nothing

} -

Testing that labels can be referenced

+

Testing that labels can be referenced

just creates a paragraph outside the list.

+

just creates a paragraph outside the list.

  1. but there is also the numbered variant.

Unicode

-

The parser supports any ASCII-compatible encoding, in particuλar - UTF-8. +

The parser supports any ASCII-compatible encoding, in + particuλar UTF-8.

Raw HTML

-

Raw HTML can be as inline - elements into sentences. +

Raw HTML can be + as inline elements into sentences.

@@ -205,10 +206,10 @@

Lists

Math

-

Math elements can be inline: +

Math elements can be inline: \int_{-\infty}^\infty, or blocks:

-
+
          % \f is defined as #1f(#2) using the macro
          \newcommand{\f}[2]{#1f(#2)}
@@ -223,42 +224,45 @@ 

Math

Tags

-

Each comment can end with zero or more tags. Here are some examples: +

Each comment can end with zero or more tags. Here are + some examples:

  • author antron
  • deprecated -

    a long time ago

    +

    a long time ago

  • parameter - foo

    unused

    + foo

    unused

  • raises - Failure

    always

    + Failure

    always

    -
  • returns

    never

  • +
  • returns +

    never

    +
  • see - #

    this url

    + #

    this url

  • see - foo.ml

    this file

    + foo.ml

    this file

  • see - Foo

    this document

    + Foo

    this document

    @@ -267,7 +271,7 @@

    Math

    • before 1.0 -

      it was in beta

      +

      it was in beta

      @@ -279,11 +283,11 @@

      Math

      val foo : unit
-

Comments in structure items support markup, t - oo. +

Comments in structure items support markup + , too.

-

Some modules to support references.

+

Some modules to support references.

diff --git a/test/generators/html/Module.html b/test/generators/html/Module.html index 98e06a8c70..e478aa7c14 100644 --- a/test/generators/html/Module.html +++ b/test/generators/html/Module.html @@ -8,7 +8,7 @@
-

Module Module

Foo.

+

Module Module

Foo.

@@ -17,8 +17,9 @@

Module Module

Foo.

val foo : unit
-

The module needs at least one signature item, otherwise a bug - causes the compiler to drop the module comment (above). See +

The module needs at least one signature item, otherwise + a bug causes the compiler to drop the module comment (above). + See https://caml.inria.fr/mantis/view.php?id=7701 . diff --git a/test/generators/html/Module_type_alias.html b/test/generators/html/Module_type_alias.html index 7ffa36fbc7..b9215af61f 100644 --- a/test/generators/html/Module_type_alias.html +++ b/test/generators/html/Module_type_alias.html @@ -10,7 +10,7 @@

Module Module_type_alias

-

Module Type Aliases

+

Module Type Aliases

diff --git a/test/generators/html/Nested-F-argument-1-Arg1.html b/test/generators/html/Nested-F-argument-1-Arg1.html index c71d953347..108e1d2ba9 100644 --- a/test/generators/html/Nested-F-argument-1-Arg1.html +++ b/test/generators/html/Nested-F-argument-1-Arg1.html @@ -25,7 +25,7 @@

Type

type t -

Some type.

+

Some type.

Values

@@ -34,7 +34,7 @@

Type

val y : t -

The value of y.

+

The value of y.

diff --git a/test/generators/html/Nested-F-argument-2-Arg2.html b/test/generators/html/Nested-F-argument-2-Arg2.html index 86df8b8b7f..02208a4ad7 100644 --- a/test/generators/html/Nested-F-argument-2-Arg2.html +++ b/test/generators/html/Nested-F-argument-2-Arg2.html @@ -22,7 +22,7 @@

Type

type t -

Some type.

+

Some type.

diff --git a/test/generators/html/Nested-F.html b/test/generators/html/Nested-F.html index 34877afd6d..e8bd276971 100644 --- a/test/generators/html/Nested-F.html +++ b/test/generators/html/Nested-F.html @@ -12,7 +12,8 @@

Module Nested.F

-

This is a functor F.

Some additional comments.

+

This is a functor F.

+

Some additional comments.

-

Module Nested.X

This is module X.

-

Some additional comments.

+

Module Nested.X

+

This is module X.

Some additional comments.

-

Class Nested.z

This is class z.

-

Some additional comments.

+

Class Nested.z

+

This is class z.

Some additional comments.

@@ -21,7 +21,7 @@

Class Nested.z

This is class z.

val y : int -

Some value.

+

Some value.

@@ -38,7 +38,7 @@

Class Nested.z

This is class z.

method z : int -

Some method.

+

Some method.

diff --git a/test/generators/html/Nested-module-type-Y.html b/test/generators/html/Nested-module-type-Y.html index 0f847780ee..3535f7703b 100644 --- a/test/generators/html/Nested-module-type-Y.html +++ b/test/generators/html/Nested-module-type-Y.html @@ -12,7 +12,8 @@

Module type Nested.Y

-

This is module type Y.

Some additional comments.

+

This is module type Y.

+

Some additional comments.

Some type.

Values

@@ -33,7 +34,7 @@

Type

val y : t -

The value of y.

+

The value of y.

diff --git a/test/generators/html/Nested.html b/test/generators/html/Nested.html index 6a490bf140..9ff6f7bbd3 100644 --- a/test/generators/html/Nested.html +++ b/test/generators/html/Nested.html @@ -9,7 +9,7 @@

Module Nested

-

This comment needs to be here before #235 is fixed.

+

This comment needs to be here before #235 is fixed.

Module Ocamlary.Aliases

-

Let's imitate jst's layout.

+

Let's imitate jst's layout.

@@ -102,8 +102,8 @@

Module Ocamlary.Aliases

include of Foo

-

Just for giggle, let's see what happens when we include - Foo. +

Just for giggle, let's see what happens when we include + Foo.

@@ -171,7 +171,7 @@

Module Ocamlary.Aliases

-

And also, let's refer to +

And also, let's refer to A.t and Foo.B.id diff --git a/test/generators/html/Ocamlary-Buffer.html b/test/generators/html/Ocamlary-Buffer.html index f1235c684d..e378f20e6b 100644 --- a/test/generators/html/Ocamlary-Buffer.html +++ b/test/generators/html/Ocamlary-Buffer.html @@ -13,8 +13,8 @@

Module Ocamlary.Buffer

-

References are resolved after everything, so {!Buffer.t} - won't resolve. +

References are resolved after everything, so + {!Buffer.t} won't resolve.

diff --git a/test/generators/html/Ocamlary-CollectionModule-InnerModuleA-InnerModuleA'.html b/test/generators/html/Ocamlary-CollectionModule-InnerModuleA-InnerModuleA'.html index 18fb9a5bb3..ea35dfc3b5 100644 --- a/test/generators/html/Ocamlary-CollectionModule-InnerModuleA-InnerModuleA'.html +++ b/test/generators/html/Ocamlary-CollectionModule-InnerModuleA-InnerModuleA'.html @@ -18,7 +18,7 @@

Module InnerModuleA.InnerModuleA'

-

This comment is for InnerModuleA'.

+

This comment is for InnerModuleA'.

@@ -32,7 +32,8 @@

Module InnerModuleA.InnerModuleA'

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-CollectionModule-InnerModuleA-module-type-InnerModuleTypeA'.html b/test/generators/html/Ocamlary-CollectionModule-InnerModuleA-module-type-InnerModuleTypeA'.html index c23b24485f..f34270c8aa 100644 --- a/test/generators/html/Ocamlary-CollectionModule-InnerModuleA-module-type-InnerModuleTypeA'.html +++ b/test/generators/html/Ocamlary-CollectionModule-InnerModuleA-module-type-InnerModuleTypeA'.html @@ -20,7 +20,7 @@

Module type InnerModuleA.InnerModuleTypeA' -

This comment is for InnerModuleTypeA'.

+

This comment is for InnerModuleTypeA'.

@@ -35,7 +35,8 @@

Module type InnerModuleA.InnerModuleTypeA'

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-CollectionModule-InnerModuleA.html b/test/generators/html/Ocamlary-CollectionModule-InnerModuleA.html index 4aacd1d3cf..95e1846675 100644 --- a/test/generators/html/Ocamlary-CollectionModule-InnerModuleA.html +++ b/test/generators/html/Ocamlary-CollectionModule-InnerModuleA.html @@ -15,7 +15,7 @@

Module CollectionModule.InnerModuleA

-

This comment is for InnerModuleA.

+

This comment is for InnerModuleA.

@@ -28,7 +28,8 @@

Module CollectionModule.InnerModuleA

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-CollectionModule.html b/test/generators/html/Ocamlary-CollectionModule.html index 8e725baf5a..f2cc7b8b2e 100644 --- a/test/generators/html/Ocamlary-CollectionModule.html +++ b/test/generators/html/Ocamlary-CollectionModule.html @@ -13,7 +13,7 @@

Module Ocamlary.CollectionModule

-

This comment is for CollectionModule.

+

This comment is for CollectionModule.

@@ -21,7 +21,8 @@

Module Ocamlary.CollectionModule

type collection
-

This comment is for collection.

+
+

This comment is for collection.

diff --git a/test/generators/html/Ocamlary-Empty.html b/test/generators/html/Ocamlary-Empty.html index f9b2e0088b..5075228d60 100644 --- a/test/generators/html/Ocamlary-Empty.html +++ b/test/generators/html/Ocamlary-Empty.html @@ -13,8 +13,8 @@

Module Ocamlary.Empty

-

A plain, empty module

-

This module has a signature without any members.

+

A plain, empty module

+

This module has a signature without any members.

diff --git a/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA-InnerModuleA'.html b/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA-InnerModuleA'.html index 77da390a7f..408110e555 100644 --- a/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA-InnerModuleA'.html +++ b/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA-InnerModuleA'.html @@ -24,7 +24,7 @@

Module InnerModuleA.InnerModuleA'

-

This comment is for InnerModuleA'.

+

This comment is for InnerModuleA'.

@@ -38,7 +38,8 @@

Module InnerModuleA.InnerModuleA'

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA-module-type-InnerModuleTypeA'.html b/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA-module-type-InnerModuleTypeA'.html index ea06b050ba..d4a08133fe 100644 --- a/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA-module-type-InnerModuleTypeA'.html +++ b/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA-module-type-InnerModuleTypeA'.html @@ -24,7 +24,7 @@

Module type InnerModuleA.InnerModuleTypeA' -

This comment is for InnerModuleTypeA'.

+

This comment is for InnerModuleTypeA'.

@@ -39,7 +39,8 @@

Module type InnerModuleA.InnerModuleTypeA'

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA.html b/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA.html index 4a52bef20c..a7809c5314 100644 --- a/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA.html +++ b/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA.html @@ -18,7 +18,7 @@

Module Collection.InnerModuleA

-

This comment is for InnerModuleA.

+

This comment is for InnerModuleA.

@@ -33,7 +33,8 @@

Module Collection.InnerModuleA

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection.html b/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection.html index 848e9249d1..606f2bd39c 100644 --- a/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection.html +++ b/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection.html @@ -17,13 +17,14 @@

Parameter FunctorTypeOf.Collection

-

This comment is for CollectionModule.

+

This comment is for CollectionModule.

type collection
-

This comment is for collection.

+
+

This comment is for collection.

diff --git a/test/generators/html/Ocamlary-FunctorTypeOf.html b/test/generators/html/Ocamlary-FunctorTypeOf.html index 84d05ce6cc..8c1b5a09f8 100644 --- a/test/generators/html/Ocamlary-FunctorTypeOf.html +++ b/test/generators/html/Ocamlary-FunctorTypeOf.html @@ -13,7 +13,7 @@

Module Ocamlary.FunctorTypeOf

-

This comment is for FunctorTypeOf.

+

This comment is for FunctorTypeOf.

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-ModuleWithSignature.html b/test/generators/html/Ocamlary-ModuleWithSignature.html index f5ed434042..78befd214f 100644 --- a/test/generators/html/Ocamlary-ModuleWithSignature.html +++ b/test/generators/html/Ocamlary-ModuleWithSignature.html @@ -13,7 +13,7 @@

Module Ocamlary.ModuleWithSignature

-

A plain module of a signature of +

A plain module of a signature of EmptySig (reference)

diff --git a/test/generators/html/Ocamlary-ModuleWithSignatureAlias.html b/test/generators/html/Ocamlary-ModuleWithSignatureAlias.html index 60e6e191e9..94e47c110c 100644 --- a/test/generators/html/Ocamlary-ModuleWithSignatureAlias.html +++ b/test/generators/html/Ocamlary-ModuleWithSignatureAlias.html @@ -14,10 +14,10 @@

Module Ocamlary.ModuleWithSignatureAlias -

A plain module with an alias signature

+

A plain module with an alias signature

  • deprecated -

    I don't like this element any more.

    +

    I don't like this element any more.

diff --git a/test/generators/html/Ocamlary-Recollection-InnerModuleA-InnerModuleA'.html b/test/generators/html/Ocamlary-Recollection-InnerModuleA-InnerModuleA'.html index 73b7bbc2fe..2d53f49861 100644 --- a/test/generators/html/Ocamlary-Recollection-InnerModuleA-InnerModuleA'.html +++ b/test/generators/html/Ocamlary-Recollection-InnerModuleA-InnerModuleA'.html @@ -18,7 +18,7 @@

Module InnerModuleA.InnerModuleA'

-

This comment is for InnerModuleA'.

+

This comment is for InnerModuleA'.

@@ -32,7 +32,8 @@

Module InnerModuleA.InnerModuleA'

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-Recollection-InnerModuleA-module-type-InnerModuleTypeA'.html b/test/generators/html/Ocamlary-Recollection-InnerModuleA-module-type-InnerModuleTypeA'.html index 40b6b0cfe4..e6ccd91d6c 100644 --- a/test/generators/html/Ocamlary-Recollection-InnerModuleA-module-type-InnerModuleTypeA'.html +++ b/test/generators/html/Ocamlary-Recollection-InnerModuleA-module-type-InnerModuleTypeA'.html @@ -19,7 +19,7 @@

Module type InnerModuleA.InnerModuleTypeA' -

This comment is for InnerModuleTypeA'.

+

This comment is for InnerModuleTypeA'.

@@ -33,7 +33,8 @@

Module type InnerModuleA.InnerModuleTypeA'

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-Recollection-InnerModuleA.html b/test/generators/html/Ocamlary-Recollection-InnerModuleA.html index 1252ce3cff..f51f8a8cc0 100644 --- a/test/generators/html/Ocamlary-Recollection-InnerModuleA.html +++ b/test/generators/html/Ocamlary-Recollection-InnerModuleA.html @@ -15,7 +15,7 @@

Module Recollection.InnerModuleA

-

This comment is for InnerModuleA.

+

This comment is for InnerModuleA.

@@ -27,7 +27,8 @@

Module Recollection.InnerModuleA

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA-InnerModuleA'.html b/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA-InnerModuleA'.html index 4dcb7d91d7..3d57ff246c 100644 --- a/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA-InnerModuleA'.html +++ b/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA-InnerModuleA'.html @@ -20,7 +20,7 @@

Module InnerModuleA.InnerModuleA'

-

This comment is for InnerModuleA'.

+

This comment is for InnerModuleA'.

@@ -34,7 +34,8 @@

Module InnerModuleA.InnerModuleA'

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA-module-type-InnerModuleTypeA'.html b/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA-module-type-InnerModuleTypeA'.html index a61c3551fd..134c120f86 100644 --- a/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA-module-type-InnerModuleTypeA'.html +++ b/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA-module-type-InnerModuleTypeA'.html @@ -21,7 +21,7 @@

Module type InnerModuleA.InnerModuleTypeA' -

This comment is for InnerModuleTypeA'.

+

This comment is for InnerModuleTypeA'.

@@ -36,7 +36,8 @@

Module type InnerModuleA.InnerModuleTypeA'

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA.html b/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA.html index c96d3f8d2e..b2574af008 100644 --- a/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA.html +++ b/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA.html @@ -17,7 +17,7 @@

Module C.InnerModuleA

-

This comment is for InnerModuleA.

+

This comment is for InnerModuleA.

@@ -31,7 +31,8 @@

Module C.InnerModuleA

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-Recollection-argument-1-C.html b/test/generators/html/Ocamlary-Recollection-argument-1-C.html index 0874817a0e..d10ea52874 100644 --- a/test/generators/html/Ocamlary-Recollection-argument-1-C.html +++ b/test/generators/html/Ocamlary-Recollection-argument-1-C.html @@ -16,13 +16,14 @@

Parameter Recollection.C

-

This comment is for CollectionModule.

+

This comment is for CollectionModule.

type collection
-

This comment is for collection.

+
+

This comment is for collection.

diff --git a/test/generators/html/Ocamlary-Recollection.html b/test/generators/html/Ocamlary-Recollection.html index 8fbc7722c4..63274968ed 100644 --- a/test/generators/html/Ocamlary-Recollection.html +++ b/test/generators/html/Ocamlary-Recollection.html @@ -33,7 +33,7 @@

Parameters

Signature

-

This comment is for CollectionModule.

+

This comment is for CollectionModule.

@@ -47,7 +47,8 @@

Signature

-

This comment is for collection.

+
+

This comment is for collection.

diff --git a/test/generators/html/Ocamlary-With10-module-type-T.html b/test/generators/html/Ocamlary-With10-module-type-T.html index dc685c9b6c..505f01b65e 100644 --- a/test/generators/html/Ocamlary-With10-module-type-T.html +++ b/test/generators/html/Ocamlary-With10-module-type-T.html @@ -14,7 +14,8 @@

Module type With10.T

-

With10.T is a submodule type.

+

With10.T is a submodule type. +

diff --git a/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA-InnerModuleA'.html b/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA-InnerModuleA'.html index 30a10700e3..4bb2044d8c 100644 --- a/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA-InnerModuleA'.html +++ b/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA-InnerModuleA'.html @@ -18,7 +18,7 @@

Module InnerModuleA.InnerModuleA'

-

This comment is for InnerModuleA'.

+

This comment is for InnerModuleA'.

@@ -32,7 +32,8 @@

Module InnerModuleA.InnerModuleA'

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA-module-type-InnerModuleTypeA'.html b/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA-module-type-InnerModuleTypeA'.html index 900196c3cd..5279239faf 100644 --- a/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA-module-type-InnerModuleTypeA'.html +++ b/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA-module-type-InnerModuleTypeA'.html @@ -19,7 +19,7 @@

Module type InnerModuleA.InnerModuleTypeA' -

This comment is for InnerModuleTypeA'.

+

This comment is for InnerModuleTypeA'.

@@ -34,7 +34,8 @@

Module type InnerModuleA.InnerModuleTypeA'

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA.html b/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA.html index 54a8f20128..549dde3380 100644 --- a/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA.html +++ b/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA.html @@ -15,7 +15,7 @@

Module Q.InnerModuleA

-

This comment is for InnerModuleA.

+

This comment is for InnerModuleA.

@@ -27,7 +27,8 @@

Module Q.InnerModuleA

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-module-type-A-Q.html b/test/generators/html/Ocamlary-module-type-A-Q.html index 6741240f84..2f0705b2ea 100644 --- a/test/generators/html/Ocamlary-module-type-A-Q.html +++ b/test/generators/html/Ocamlary-module-type-A-Q.html @@ -15,13 +15,14 @@

Module A.Q

-

This comment is for CollectionModule.

+

This comment is for CollectionModule.

type collection
-

This comment is for collection.

+
+

This comment is for collection.

diff --git a/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA-InnerModuleA'.html b/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA-InnerModuleA'.html index 0cef212d7d..7860178554 100644 --- a/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA-InnerModuleA'.html +++ b/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA-InnerModuleA'.html @@ -18,7 +18,7 @@

Module InnerModuleA.InnerModuleA'

-

This comment is for InnerModuleA'.

+

This comment is for InnerModuleA'.

@@ -32,7 +32,8 @@

Module InnerModuleA.InnerModuleA'

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA-module-type-InnerModuleTypeA'.html b/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA-module-type-InnerModuleTypeA'.html index 14fb2a05da..004137572b 100644 --- a/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA-module-type-InnerModuleTypeA'.html +++ b/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA-module-type-InnerModuleTypeA'.html @@ -19,7 +19,7 @@

Module type InnerModuleA.InnerModuleTypeA' -

This comment is for InnerModuleTypeA'.

+

This comment is for InnerModuleTypeA'.

@@ -34,7 +34,8 @@

Module type InnerModuleA.InnerModuleTypeA'

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA.html b/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA.html index 4c359a2e98..567002ac84 100644 --- a/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA.html +++ b/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA.html @@ -15,7 +15,7 @@

Module Q.InnerModuleA

-

This comment is for InnerModuleA.

+

This comment is for InnerModuleA.

@@ -27,7 +27,8 @@

Module Q.InnerModuleA

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-module-type-B-Q.html b/test/generators/html/Ocamlary-module-type-B-Q.html index 22eee0a224..42091d5e6b 100644 --- a/test/generators/html/Ocamlary-module-type-B-Q.html +++ b/test/generators/html/Ocamlary-module-type-B-Q.html @@ -15,13 +15,14 @@

Module B.Q

-

This comment is for CollectionModule.

+

This comment is for CollectionModule.

type collection
-

This comment is for collection.

+
+

This comment is for collection.

diff --git a/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA-InnerModuleA'.html b/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA-InnerModuleA'.html index 727a4a55bd..9da83f85bb 100644 --- a/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA-InnerModuleA'.html +++ b/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA-InnerModuleA'.html @@ -18,7 +18,7 @@

Module InnerModuleA.InnerModuleA'

-

This comment is for InnerModuleA'.

+

This comment is for InnerModuleA'.

@@ -32,7 +32,8 @@

Module InnerModuleA.InnerModuleA'

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA-module-type-InnerModuleTypeA'.html b/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA-module-type-InnerModuleTypeA'.html index 1e96699892..ad9fb46e14 100644 --- a/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA-module-type-InnerModuleTypeA'.html +++ b/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA-module-type-InnerModuleTypeA'.html @@ -19,7 +19,7 @@

Module type InnerModuleA.InnerModuleTypeA' -

This comment is for InnerModuleTypeA'.

+

This comment is for InnerModuleTypeA'.

@@ -34,7 +34,8 @@

Module type InnerModuleA.InnerModuleTypeA'

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA.html b/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA.html index 19e27aa3b2..5f3ae2517e 100644 --- a/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA.html +++ b/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA.html @@ -15,7 +15,7 @@

Module Q.InnerModuleA

-

This comment is for InnerModuleA.

+

This comment is for InnerModuleA.

@@ -27,7 +27,8 @@

Module Q.InnerModuleA

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-module-type-C-Q.html b/test/generators/html/Ocamlary-module-type-C-Q.html index 6e404925b8..6739f417cb 100644 --- a/test/generators/html/Ocamlary-module-type-C-Q.html +++ b/test/generators/html/Ocamlary-module-type-C-Q.html @@ -15,13 +15,14 @@

Module C.Q

-

This comment is for CollectionModule.

+

This comment is for CollectionModule.

type collection
-

This comment is for collection.

+
+

This comment is for collection.

diff --git a/test/generators/html/Ocamlary-module-type-C.html b/test/generators/html/Ocamlary-module-type-C.html index 1bec482720..bbcaa10a09 100644 --- a/test/generators/html/Ocamlary-module-type-C.html +++ b/test/generators/html/Ocamlary-module-type-C.html @@ -12,7 +12,7 @@

Module type Ocamlary.C

-

This module type includes two signatures.

+

This module type includes two signatures.

  • it includes A
  • diff --git a/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA-InnerModuleA'.html b/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA-InnerModuleA'.html index 87734c2d4f..61563d8c59 100644 --- a/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA-InnerModuleA'.html +++ b/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA-InnerModuleA'.html @@ -19,7 +19,7 @@

    Module InnerModuleA.InnerModuleA'

    -

    This comment is for InnerModuleA'.

    +

    This comment is for InnerModuleA'.

    @@ -33,7 +33,8 @@

    Module InnerModuleA.InnerModuleA'

    -

    This comment is for t.

    +

    This comment is for t.

    +
diff --git a/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA-module-type-InnerModuleTypeA'.html b/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA-module-type-InnerModuleTypeA'.html index fb6d32f6c2..67cb87fadd 100644 --- a/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA-module-type-InnerModuleTypeA'.html +++ b/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA-module-type-InnerModuleTypeA'.html @@ -20,7 +20,7 @@

Module type InnerModuleA.InnerModuleTypeA' -

This comment is for InnerModuleTypeA'.

+

This comment is for InnerModuleTypeA'.

@@ -35,7 +35,8 @@

Module type InnerModuleA.InnerModuleTypeA'

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA.html b/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA.html index 55ed080c26..21ffbae31f 100644 --- a/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA.html +++ b/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA.html @@ -15,7 +15,7 @@

Module COLLECTION.InnerModuleA

-

This comment is for InnerModuleA.

+

This comment is for InnerModuleA.

@@ -29,7 +29,8 @@

Module COLLECTION.InnerModuleA

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-module-type-COLLECTION.html b/test/generators/html/Ocamlary-module-type-COLLECTION.html index 85b9d992f5..d98a6503d4 100644 --- a/test/generators/html/Ocamlary-module-type-COLLECTION.html +++ b/test/generators/html/Ocamlary-module-type-COLLECTION.html @@ -13,16 +13,17 @@

Module type Ocamlary.COLLECTION

-

module type of

+

module type of

-

This comment is for CollectionModule.

+

This comment is for CollectionModule.

type collection
-

This comment is for collection.

+
+

This comment is for collection.

diff --git a/test/generators/html/Ocamlary-module-type-Empty.html b/test/generators/html/Ocamlary-module-type-Empty.html index 5d6b095ef4..193bce2c42 100644 --- a/test/generators/html/Ocamlary-module-type-Empty.html +++ b/test/generators/html/Ocamlary-module-type-Empty.html @@ -13,7 +13,7 @@

Module type Ocamlary.Empty

-

An ambiguous, misnamed module type

+

An ambiguous, misnamed module type

diff --git a/test/generators/html/Ocamlary-module-type-EmptySig.html b/test/generators/html/Ocamlary-module-type-EmptySig.html index bcb61dbc4d..70dea7378f 100644 --- a/test/generators/html/Ocamlary-module-type-EmptySig.html +++ b/test/generators/html/Ocamlary-module-type-EmptySig.html @@ -13,7 +13,7 @@

Module type Ocamlary.EmptySig

-

A plain, empty module signature

+

A plain, empty module signature

diff --git a/test/generators/html/Ocamlary-module-type-IncludeModuleType.html b/test/generators/html/Ocamlary-module-type-IncludeModuleType.html index c0318d621f..78319e0f41 100644 --- a/test/generators/html/Ocamlary-module-type-IncludeModuleType.html +++ b/test/generators/html/Ocamlary-module-type-IncludeModuleType.html @@ -13,12 +13,12 @@

Module type Ocamlary.IncludeModuleType

-

This comment is for IncludeModuleType.

+

This comment is for IncludeModuleType.

-

This comment is for include EmptySigAlias.

+

This comment is for include EmptySigAlias.

diff --git a/test/generators/html/Ocamlary-module-type-MMM-C-InnerModuleA-InnerModuleA'.html b/test/generators/html/Ocamlary-module-type-MMM-C-InnerModuleA-InnerModuleA'.html index 2347cae82b..13c81e9394 100644 --- a/test/generators/html/Ocamlary-module-type-MMM-C-InnerModuleA-InnerModuleA'.html +++ b/test/generators/html/Ocamlary-module-type-MMM-C-InnerModuleA-InnerModuleA'.html @@ -19,7 +19,7 @@

Module InnerModuleA.InnerModuleA'

-

This comment is for InnerModuleA'.

+

This comment is for InnerModuleA'.

@@ -33,7 +33,8 @@

Module InnerModuleA.InnerModuleA'

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-module-type-MMM-C-InnerModuleA-module-type-InnerModuleTypeA'.html b/test/generators/html/Ocamlary-module-type-MMM-C-InnerModuleA-module-type-InnerModuleTypeA'.html index cd572f2ff8..874349f0ca 100644 --- a/test/generators/html/Ocamlary-module-type-MMM-C-InnerModuleA-module-type-InnerModuleTypeA'.html +++ b/test/generators/html/Ocamlary-module-type-MMM-C-InnerModuleA-module-type-InnerModuleTypeA'.html @@ -19,7 +19,7 @@

Module type InnerModuleA.InnerModuleTypeA' -

This comment is for InnerModuleTypeA'.

+

This comment is for InnerModuleTypeA'.

@@ -34,7 +34,8 @@

Module type InnerModuleA.InnerModuleTypeA'

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-module-type-MMM-C-InnerModuleA.html b/test/generators/html/Ocamlary-module-type-MMM-C-InnerModuleA.html index f15b794bd9..f66435c7f4 100644 --- a/test/generators/html/Ocamlary-module-type-MMM-C-InnerModuleA.html +++ b/test/generators/html/Ocamlary-module-type-MMM-C-InnerModuleA.html @@ -15,7 +15,7 @@

Module C.InnerModuleA

-

This comment is for InnerModuleA.

+

This comment is for InnerModuleA.

@@ -28,7 +28,8 @@

Module C.InnerModuleA

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-module-type-MMM-C.html b/test/generators/html/Ocamlary-module-type-MMM-C.html index c50306ea93..45d9ff55b5 100644 --- a/test/generators/html/Ocamlary-module-type-MMM-C.html +++ b/test/generators/html/Ocamlary-module-type-MMM-C.html @@ -16,13 +16,14 @@

Module MMM.C

-

This comment is for CollectionModule.

+

This comment is for CollectionModule.

type collection
-

This comment is for collection.

+
+

This comment is for collection.

diff --git a/test/generators/html/Ocamlary-module-type-MissingComment.html b/test/generators/html/Ocamlary-module-type-MissingComment.html index 88ba18c04b..d529b77a3b 100644 --- a/test/generators/html/Ocamlary-module-type-MissingComment.html +++ b/test/generators/html/Ocamlary-module-type-MissingComment.html @@ -13,7 +13,7 @@

Module type Ocamlary.MissingComment

-

An ambiguous, misnamed module type

+

An ambiguous, misnamed module type

diff --git a/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA-InnerModuleA'.html b/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA-InnerModuleA'.html index 9b1c6ae3d0..70ab7631ba 100644 --- a/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA-InnerModuleA'.html +++ b/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA-InnerModuleA'.html @@ -21,7 +21,7 @@

Module InnerModuleA.InnerModuleA'

-

This comment is for InnerModuleA'.

+

This comment is for InnerModuleA'.

@@ -35,7 +35,8 @@

Module InnerModuleA.InnerModuleA'

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA-module-type-InnerModuleTypeA'.html b/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA-module-type-InnerModuleTypeA'.html index 69c62484d9..1fb1ec5d0d 100644 --- a/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA-module-type-InnerModuleTypeA'.html +++ b/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA-module-type-InnerModuleTypeA'.html @@ -22,7 +22,7 @@

Module type InnerModuleA.InnerModuleTypeA' -

This comment is for InnerModuleTypeA'.

+

This comment is for InnerModuleTypeA'.

@@ -37,7 +37,8 @@

Module type InnerModuleA.InnerModuleTypeA'

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA.html b/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA.html index cbd7e343af..c0007983d9 100644 --- a/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA.html +++ b/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA.html @@ -16,7 +16,7 @@

Module RecollectionModule.InnerModuleA

-

This comment is for InnerModuleA.

+

This comment is for InnerModuleA.

@@ -30,7 +30,8 @@

Module RecollectionModule.InnerModuleA

-

This comment is for t.

+

This comment is for t.

+
diff --git a/test/generators/html/Ocamlary-module-type-SigForMod.html b/test/generators/html/Ocamlary-module-type-SigForMod.html index 33e21dd328..6a48c2a413 100644 --- a/test/generators/html/Ocamlary-module-type-SigForMod.html +++ b/test/generators/html/Ocamlary-module-type-SigForMod.html @@ -13,7 +13,7 @@

Module type Ocamlary.SigForMod

-

There's a signature in a module in this signature.

+

There's a signature in a module in this signature.

diff --git a/test/generators/html/Ocamlary.html b/test/generators/html/Ocamlary.html index 46ac3a4d7d..4140f6b34b 100644 --- a/test/generators/html/Ocamlary.html +++ b/test/generators/html/Ocamlary.html @@ -10,19 +10,20 @@

Module Ocamlary

-

This is an interface with all of the +

This is an interface with all of the module system features. This documentation demonstrates:

  • comment formatting
  • unassociated comments
  • documentation sections
  • -
  • module system documentation including

    +
  • module system documentation including

    1. submodules
    2. module aliases
    3. module types
    4. module type aliases
    5. modules with signatures
    6. modules with aliased signatures
  • -

A numbered list:

  1. 3
  2. 2
  3. 1
-

David Sheets is the author.

+

A numbered list:

+
  1. 3
  2. 2
  3. 1
+

David Sheets is the author.

  • author David Sheets
@@ -70,14 +71,14 @@

Module Ocamlary

-

You may find more information about this HTML documentation renderer - at +

You may find more information about this HTML documentation + renderer at github.com/dsheets/ocamlary . -

This is some verbatim text:

verbatim
-

This is some verbatim text:

[][df[]]}}
-

Here is some raw LaTeX:

-

Here is an index table of Empty modules:

+

This is some verbatim text:

+
verbatim

This is some verbatim text:

+
[][df[]]}}

Here is some raw LaTeX:

+

Here is an index table of Empty modules:

  • Empty A plain, empty module @@ -85,12 +86,12 @@

    Module Ocamlary

  • EmptyAlias A plain module alias of Empty
  • -

Odoc doesn't support {!indexlist}.

-

Here is some superscript: x2

-

Here is some subscript: x0

-

Here are some escaped brackets: { [ @ ] }

-

Here is some emphasis followed by code.

-

An unassociated comment

+

Odoc doesn't support {!indexlist}.

+

Here is some superscript: x2

+

Here is some subscript: x0

+

Here are some escaped brackets: { [ @ ] }

+

Here is some emphasis followed by code. +

An unassociated comment

Level 1

Level 2

Level 3

@@ -257,7 +258,7 @@

EmptySig

-

For a good time, see +

For a good time, see subSig or @@ -289,11 +290,11 @@

EmptySig

won't resolve.

-

Some text before exception title.

+

Some text before exception title.

Basic exception stuff -

After exception title.

+

After exception title.

@@ -302,7 +303,8 @@

of unit -

Unary exception constructor

+
+

Unary exception constructor

@@ -312,7 +314,8 @@

of unit * unit -

Binary exception constructor

+
+

Binary exception constructor

@@ -324,7 +327,7 @@

-

Unary exception constructor over binary tuple

+

Unary exception constructor over binary tuple

@@ -335,7 +338,7 @@

-

+

EmptySig is a module and EmptySig is this @@ -351,7 +354,8 @@

-

EmptySigAlias +

+ EmptySigAlias is this exception.

@@ -376,8 +380,8 @@

-

a_function is this - type and a_function +

a_function + is this type and a_function is the value below.

@@ -392,15 +396,17 @@

-

This is a_function with param and return type.

+

This is a_function with param and return type. +

@@ -447,7 +453,7 @@

@@ -465,7 +471,7 @@

@@ -480,7 +486,7 @@

@@ -495,7 +501,7 @@

@@ -510,7 +516,7 @@

@@ -523,7 +529,7 @@

-

This value was introduced in the Mesozoic era.

+

This value was introduced in the Mesozoic era.

@@ -536,15 +542,15 @@

-

This value has had changes in 1.0.0, 1.1.0, and 1.2.0.

+

This value has had changes in 1.0.0, 1.1.0, and 1.2.0.

-

This comment is for record.

-

This comment is also for record.

+
+

This comment is for record.

+

This comment is also for record.

@@ -947,7 +954,7 @@

mutable a : int;
(* -

a is first and mutable

+

a is first and mutable

*)
@@ -955,7 +962,7 @@

b : unit;
(* -

b is second and immutable

+

b is second and immutable

*)
@@ -964,7 +971,7 @@

mutable c : int;
(* -

c is third and mutable

+

c is third and mutable

*)
@@ -1004,7 +1011,7 @@

TagA
(* -

This comment is for TagA.

+

This comment is for TagA.

*)
@@ -1016,7 +1023,7 @@

(* -

This comment is for ConstrB.

+

This comment is for ConstrB.

*)
@@ -1028,7 +1035,7 @@

(* -

This comment is for binary ConstrC.

+

This comment is for binary ConstrC.

*)
@@ -1040,14 +1047,16 @@

(* -

This comment is for unary ConstrD of binary tuple. +

This comment is for unary ConstrD of + binary tuple.

*)

-

This comment is for variant.

-

This comment is also for variant.

+
+

This comment is for variant.

+

This comment is also for variant.

@@ -1069,8 +1078,8 @@

]

-

This comment is for poly_variant.

-

Wow! It was a polymorphic variant!

+

This comment is for poly_variant.

+

Wow! It was a polymorphic variant!

@@ -1129,8 +1138,9 @@

-

This comment is for full_gadt.

-

Wow! It was a GADT!

+
+

This comment is for full_gadt.

+

Wow! It was a GADT!

@@ -1181,8 +1191,8 @@

-

This comment is for partial_gadt.

-

Wow! It was a mixed GADT!

+

This comment is for partial_gadt.

+

Wow! It was a mixed GADT!

@@ -1192,7 +1202,8 @@

= variant

-

This comment is for alias.

+
+

This comment is for alias.

@@ -1209,7 +1220,8 @@

-

This comment is for tuple.

+
+

This comment is for tuple.

@@ -1252,7 +1264,7 @@

-

This comment is for variant_alias.

+

This comment is for variant_alias.

@@ -1274,7 +1286,7 @@

}

-

This comment is for record_alias.

+

This comment is for record_alias.

@@ -1297,7 +1309,7 @@

]

-

This comment is for poly_variant_union.

+

This comment is for poly_variant_union.

@@ -1556,7 +1568,7 @@

-

This comment is for full_gadt_alias.

+

This comment is for full_gadt_alias.

@@ -1614,7 +1626,7 @@

-

This comment is for partial_gadt_alias.

+

This comment is for partial_gadt_alias.

@@ -1627,7 +1639,7 @@

-

This comment is for +

This comment is for Exn_arrow.

@@ -1653,7 +1665,7 @@

(* -

This comment is between +

This comment is between mutual_constr_a and mutual_constr_b @@ -1664,7 +1676,7 @@

-

This comment is for +

This comment is for mutual_constr_a then mutual_constr_b . @@ -1692,14 +1704,15 @@

(* -

This comment must be here for the next to associate correctly.

- *) +

This comment must be here for the next to associate + correctly. +

*)

-

This comment is for +

This comment is for mutual_constr_b then mutual_constr_a . @@ -1777,7 +1790,9 @@

type ext = .. -

A mystery wrapped in an ellipsis

+ +

A mystery wrapped in an ellipsis

+
@@ -1877,7 +1892,7 @@

type 'a poly_ext = .. -

'a poly_ext

+

'a poly_ext

@@ -1905,7 +1920,7 @@

(* -

'b poly_ext

*) +

'b poly_ext

*)
@@ -1928,7 +1943,7 @@

(* -

'c poly_ext

*) +

'c poly_ext

*)
@@ -1962,7 +1977,8 @@

ZzzTop0
(* -

It's got the rock

*) +

It's got the rock

+ *)
@@ -1985,7 +2001,8 @@

(* -

and it packs a unit.

*) +

and it packs a unit.

+ *)
@@ -1999,7 +2016,8 @@

unit -> unit -

Rotate keys on my mark...

+
+

Rotate keys on my mark...

@@ -2013,7 +2031,8 @@

-

A brown paper package tied up with string

+
+

A brown paper package tied up with string

@@ -2701,11 +2720,11 @@

Trying the {!modules: ...} command.

-

With ocamldoc, toplevel units will be linked and documented, while - submodules will behave as simple references. +

With ocamldoc, toplevel units will be linked and documented, + while submodules will behave as simple references.

-

With odoc, everything should be resolved (and linked) but only - toplevel units will be documented. +

With odoc, everything should be resolved (and linked) + but only toplevel units will be documented.

  • Dep1.X
  • @@ -2749,7 +2768,7 @@

-

Some ref to +

Some ref to CanonicalTest.Base_Tests.C.t and @@ -2780,7 +2799,7 @@

Aliases again

Section title splicing -

I can refer to

+

I can refer to

But also to things in submodules:

+

But also to things in submodules:

And just to make sure we do not mess up:

+

And just to make sure we do not mess up: