Update vendored odoc-parser to master branch (#2632)

* Add support for media elements
* Support for the new tag syntax and new tags
* Backport changed newline parsing in code spans

* Wrap code spans if they are too long

If a code span exceed the margin, the line is broken before the code
spans. If a code span is on its own line and still break the margin,
then it is allowed to break.
The new parsing rules allow us to do that without changing the comment.

Author: Julow

CHANGES.md

@@ -56,7 +56,7 @@ profile. This started with version 0.26.0.
 - Added back the flag `--disable-outside-detected-project` (#2439, @gpetiot)
   It was removed in version 0.22.
 
-- Support newer Odoc syntax (#2631, @Julow)
+- Support newer Odoc syntax (#2631, #2632, @Julow)
 
 ### Changed
 

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,20 +143,24 @@ 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
 
-let odoc_tag c fmt = function
+let odoc_implicitly_ended_tag c fmt tag elems =
+  fpf fmt "%s(%a)" tag (odoc_nestable_block_elements c) elems
+
+let odoc_tag c fmt : Ast.tag -> unit = function
   | `Author txt -> fpf fmt "Author(%a)" str txt
-  | `Deprecated elems ->
-      fpf fmt "Deprecated(%a)" (odoc_nestable_block_elements c) elems
+  | `Deprecated elems -> odoc_implicitly_ended_tag c fmt "Deprecated" elems
   | `Param (p, elems) ->
       fpf fmt "Param(%a,%a)" str p (odoc_nestable_block_elements c) elems
   | `Raise (p, elems) ->
       fpf fmt "Raise(%a,%a)" str p (odoc_nestable_block_elements c) elems
-  | `Return elems ->
-      fpf fmt "Return(%a)" (odoc_nestable_block_elements c) elems
+  | `Return elems -> odoc_implicitly_ended_tag c fmt "Return" elems
   | `See (kind, txt, elems) ->
       let kind =
         match kind with `Url -> "U" | `File -> "F" | `Document -> "D"
@@ -163,6 +177,9 @@ let odoc_tag c fmt = function
   | `Open -> fpf fmt "Open"
   | `Closed -> fpf fmt "Closed"
   | `Hidden -> fpf fmt "Hidden"
+  | `Children_order elems ->
+      odoc_implicitly_ended_tag c fmt "Children_order" elems
+  | `Short_title elems -> odoc_implicitly_ended_tag c fmt "Short_title" elems
 
 let odoc_block_element c fmt = function
   | `Heading (lvl, lbl, content) ->

lib/Fmt_odoc.ml

@@ -104,8 +104,15 @@ let fmt_verbatim_block ~loc s =
   in
   hvbox 0 (wrap (str "{v") (str "v}") content)
 
-let fmt_code_span s =
-  wrap (str "[") (str "]") (str (escape_balanced_brackets s))
+let fmt_code_span ~wrap s =
+  let s = escape_balanced_brackets s in
+  let s =
+    if wrap then
+      let words = String.split_on_chars ~on:[' '] s in
+      list words space_break str
+    else str s
+  in
+  hovbox_if wrap 1 (str "[" $ s $ str "]")
 
 let fmt_math_span s = hovbox 2 (wrap (str "{m ") (str "}") (str s))
 
@@ -163,8 +170,8 @@ let list_block_elem c elems f =
                 (elem.Loc.value :> block_element)
                 (n.value :> block_element)
               || should_preserve_blank c elem.location n.location
-            then str "\n" $ force_newline
-            else force_newline
+            then str "\n" $ force_break
+            else force_break
         | None -> noop
       in
       f elem $ break )
@@ -231,7 +238,7 @@ let rec fmt_inline_elements c ~wrap elements =
     | `Word w :: t ->
         fmt_if (String.is_prefix ~prefix:"@" w) (str "\\")
         $ str_normalized ~wrap w $ aux t
-    | `Code_span s :: t -> fmt_code_span s $ aux t
+    | `Code_span s :: t -> fmt_code_span ~wrap s $ aux t
     | `Math_span s :: t -> fmt_math_span s $ aux t
     | `Raw_markup (lang, s) :: t ->
         let lang =
@@ -281,7 +288,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 +307,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 =
@@ -437,7 +459,7 @@ let wrap_see = function
   | `File -> wrap (str "'") (str "'")
   | `Document -> wrap (str "\"") (str "\"")
 
-let fmt_tag c = function
+let fmt_tag c : tag -> _ = function
   | `Author s -> fmt_tag_args c "author" ~arg:(str s)
   | `Version s -> fmt_tag_args c "version" ~arg:(str s)
   | `See (k, sr, txt) -> fmt_tag_args c "see" ~arg:(wrap_see k (str sr)) ~txt
@@ -452,6 +474,8 @@ let fmt_tag c = function
   | `Closed -> fmt_tag_args c "closed"
   | `Hidden -> fmt_tag_args c "hidden"
   | `Canonical ref -> fmt_tag_args c "canonical" ~arg:(fmt_reference ref)
+  | `Children_order txt -> fmt_tag_args c "children_order" ~txt
+  | `Short_title txt -> fmt_tag_args c "short_title" ~txt
 
 let fmt_block_element c elm =
   match elm.Loc.value with

test/passing/refs.default/doc_comments-no-wrap.mli.err

@@ -7,7 +7,6 @@ Warning: doc_comments-no-wrap.mli:110 exceeds the margin
 Warning: doc_comments-no-wrap.mli:115 exceeds the margin
 Warning: doc_comments-no-wrap.mli:124 exceeds the margin
 Warning: doc_comments-no-wrap.mli:328 exceeds the margin
-Warning: doc_comments-no-wrap.mli:384 exceeds the margin
 Warning: doc_comments-no-wrap.mli:556 exceeds the margin
 Warning: doc_comments-no-wrap.mli:625 exceeds the margin
 Warning: doc_comments-no-wrap.mli:648 exceeds the margin

test/passing/refs.default/doc_comments-no-wrap.mli.ref

@@ -377,12 +377,12 @@ end
 
 (** {%html:<p>Raw markup</p>%} {%Without language%} {%other:Other language%} *)
 
-(** [Multi
-     Line]
+(** [Multi Line]
 
     [ A lot of    spaces ]
 
-    [Very looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong]
+    [Very
+     looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong]
 *)
 
 (** {[

test/passing/refs.default/doc_comments.mli.err

@@ -7,7 +7,6 @@ Warning: doc_comments.mli:110 exceeds the margin
 Warning: doc_comments.mli:115 exceeds the margin
 Warning: doc_comments.mli:124 exceeds the margin
 Warning: doc_comments.mli:328 exceeds the margin
-Warning: doc_comments.mli:384 exceeds the margin
 Warning: doc_comments.mli:556 exceeds the margin
 Warning: doc_comments.mli:625 exceeds the margin
 Warning: doc_comments.mli:648 exceeds the margin

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

@@ -377,12 +377,12 @@ end
 
 (** {%html:<p>Raw markup</p>%} {%Without language%} {%other:Other language%} *)
 
-(** [Multi
-     Line]
+(** [Multi Line]
 
     [ A lot of    spaces ]
 
-    [Very looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong]
+    [Very
+     looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong]
 *)
 
 (** {[

test/passing/refs.default/js_source.ml.err

@@ -2,4 +2,4 @@ Warning: js_source.ml:122 exceeds the margin
 Warning: js_source.ml:156 exceeds the margin
 Warning: js_source.ml:229 exceeds the margin
 Warning: js_source.ml:327 exceeds the margin
-Warning: js_source.ml:809 exceeds the margin
+Warning: js_source.ml:808 exceeds the margin

test/passing/refs.default/js_source.ml.ref

@@ -750,8 +750,7 @@ let _ =
 
 (*$ (* *) *)
 
-(** xxxxxxxxxxxxxxxxxxxxxxxxxxx [xxxxxxx
-    xxxx]
+(** xxxxxxxxxxxxxxxxxxxxxxxxxxx [xxxxxxx xxxx]
     xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx [xxxxxxx] *)
 
 (*    Hand-aligned comment

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

@@ -245,7 +245,56 @@
     @open
     @closed
     @hidden
-    @canonical ref *)
+    @canonical ref
+
+    @author Foo
+
+    {2 Bar}
+
+    @author Foo
+
+    - bar
+
+    @hidden
+
+    foo
+    @hidden
+
+    @deprecated
+      - foo
+      - bar
+
+    @deprecated
+      - foo
+      - bar
+
+    @deprecated
+
+    {2 Bar}
+
+    @children_order
+      foo
+      - bar baz *)
 
 (** {!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} *)
+
+(** fooooooooooooooo fooooooooooooooo fooooooooooooooo
+    [fooooooooooooooo fooooooooooooooo] fooooooooooooooo
+
+    fooooooooooooooo
+    [fooooooooooooooo fooooooooooooooo fooooooooooooooo fooooooooooooooo
+     fooooooooooooooo fooooooooooooooo] fooooooooooooooo *)