Format Odoc code block metadata fields (#1713)

* Format Odoc code block metadata fields

Since `odoc-parser.0.9.0`, Odoc's code blocks have a metadata field:

    (** {@metadata[
          ...
        ]} *)

Co-authored-by: Guillaume Petiot <[email protected]>

Author: Julow

CHANGES.md

@@ -48,7 +48,7 @@
 
   + Improve position of `;;` tokens (#1688, @gpetiot)
 
-  + Depend on `odoc-parser` instead of `odoc` (#1683, @kit-ty-kate, @jonludlam)
+  + Depend on `odoc-parser` instead of `odoc` (#1683, #1713, @kit-ty-kate, @jonludlam, @julow)
     The parser from odoc has been split from the main odoc package and put into its own package, `odoc-parser`.
 
 #### New features

lib/Fmt_odoc.ml

@@ -67,10 +67,17 @@ let fmt_verbatim_block s =
   in
   hvbox 0 (wrap "{v" "v}" content)
 
-let fmt_code_block conf _s1 s2 =
+let fmt_metadata s = str "@" $ str s
+
+let fmt_code_block conf s1 s2 =
+  let wrap_code x =
+    str "{"
+    $ opt s1 (ign_loc ~f:fmt_metadata)
+    $ fmt "[@;<1 2>" $ x $ fmt "@ ]}"
+  in
   let s2 = Odoc_parser.Loc.value s2 in
   match conf.fmt_code s2 with
-  | Ok formatted -> hvbox 0 (wrap "{[@;<1 2>" "@ ]}" formatted)
+  | Ok formatted -> hvbox 0 (wrap_code formatted)
   | Error () ->
       let fmt_line ~first ~last:_ l =
         let l = String.rstrip l in
@@ -80,7 +87,7 @@ let fmt_code_block conf _s1 s2 =
       in
       let lines = String.split_lines s2 in
       let box = match lines with _ :: _ :: _ -> vbox 0 | _ -> hvbox 0 in
-      box (wrap "{[@;<1 2>" "@ ]}" (vbox 0 (list_fl lines fmt_line)))
+      box (wrap_code (vbox 0 (list_fl lines fmt_line)))
 
 let fmt_code_span s = hovbox 0 (wrap "[" "]" (str (escape_brackets s)))
 

lib/Normalize.ml

@@ -63,6 +63,8 @@ let fpf = Format.fprintf
 
 let odoc_reference = ign_loc str
 
+let option f fmt = function Some v -> f fmt v | None -> ()
+
 let odoc_style fmt = function
   | `Bold -> fpf fmt "Bold"
   | `Italic -> fpf fmt "Italic"
@@ -94,7 +96,7 @@ and odoc_inline_elements fmt elems =
 
 let rec odoc_nestable_block_element c fmt = function
   | `Paragraph elms -> fpf fmt "Paragraph(%a)" odoc_inline_elements elms
-  | `Code_block (_, txt) ->
+  | `Code_block (metadata, txt) ->
       let txt = Odoc_parser.Loc.value txt in
       let txt =
         try
@@ -116,7 +118,7 @@ let rec odoc_nestable_block_element c fmt = function
             comments
         with _ -> txt
       in
-      fpf fmt "Code_block(%a)" str txt
+      fpf fmt "Code_block(%a, %a)" (option (ign_loc str)) metadata str txt
   | `Verbatim txt -> fpf fmt "Verbatim(%a)" str txt
   | `Modules mods -> fpf fmt "Modules(%a)" (list odoc_reference) mods
   | `List (ord, _syntax, items) ->

test/passing/tests/doc_comments-after.ml.ref

@@ -293,3 +293,17 @@ let _ = ()
 
 (** starts with linebreaks *)
 let a = 1
+
+(** {@metadata[ Code block with metadata field ]} *)
+
+(** {@some_tag[
+      Code block with metadata field. This is a big block that should hopefully break
+    ]} *)
+
+(** {@ocaml[
+      let _ =
+        f @@ {aaa= aaa bbb ccc; bbb= aaa bbb ccc; ccc= aaa bbb ccc}
+        >>= fun () ->
+        let _ = x in
+        f @@ g @@ h @@ fun x -> y
+    ]} *)

test/passing/tests/doc_comments-before-except-val.ml.ref

@@ -293,3 +293,17 @@ let _ = ()
 
 (** starts with linebreaks *)
 let a = 1
+
+(** {@metadata[ Code block with metadata field ]} *)
+
+(** {@some_tag[
+      Code block with metadata field. This is a big block that should hopefully break
+    ]} *)
+
+(** {@ocaml[
+      let _ =
+        f @@ {aaa= aaa bbb ccc; bbb= aaa bbb ccc; ccc= aaa bbb ccc}
+        >>= fun () ->
+        let _ = x in
+        f @@ g @@ h @@ fun x -> y
+    ]} *)

test/passing/tests/doc_comments-before.ml.ref

@@ -293,3 +293,17 @@ let _ = ()
 
 (** starts with linebreaks *)
 let a = 1
+
+(** {@metadata[ Code block with metadata field ]} *)
+
+(** {@some_tag[
+      Code block with metadata field. This is a big block that should hopefully break
+    ]} *)
+
+(** {@ocaml[
+      let _ =
+        f @@ {aaa= aaa bbb ccc; bbb= aaa bbb ccc; ccc= aaa bbb ccc}
+        >>= fun () ->
+        let _ = x in
+        f @@ g @@ h @@ fun x -> y
+    ]} *)

test/passing/tests/doc_comments.ml

@@ -289,3 +289,19 @@ let _ = ()
 starts with linebreaks
 *)
 let a = 1
+
+(** {@metadata[ Code block with metadata field ]} *)
+
+(** {@some_tag[ Code block with metadata field. This is a big block that should hopefully break ]} *)
+
+(** {@ocaml[
+      let _ =
+       f
+       @@
+       { aaa= aaa bbb ccc
+       ; bbb= aaa bbb ccc
+       ; ccc= aaa bbb ccc }
+       >>= fun () ->
+       let _ = x in
+       f @@ g @@ h @@ fun x -> y
+    ]} *)

test/passing/tests/doc_comments.ml.ref

@@ -293,3 +293,17 @@ let _ = ()
 
 (** starts with linebreaks *)
 let a = 1
+
+(** {@metadata[ Code block with metadata field ]} *)
+
+(** {@some_tag[
+      Code block with metadata field. This is a big block that should hopefully break
+    ]} *)
+
+(** {@ocaml[
+      let _ =
+        f @@ {aaa= aaa bbb ccc; bbb= aaa bbb ccc; ccc= aaa bbb ccc}
+        >>= fun () ->
+        let _ = x in
+        f @@ g @@ h @@ fun x -> y
+    ]} *)