Add support for media elements

lib/Docstring.ml

@@ -96,7 +96,17 @@ let alignment_to_string = function
 
 let header_data_to_string = function `Header -> "Header" | `Data -> "Data"
 
-let rec odoc_nestable_block_element c fmt = function
+let media_to_string = function
+  | `Audio -> "Audio"
+  | `Video -> "Video"
+  | `Image -> "Image"
+
+let fmt_media_href fmt = function
+  | `Reference s -> fpf fmt "Reference(%s)" s
+  | `Link s -> fpf fmt "Link(%s)" s
+
+let rec odoc_nestable_block_element c fmt : Ast.nestable_block_element -> _ =
+  function
   | `Paragraph elms -> fpf fmt "Paragraph(%a)" odoc_inline_elements elms
   | `Code_block (b : Ast.code_block) ->
       let fmt_metadata fmt (m : Ast.code_block_meta) =
@@ -133,6 +143,9 @@ let rec odoc_nestable_block_element c fmt = function
       let pp_alignment = option (list (option pp_align)) in
       fpf fmt "Table((%a,%a),%s)" pp_grid grid pp_alignment alignment
         (light_heavy_to_string syntax)
+  | `Media (_kind, href, text, media) ->
+      fpf fmt "Media(%a,%S,%s)" (ign_loc fmt_media_href) href text
+        (media_to_string media)
 
 and odoc_nestable_block_elements c fmt elems =
   list (ign_loc (odoc_nestable_block_element c)) fmt elems

lib/Fmt_odoc.ml

@@ -281,7 +281,8 @@ and fmt_markup_with_inline_elements c ~wrap ?(force_space = false) tag elems
   in
   str "{" $ tag $ leading_space $ fmt_inline_elements c ~wrap elems $ str "}"
 
-and fmt_nestable_block_element c elm =
+and fmt_nestable_block_element c (elm : nestable_block_element with_location)
+    =
   match elm.Loc.value with
   | `Paragraph elems ->
       hovbox 0
@@ -299,6 +300,20 @@ and fmt_nestable_block_element c elm =
       fmt_list_heavy c k items
   | `List (k, _syntax, items) -> fmt_list_light c k items
   | `Table table -> fmt_table c table
+  | `Media (_kind, href, text, media) -> (
+      let prefix =
+        match media with
+        | `Image -> "image"
+        | `Video -> "video"
+        | `Audio -> "audio"
+      in
+      let href =
+        match href.value with
+        | `Reference s -> str "!" $ str s
+        | `Link s -> str ":" $ str s
+      in
+      let ref = str "{" $ str prefix $ href $ str "}" in
+      match text with "" -> ref | _ -> str "{" $ ref $ str text $ str "}" )
 
 and fmt_list_heavy c kind items =
   let fmt_item elems =

test/passing/refs.default/odoc.mli.ref

@@ -248,4 +248,17 @@
     @canonical ref *)
 
 (** {!foo} bar{!foo} {!foo}bar {!val:foo} {!} {!( * )} {!:foo} {!val:}
-    {!"my-name"} {!"}"} {!( } )} {{!foo} bar} {{!foo} {b bar}} *)
+    {!"my-name"} {!"}"} {!( } )} {{!foo} bar} {{!foo} {b bar}}
+
+    {image!foo}
+    {audio!foo}
+    {video!foo}
+    {image:foo}
+    {audio:foo}
+    {video:foo}
+    {{image!foo}bar}
+    {{audio!foo}bar}
+    {{video!foo}bar}
+    {{image:foo}bar}
+    {{audio:foo}bar}
+    {{video:foo}bar} *)

test/passing/refs.janestreet/odoc.mli.ref

@@ -259,4 +259,17 @@
     {!"}"}
     {!( } )}
     {{!foo} bar}
-    {{!foo} {b bar}} *)
+    {{!foo} {b bar}}
+
+    {image!foo}
+    {audio!foo}
+    {video!foo}
+    {image:foo}
+    {audio:foo}
+    {video:foo}
+    {{image!foo}bar}
+    {{audio!foo}bar}
+    {{video!foo}bar}
+    {{image:foo}bar}
+    {{audio:foo}bar}
+    {{video:foo}bar} *)

test/passing/refs.ocamlformat/odoc.mli.ref

@@ -248,4 +248,17 @@
     @canonical ref *)
 
 (** {!foo} bar{!foo} {!foo}bar {!val:foo} {!} {!( * )} {!:foo} {!val:}
-    {!"my-name"} {!"}"} {!( } )} {{!foo} bar} {{!foo} {b bar}} *)
+    {!"my-name"} {!"}"} {!( } )} {{!foo} bar} {{!foo} {b bar}}
+
+    {image!foo}
+    {audio!foo}
+    {video!foo}
+    {image:foo}
+    {audio:foo}
+    {video:foo}
+    {{image!foo}bar}
+    {{audio!foo}bar}
+    {{video!foo}bar}
+    {{image:foo}bar}
+    {{audio:foo}bar}
+    {{video:foo}bar} *)

test/passing/tests/odoc.mli

@@ -234,4 +234,17 @@
    {!( } )}
    {{!foo} bar}
    {{!foo} {b bar}}
+
+   {image!foo}
+   {audio!foo}
+   {video!foo}
+   {image:foo}
+   {audio:foo}
+   {video:foo}
+   {{image!foo}bar}
+   {{audio!foo}bar}
+   {{video!foo}bar}
+   {{image:foo}bar}
+   {{audio:foo}bar}
+   {{video:foo}bar}
 *)

vendor/odoc-parser/ast.ml

@@ -40,6 +40,9 @@ type code_block_meta = {
   tags : string with_location option;
 }
 
+type media = Token.media
+type media_href = Token.media_href
+
 type code_block = {
   meta : code_block_meta option;
   delimiter : string option;
@@ -57,7 +60,9 @@ and nestable_block_element =
     * [ `Light | `Heavy ]
     * nestable_block_element with_location list list
   | `Table of table
-  | `Math_block of string  (** @since 2.0.0 *) ]
+  | `Math_block of string  (** @since 2.0.0 *)
+  | `Media of reference_kind * media_href with_location * string * media
+    (** @since 3.0.0 *) ]
 (** Some block elements may be nested within lists or tags, but not all.
     The [`List] constructor has a parameter of type [\[`Light | `Heavy\]].
     This corresponds to the syntactic constructor used (see the

vendor/odoc-parser/lexer.mll

@@ -181,13 +181,34 @@ let warning =
   with_location_adjustments (fun input location error ->
     input.warnings := (error location) :: !(input.warnings))
 
-let reference_token start target =
+let reference_token media start target input lexbuf =
   match start with
   | "{!" -> `Simple_reference target
   | "{{!" -> `Begin_reference_with_replacement_text target
-  | "{:" -> `Simple_link target
-  | "{{:" -> `Begin_link_with_replacement_text target
-  | _ -> assert false
+  | "{:" -> `Simple_link (target)
+  | "{{:" -> `Begin_link_with_replacement_text (target)
+
+  | "{image!" -> `Simple_media (`Reference target, `Image)
+  | "{image:" -> `Simple_media (`Link target, `Image)
+  | "{audio!" -> `Simple_media (`Reference target, `Audio)
+  | "{audio:" -> `Simple_media (`Link target, `Audio)
+  | "{video!" -> `Simple_media (`Reference target, `Video)
+  | "{video:" -> `Simple_media (`Link target, `Video)
+
+  | _ ->
+     let target, kind =
+       match start with
+       | "{{image!" -> `Reference target, `Image
+       | "{{image:" -> `Link target, `Image
+       | "{{audio!" -> `Reference target, `Audio
+       | "{{audio:" -> `Link target, `Audio
+       | "{{video!" -> `Reference target, `Video
+       | "{{video:" -> `Link target, `Video
+       | _ -> assert false
+     in
+     let token_descr = Token.describe (`Media_with_replacement_text (target, kind, "")) in
+     let content = media token_descr (Buffer.create 1024) 0 (Lexing.lexeme_start lexbuf) input lexbuf in
+     `Media_with_replacement_text (target, kind, content)
 
 let trim_leading_space_or_accept_whitespace input start_offset text =
   match text.[0] with
@@ -264,8 +285,11 @@ let horizontal_space =
 let newline =
   '\n' | "\r\n"
 
-let reference_start =
-  "{!" | "{{!" | "{:" | "{{:"
+let media_start =
+    "{!" | "{{!" | "{:" | "{{:"
+  | "{image!" | "{{image!" | "{image:" | "{{image:"
+  | "{video!" | "{{video!" | "{video:" | "{{video:"
+  | "{audio!" | "{{audio!" | "{audio:" | "{{audio:"
 
 let raw_markup =
   ([^ '%'] | '%'+ [^ '%' '}'])* '%'*
@@ -402,13 +426,13 @@ and token input = parse
   | "{!modules:" ([^ '}']* as modules) '}'
     { emit input (`Modules modules) }
 
-  | (reference_start as start)
+  | (media_start as start)
     {
       let start_offset = Lexing.lexeme_start lexbuf in
       let target =
         reference_content input start start_offset (Buffer.create 16) lexbuf
       in
-      let token = (reference_token start target) in
+      let token = reference_token media start target input lexbuf in
       emit ~start_offset input token }
 
   | "{["
@@ -681,6 +705,35 @@ and math kind buffer nesting_level start_offset input = parse
     { Buffer.add_char buffer c;
       math kind buffer nesting_level start_offset input lexbuf }
 
+and media tok_descr buffer nesting_level start_offset input = parse
+  | '}'
+    { if nesting_level == 0 then
+        Buffer.contents buffer
+      else begin
+        Buffer.add_char buffer '}';
+        media tok_descr buffer (nesting_level - 1) start_offset input lexbuf
+      end
+      }
+  | '{'
+    { Buffer.add_char buffer '{';
+      media tok_descr buffer (nesting_level + 1) start_offset input lexbuf }
+  | ("\\{" | "\\}") as s
+    { Buffer.add_string buffer s;
+      media tok_descr buffer nesting_level start_offset input lexbuf }
+  | eof
+    { warning
+        input
+        (Parse_error.not_allowed
+          ~what:(Token.describe `End)
+          ~in_what:tok_descr);
+      Buffer.contents buffer}
+  | (newline)
+    { Buffer.add_char buffer ' ';
+      media tok_descr buffer nesting_level start_offset input lexbuf }
+  | _ as c
+    { Buffer.add_char buffer c;
+      media tok_descr buffer nesting_level start_offset input lexbuf }
+
 and verbatim buffer last_false_terminator start_offset input = parse
   | (space_char as c) "v}"
     { Buffer.add_char buffer c;

vendor/odoc-parser/loc.ml

@@ -23,6 +23,9 @@ let span spans =
 let nudge_start offset span =
   { span with start = { span.start with column = span.start.column + offset } }
 
+let nudge_end offset span =
+  { span with end_ = { span.end_ with column = span.end_.column - offset } }
+
 let spans_multiple_lines = function
   | {
       location =

vendor/odoc-parser/loc.mli

@@ -19,6 +19,10 @@ val nudge_start : int -> span -> span
 (** This adjusts only the column number, implicitly assuming that the offset does
    not move the location across a newline character. *)
 
+val nudge_end : int -> span -> span
+(** This adjusts only the column number, implicitly assuming that the offset does
+   not move the location across a newline character. *)
+
 (** {2 Located values} *)
 
 type +'a with_location = { location : span; value : 'a }

vendor/odoc-parser/syntax.ml

@@ -533,7 +533,7 @@ type where_in_line =
 
    When it is called inside a shorthand list item ([- foo]), it stops on end of
    input, right brace, a blank line (indicating end of shorthand list), plus or
-   minus (indicating the start of the next liste item), or a section heading or
+   minus (indicating the start of the next list item), or a section heading or
    tag, which cannot be nested in list markup.
 
    The block parser [block_element_list] explicitly returns the token that
@@ -554,6 +554,7 @@ type stopped_implicitly =
   | `Minus
   | `Plus
   | Token.section_heading
+  | Token.media_markup
   | Token.tag ]
 
 (* Ensure that the above two types are really subsets of [Token.t]. *)
@@ -1146,6 +1147,54 @@ let rec block_element_list :
           |> Loc.at location
         in
         consume_block_elements ~parsed_a_tag `At_start_of_line (paragraph :: acc)
+    | {
+     location;
+     value = `Media_with_replacement_text (href, media, content) as token;
+    } ->
+        junk input;
+
+        let r_location =
+          Loc.nudge_start
+            (String.length @@ Token.s_of_media `Replaced media)
+            location
+          |> Loc.nudge_end (String.length content + 1)
+          (* +1 for closing character *)
+        in
+        let c_location =
+          Loc.nudge_start
+            (String.length (Token.s_of_media `Replaced media)
+            + String.length (match href with `Reference s | `Link s -> s))
+            location
+          |> Loc.nudge_end 1
+        in
+        let content = String.trim content in
+        let href = href |> Loc.at r_location in
+
+        if content = "" then
+          Parse_error.should_not_be_empty ~what:(Token.describe token)
+            c_location
+          |> add_warning input;
+
+        let block = `Media (`Simple, href, content, media) in
+        let block = accepted_in_all_contexts context block in
+        let block = Loc.at location block in
+        let acc = block :: acc in
+        consume_block_elements ~parsed_a_tag `After_text acc
+    | { location; value = `Simple_media (href, media) } ->
+        junk input;
+
+        let r_location =
+          Loc.nudge_start
+            (String.length @@ Token.s_of_media `Simple media)
+            location
+          |> Loc.nudge_end 1
+        in
+        let href = href |> Loc.at r_location in
+        let block = `Media (`Simple, href, "", media) in
+        let block = accepted_in_all_contexts context block in
+        let block = Loc.at location block in
+        let acc = block :: acc in
+        consume_block_elements ~parsed_a_tag `After_text acc
   in
 
   let where_in_line =
@@ -1187,7 +1236,8 @@ and shorthand_list_items :
       Ast.nestable_block_element with_location list list * where_in_line =
    fun next_token where_in_line acc ->
     match next_token.value with
-    | `End | `Right_brace | `Blank_line _ | `Tag _ | `Begin_section_heading _ ->
+    | `End | `Right_brace | `Blank_line _ | `Tag _ | `Begin_section_heading _
+    | `Simple_media _ | `Media_with_replacement_text _ ->
         (List.rev acc, where_in_line)
     | (`Minus | `Plus) as bullet ->
         if bullet = bullet_token then (