Update the vendored odoc-parser (#2757)

Update to the new Odoc features:
- @toc_status and @order_category
- Structured code block tags syntax
- Indentation of code and verbatim blocks

Also backported formatting changes and code changes.

* odoc-parser: Code block and verbatim blocks indentation change

Odoc now strips the indentation from code and verbatim blocks. It
doesn't use the indentation of the least indented line, like
OCamlformat, but instead use the indentation of the block opening.

* odoc: Normalize `\\n` into newline

In code blocks, newlines can be turned into `\\n` (or the opposite) when
formatting string literals that need to break. Update the normalization
function to avoid crashing when that happens.

* odoc: Remove extra indentation in code blocks

The updated Odoc parser considers that code blocks horizontally start at
the opening bracket. It no longer uses the indentation of the least
indented line for that.
As a result, OCamlformat cannot indent code blocks without changing
their content.

The indentation is also removed in code blocks that are formatted, to
avoid adding visible indentation in rendered documentation.

* odoc: Don't fail for removed whitespaces in code blocks

During normalisation, allow whitespaces to disappear from code blocks.
This happens when code if formatted.

Author: Julow

CHANGES.md

@@ -6,6 +6,13 @@ profile. This started with version 0.26.0.
 
 ## unreleased
 
+### Highlight
+
+- \* Update Odoc's parser to 3.0 (#2757, @Julow)
+  The indentation of code-blocks containing OCaml code is reduced by 2 to avoid
+  changing the generated documentation. The indentation within code-blocks is
+  now significative in Odoc and shows up in generated documentation.
+
 ### Added
 
 - Added option `letop-punning` (#2746, @WardBrian) to control whether

lib/Docstring.ml

@@ -37,17 +37,55 @@ let is_tag_only =
 
 type norm_conf = {normalize_code: string -> string}
 
-let normalize_text s =
+(** Like [String.fields] but the separator can be of variable length.
+    [f start_index str] returns [0] if [str.[start_index]] is not the first
+    char of a separator, or returns the length of the separator.
+    [start_index] is always less than [String.length s]. *)
+let fields_pattern ?(empty = true) ~is_sep s =
+  let module Sub = Astring.String.Sub in
+  let len = String.length s in
+  (* Add a sub at the front of [acc] while respecting [empty]. *)
+  let sub' ~start ~stop acc =
+    if start = stop && not empty then acc else Sub.v ~start ~stop s :: acc
+  in
+  let rec loop acc field_start i =
+    if i = len then List.rev (sub' ~start:field_start ~stop:i acc)
+    else
+      match is_sep i s with
+      | 0 -> loop acc field_start (i + 1)
+      | sep_len ->
+          let next = i + sep_len in
+          loop (sub' ~start:field_start ~stop:i acc) next next
+  in
+  loop [] 0 0
+
+let normalize_text_subs s =
   (* normalize consecutive whitespace chars to a single space *)
-  String.concat ~sep:" "
-    (List.filter ~f:(Fn.non String.is_empty)
-       (String.split_on_chars s ~on:['\t'; '\n'; '\011'; '\012'; '\r'; ' ']) )
+  let is_sep i s =
+    match s.[i] with
+    | '\t' | '\n' | '\011' | '\012' | '\r' | ' ' -> 1
+    | '\\' when i + 1 < String.length s -> (
+      match s.[i + 1] with 'n' -> 2 | _ -> 0 )
+    | _ -> 0
+  in
+  fields_pattern ~empty:false ~is_sep s
+
+let normalize_text s =
+  let module Sub = Astring.String.Sub in
+  let sep = Sub.v " " in
+  Sub.concat ~sep (normalize_text_subs s) |> Sub.to_string
 
 let list f fmt l =
-  let pp_sep fmt () = Format.fprintf fmt "" in
+  let pp_sep _ () = () in
   Format.pp_print_list ~pp_sep f fmt l
 
-let str fmt s = Format.fprintf fmt "%s" (normalize_text s)
+let str_with_sep ~pp_sep fmt s =
+  Format.pp_print_list ~pp_sep Astring.String.Sub.pp fmt
+    (normalize_text_subs s)
+
+let str fmt s =
+  let pp_sep fmt () = Format.pp_print_string fmt " " in
+  str_with_sep ~pp_sep fmt s
 
 let ign_loc f fmt with_loc = f fmt with_loc.Odoc_parser.Loc.value
 
@@ -105,17 +143,22 @@ let fmt_media_href fmt = function
   | `Reference s -> fpf fmt "Reference(%s)" s
   | `Link s -> fpf fmt "Link(%s)" s
 
+let fmt_code_block_tag fmt = function
+  | `Tag s -> fpf fmt "Tag(%a)" (ign_loc str) s
+  | `Binding (a, b) ->
+      fpf fmt "Binding(%a, %a)" (ign_loc str) a (ign_loc str) b
+
 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) =
-        fpf fmt "(%a, %a)" (ign_loc str) m.language
-          (option (ign_loc str))
+        fpf fmt "(%a, %a)" (ign_loc str) m.language (list fmt_code_block_tag)
           m.tags
       in
       let fmt_content =
-        ign_loc (fun fmt s -> str fmt (c.normalize_code s))
+        let pp_sep _ () = () in
+        ign_loc (fun fmt s -> str_with_sep ~pp_sep fmt (c.normalize_code s))
       in
       let fmt_output =
         option (list (ign_loc (odoc_nestable_block_element c)))
@@ -179,6 +222,10 @@ let odoc_tag c fmt : Ast.tag -> unit = function
   | `Hidden -> fpf fmt "Hidden"
   | `Children_order elems ->
       odoc_implicitly_ended_tag c fmt "Children_order" elems
+  | `Toc_status txt ->
+      fpf fmt "Toc_status(%a)" (odoc_nestable_block_elements c) txt
+  | `Order_category txt ->
+      fpf fmt "Order_category(%a)" (odoc_nestable_block_elements c) txt
   | `Short_title elems -> odoc_implicitly_ended_tag c fmt "Short_title" elems
 
 let odoc_block_element c fmt = function

lib/Fmt_odoc.ml

@@ -10,6 +10,7 @@
 (**************************************************************************)
 
 open Fmt
+open Ocamlformat_odoc_parser
 open Ocamlformat_odoc_parser.Ast
 module Loc = Ocamlformat_odoc_parser.Loc
 
@@ -95,14 +96,23 @@ let rec drop_leading_spaces = function
 
 let ign_loc ~f with_loc = f with_loc.Loc.value
 
+(** Format the content of code and verbatim blocks. *)
+let fmt_multiline_text txt =
+  let fmt_line ~first ~last:_ l =
+    let l = String.rstrip l in
+    if first then str l
+    else if String.length l = 0 then str_as 0 "\n"
+    else force_break $ str l
+  in
+  let lines = String.split_lines txt in
+  vbox 0 (list_fl lines fmt_line)
+
 let fmt_verbatim_block ~loc s =
-  let force_break = loc.Loc.start.line < loc.end_.line in
   let content =
-    (* Literal newline to avoid indentation *)
-    if force_break then wrap (str "\n") force_newline (str s)
-    else fits_breaks " " "\n" $ str s $ fits_breaks " " ~hint:(0, 0) ""
+    let s, _warnings = Odoc_parser.verbatim_content loc s in
+    fmt_multiline_text s
   in
-  hvbox 0 (wrap (str "{v") (str "v}") content)
+  hvbox 0 (str "{v" $ space_break $ content $ space_break $ str "v}")
 
 let fmt_code_span ~wrap s =
   let s = escape_balanced_brackets s in
@@ -300,7 +310,7 @@ and fmt_nestable_block_element c (elm : nestable_block_element with_location)
   | `Paragraph elems ->
       hovbox 0
         (fmt_inline_elements c ~wrap:c.conf.fmt_opts.wrap_docstrings.v elems)
-  | `Code_block code_block -> fmt_code_block c code_block
+  | `Code_block code_block -> fmt_code_block ~loc:elm.location c code_block
   | `Math_block s -> fmt_math_block s
   | `Verbatim s -> fmt_verbatim_block ~loc:elm.location s
   | `Modules mods ->
@@ -431,13 +441,19 @@ and fmt_table c table =
   | Some light -> fmt_table_light c light
   | None -> fmt_table_heavy c table
 
-and fmt_code_block c (b : code_block) =
+and fmt_code_block_tag = function
+  | `Tag t -> ign_loc ~f:str t
+  | `Binding (k, v) -> ign_loc ~f:str k $ str "=" $ ign_loc ~f:str v
+
+and fmt_code_block c ~loc (b : code_block) =
   let content =
-    let content = b.content.value in
+    let content, _warnings =
+      Odoc_parser.codeblock_content loc b.content.value
+    in
     match b.meta with
     | Some {language= {value= "ocaml"; _}; _} | None -> (
       (* [offset] doesn't take into account code blocks nested into lists. *)
-      match c.fmt_code c.conf ~offset:2 ~set_margin:true content with
+      match c.fmt_code c.conf ~offset:0 ~set_margin:true content with
       | Ok formatted -> formatted |> Format_.asprintf "%a" Fmt.eval
       | Error (`Msg message) ->
           if
@@ -451,23 +467,13 @@ and fmt_code_block c (b : code_block) =
           content )
     | Some _ -> content
   in
-  let fmt_line ~first ~last:_ l =
-    let l = String.rstrip l in
-    if first then str l
-    else if String.length l = 0 then str_as 0 "\n"
-    else force_break $ str l
-  in
-  let fmt_code s =
-    let lines = String.split_lines s in
-    vbox 0 (list_fl lines fmt_line)
-  in
   let delim = opt b.delimiter str in
   let opening =
     let meta =
       opt b.meta (fun meta ->
           str "@"
           $ ign_loc ~f:str meta.language
-          $ opt meta.tags (fun tags -> str " " $ ign_loc ~f:str tags) )
+          $ list meta.tags noop (fun t -> char ' ' $ fmt_code_block_tag t) )
     in
     str "{" $ delim $ meta $ str "["
   in
@@ -481,9 +487,11 @@ and fmt_code_block c (b : code_block) =
           $ str "]}" )
     | None -> str "]" $ delim $ str "}"
   in
-  hvbox 2
-    ( opening $ force_break $ fmt_code content $ break 1 ~-2
-    $ output_or_closing )
+  (* The content might contain an indentation when it was not formatted. *)
+  hvbox 0
+    ( opening $ force_break
+    $ fmt_multiline_text content
+    $ space_break $ output_or_closing )
 
 and fmt_nestable_block_elements c elems =
   list_block_elem c elems (fmt_nestable_block_element c)
@@ -518,6 +526,8 @@ let fmt_tag c : tag -> _ = function
   | `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
+  | `Toc_status txt -> fmt_tag_args c "toc_status" ~txt
+  | `Order_category txt -> fmt_tag_args c "order_category" ~txt
   | `Short_title txt -> fmt_tag_args c "short_title" ~txt
 
 let fmt_block_element c elm =

test/passing/refs.ahrefs/doc.mld.ref

@@ -68,7 +68,7 @@ v}
 [foo.ml]
 
 {[
-  (** I'm foo, a page child to Doe *)
+(** I'm foo, a page child to Doe *)
 ]}
 
 {2 Compilation}

test/passing/refs.ahrefs/doc_repl.mld.ref

@@ -1,29 +1,26 @@
 Block delimiters should be on their own line:
 
 {[
-  let x = 1
+let x = 1
 ]}
 
 As of odoc 2.1, a block can carry metadata:
 
 {@ocaml[
-  let x = 2
+let x = 2
 ]}
 
 An OCaml block that should break:
 
 {[
-  let x = 2 in
-  x + x
+let x = 2 in
+x + x
 ]}
 
 A toplevel phrase with no output:
 
 {[
-  # let x = 2
-    and y = 3 in
-    x + y
-    ;;
+  # let x = 2 and y = 3 in x+y;;
 ]}
 
 A toplevel phrase with output:
@@ -38,10 +35,7 @@ Many toplevel phrases without output:
 {[
   # let x = 2;;
   # x + 2;;
-  # let x = 2
-    and y = 3 in
-    x + y
-    ;;
+  # let x = 2 and y = 3 in x+y;;
 ]}
 
 Many toplevel phrases with output:
@@ -51,10 +45,7 @@ Many toplevel phrases with output:
   val x : int = 2
   # x + 2;;
   - : int = 4
-  # let x = 2
-    and y = 3 in
-    x + y
-    ;;
+  # let x = 2 and y = 3 in x+y;;
 ]}
 
 Output are printed after a newline:
@@ -68,25 +59,22 @@ Output are printed after a newline:
 Excessive linebreaks are removed:
 
 {[
-  # let x = 2 in
-    x + 1
-    ;;
+  # let x = 2 in x+1;;
+
   output
-  # let y = 3 in
-    y + 1
-    ;;
+
+  # let y = 3 in y+1;;
 ]}
 
 Linebreak after `#`:
 
 {[
-  # let x = 2 in
-    x + 1
-    ;;
+  #
+    let x = 2 in x+1;;
 ]}
 
 Invalid toplevel phrase/ocaml block:
 {[
-  - : int =
-   4
+    - : int =
+     4
 ]}