Port struct to oymarkit

dune-project

@@ -23,7 +23,7 @@
  (depends
   ocaml
   (dune
-   (>= 3.21))
+   (>= 3.22))
   oymarkit
   core
   yaml
@@ -41,7 +41,7 @@
  (depends
   ocaml
   (dune
-   (>= 3.21))
+   (>= 3.22))
   oystermark-core
   oymarkit
   core
@@ -74,7 +74,7 @@
   (depends
   ocaml
   (dune
-    (>= 3.21))
+    (>= 3.22))
   core
   opentelemetry
   trace

pkg/oystermark/lib/component/html.ml

@@ -457,6 +457,87 @@ let render_struct
   C.string c "</div>\n</div>\n"
 ;;
 
+(* List-item body rendering for non-keyed items inside a mixed keyed list.
+   [Cmarkit_html] does not expose its list-item helper, and once oystermark
+   handles a list for semantic keyed markup it must emit every [<li>] itself.
+   Nested blocks still go through [C.block], so nested keyed lists compose. *)
+let rec item_block ~(tight : bool) c : Block.t -> unit = function
+  | Block.Blank_line _ -> ()
+  | Block.Ext_keyed _ as b -> item_block ~tight c (Struct.unkey b)
+  | Block.Paragraph (p, _) when tight -> C.inline c (Block.Paragraph.inline p)
+  | Block.Blocks (bs, _) ->
+    let rec loop add_nl = function
+      | Block.Blank_line _ :: bs -> loop add_nl bs
+      | Block.Paragraph (p, _) :: bs when tight ->
+        C.inline c (Block.Paragraph.inline p);
+        loop true bs
+      | b :: bs ->
+        if add_nl then C.byte c '\n';
+        C.block c b;
+        loop false bs
+      | [] -> ()
+    in
+    loop true bs
+  | b ->
+    C.byte c '\n';
+    C.block c b
+;;
+
+let list_has_keyed (l : Block.List'.t) : bool =
+  List.exists (Block.List'.items l) ~f:(fun (item, _) ->
+    match Block.List_item.block item with
+    | Block.Ext_keyed _ -> true
+    | _ -> false)
+;;
+
+let keyed_list_item ~(style : struct_style) ~(tight : bool) c (item, _) =
+  let render_body () =
+    match Block.List_item.block item with
+    | Block.Ext_keyed ((label, body), _) ->
+      C.byte c '\n';
+      render_struct ~style `List_item c (Struct.label_key label) body
+    | b -> item_block ~tight c b
+  in
+  C.string c "<li>";
+  match Block.List_item.ext_task_marker item with
+  | None ->
+    render_body ();
+    C.string c "</li>\n"
+  | Some (mark, _) ->
+    let close =
+      match Block.List_item.task_status_of_task_marker mark with
+      | `Unchecked ->
+        C.string c "<div class=\"task\"><input type=\"checkbox\" disabled><div>";
+        "</div></div></li>\n"
+      | `Checked | `Other _ ->
+        C.string
+          c
+          "<div class=\"task\"><input type=\"checkbox\" disabled checked><div>";
+        "</div></div></li>\n"
+      | `Cancelled ->
+        C.string c "<div class=\"task\"><input type=\"checkbox\" disabled><del>";
+        "</del></div></li>\n"
+    in
+    render_body ();
+    C.string c close
+;;
+
+(* Render a list that contains keyed items. Plain lists are left to
+   [Cmarkit_html.renderer], but a mixed keyed list needs positional control so a
+   keyed list item can become semantic HTML inside its own [<li>]. *)
+let render_keyed_list ~(style : struct_style) c (l : Block.List'.t) =
+  let tight = Block.List'.tight l in
+  let opening, closing =
+    match Block.List'.type' l with
+    | `Unordered _ -> "<ul>\n", "</ul>\n"
+    | `Ordered (start, _) ->
+      (if start = 1 then "<ol>\n" else sprintf "<ol start=\"%d\">\n" start), "</ol>\n"
+  in
+  C.string c opening;
+  List.iter (Block.List'.items l) ~f:(keyed_list_item ~style ~tight c);
+  C.string c closing
+;;
+
 (** Render a block, optionally carrying a Djot [attr] from an enclosing
     {!Cmarkit.Block.Ext_attributes} wrapper. Returns [false] (defer) for
     blocks that need no oystermark-specific handling and no attribute. *)
@@ -558,11 +639,14 @@ let render_block
        struct_style := prev);
     C.string c "</div>\n";
     true
-  | Parse.Struct.Ext_keyed_block (({ label }, body), _) ->
-    render_struct ~style:!struct_style `Paragraph c label body;
+  | Cmarkit.Block.Ext_keyed ((label, body), _) ->
+    (* A keyed node reached here is a {e free} block (a top-level keyed node, or
+       the body of another keyed node). A keyed node that is a list item's block
+       is handled positionally by [render_keyed_list], not here. *)
+    render_struct ~style:!struct_style `Paragraph c (Struct.label_key label) body;
     true
-  | Parse.Struct.Ext_keyed_list_item (({ label }, body), _) ->
-    render_struct ~style:!struct_style `List_item c label body;
+  | Block.List (l, _) when list_has_keyed l ->
+    render_keyed_list ~style:!struct_style c l;
     true
   | Block.Blocks (blocks, meta) ->
     (match Meta.find Embed.embed_meta_key meta with
@@ -636,27 +720,29 @@ module For_test = struct
       doc
   ;;
 
-  let pp_doc struct_style doc = html_of_doc struct_style doc |> print_string
+  let pp_doc struct_style ppf doc =
+    html_of_doc struct_style doc |> Format.pp_print_string ppf
+  ;;
 end
 
 let%expect_test "block attribute on paragraph" =
   let open For_test in
   let doc = Parse.of_string "{#water .important key=\"my val\"}\nDon't forget!" in
-  pp_doc `Plain doc;
+  Format.printf "%a%!" (pp_doc `Plain) doc;
   [%expect {| <p id="water" class="important" key="my val">Don't forget!</p> |}]
 ;;
 
 let%expect_test "block attribute on heading combines with slug; attr id wins" =
   let open For_test in
   let doc = Parse.of_string "{#custom .big}\n# Hello world" in
-  pp_doc `Plain doc;
+  Format.printf "%a%!" (pp_doc `Plain) doc;
   [%expect {| <h1 id="custom" class="big">Hello world</h1> |}]
 ;;
 
 let%expect_test "block attribute on blockquote" =
   let open For_test in
   let doc = Parse.of_string "{source=\"Iliad\"}\n> Sing, muse" in
-  pp_doc `Plain doc;
+  Format.printf "%a%!" (pp_doc `Plain) doc;
   [%expect
     {|
     <blockquote source="Iliad">
@@ -669,7 +755,7 @@ let%expect_test "code block pandoc attribute renders as data-attr-*" =
   let open For_test in
   let src = "```python {#snippet .runnable timeout=30}\nprint('hi')\n```" in
   let doc = Parse.of_string src in
-  pp_doc `Plain doc;
+  Format.printf "%a%!" (pp_doc `Plain) doc;
   [%expect
     {|
     <pre><code class="language-python" data-attr-id="snippet" data-attr-class="runnable" data-attr-timeout="30">print('hi')
@@ -681,7 +767,7 @@ let%expect_test "orphan block attribute emits no HTML" =
   let open For_test in
   (* Orphan attribute paragraph (followed by blank line, no target) *)
   let doc = Parse.of_string "{#orphan}\n\nA paragraph." in
-  pp_doc `Plain doc;
+  Format.printf "%a%!" (pp_doc `Plain) doc;
   [%expect {| <p>A paragraph.</p> |}]
 ;;
 
@@ -705,7 +791,7 @@ Single:
 |}
   in
   let doc = Parse.of_string src in
-  pp_doc `Plain doc;
+  Format.printf "%a%!" (pp_doc `Plain) doc;
   [%expect
     {|
     <div class="keyed" data-label-kind="paragraph" data-style="plain" data-body="list"><span class="keyed-label">Architecture</span>
@@ -810,13 +896,13 @@ let%test_module "don't throw" =
       let examples : string list =
         List.concat
           [ List.map ~f:(fun ex -> ex.content) Parse.Struct.For_test.examples
-          ; (* div smoke-test inputs (divs are now parsed natively by the fork) *)
+          ; (* div smoke-test inputs *)
             [ "::: warning\nbody\n:::"
             ; ":::: outer\n::: inner\ncontent\n:::\n::::"
             ; "::: warning\nunclosed content"
             ; "- foo:\n::: warning\ncontent\n:::\n- bar"
             ]
-          ; (* callout smoke-test inputs (callout is now parsed natively by the fork) *)
+          ; (* callout smoke-test inputs *)
             [ "> [!info] Here's a callout title"
             ; "> [!tip]"
             ; "> [!faq]- Are callouts foldable?"

pkg/oystermark/lib/parse/cb_attribute.ml

@@ -160,20 +160,20 @@ let%test_module "Doc" =
     open For_test
 
     let doc_of_string s = mk_doc_of_string ~block:block_map () s
-    let pp_doc doc = mk_pp_doc ~metas:[ sexp_of_meta ] () doc
+    let pp_doc ppf doc = mk_pp_doc ~metas:[ sexp_of_meta ] () ppf doc
 
     let%expect_test _ =
       let doc = doc_of_string example_no_attribute in
       [%test_result: int] (count_attr doc) ~expect:0;
-      pp_doc doc;
+      Format.printf "%a%!" pp_doc doc;
       [%expect
         {| ((Code_block python II) (meta (attribute ((lang python) (attribute ()))))) |}]
     ;;
 
     let%expect_test _ =
       let doc = doc_of_string example_with_attribute in
       [%test_result: int] (count_attr doc) ~expect:1;
-      pp_doc doc;
+      Format.printf "%a%!" pp_doc doc;
       [%expect
         {|
         ((Code_block "python {#myid .class_a .class_b key1=val1 key2=\"val2\"}" II)
@@ -191,7 +191,7 @@ let%test_module "Doc" =
     let%expect_test _ =
       let doc = doc_of_string example_multiple_ids_override in
       [%test_result: int] (count_attr doc) ~expect:1;
-      pp_doc doc;
+      Format.printf "%a%!" pp_doc doc;
       [%expect
         {|
         ((Code_block
@@ -208,7 +208,7 @@ let%test_module "Doc" =
     let%expect_test _ =
       let doc = doc_of_string non_example_invalid_item in
       [%test_result: int] (count_attr doc) ~expect:0;
-      pp_doc doc;
+      Format.printf "%a%!" pp_doc doc;
       [%expect
         {|
         ((Code_block "python {#myid .class_a .class_b hi}" II)
@@ -219,7 +219,7 @@ let%test_module "Doc" =
     let%expect_test _ =
       let doc = doc_of_string non_example_no_info_string in
       [%test_result: int] (count_attr doc) ~expect:0;
-      pp_doc doc;
+      Format.printf "%a%!" pp_doc doc;
       [%expect {| (Code_block "{#myid .class_a .class_b}" II) |}]
     ;;
 

pkg/oystermark/lib/parse/common.ml

@@ -295,9 +295,9 @@ module For_test = struct
     doc'
   ;;
 
-  let mk_pp_doc ?inlines ?blocks ?metas () doc =
+  let mk_pp_doc ?inlines ?blocks ?metas () ppf doc =
     (make_sexp_of ?inlines ?blocks ?metas ()).doc doc
     |> Sexp.to_string_hum ~indent:2
-    |> print_endline
+    |> Format.fprintf ppf "%s@\n"
   ;;
 end

pkg/oystermark/lib/parse/frontmatter.ml

@@ -130,15 +130,15 @@ let of_doc (doc : Cmarkit.Doc.t) : Yaml.value option =
 ;;
 
 module For_test = struct
-  let pp_yaml (v : t option) : string =
+  let to_string (v : t option) : string =
     match v with
     | None -> "<none>"
     | Some v -> Yaml.to_string_exn v
   ;;
 
   let%expect_test "no frontmatter" =
     let yaml, body = of_string "# Hello\n\nSome text" in
-    Printf.printf "yaml: %s\nbody: %s\n" (pp_yaml yaml) body;
+    Printf.printf "yaml: %s\nbody: %s\n" (to_string yaml) body;
     [%expect
       {|
     yaml: <none>
@@ -152,7 +152,7 @@ module For_test = struct
     let yaml, body =
       of_string "---\ntitle: Hello\ntags: [a, b]\n---\n# Hello\n\nSome text"
     in
-    Printf.printf "yaml: %sbody: %s\n" (pp_yaml yaml) body;
+    Printf.printf "yaml: %sbody: %s\n" (to_string yaml) body;
     [%expect
       {|
     yaml: title: Hello
@@ -167,7 +167,7 @@ module For_test = struct
 
   let%expect_test "unclosed frontmatter" =
     let yaml, body = of_string "---\ntitle: Hello\nno closing" in
-    Printf.printf "yaml: %s\nbody: %s\n" (pp_yaml yaml) body;
+    Printf.printf "yaml: %s\nbody: %s\n" (to_string yaml) body;
     [%expect
       {|
     yaml: <none>
@@ -179,7 +179,7 @@ module For_test = struct
 
   let%expect_test "empty frontmatter" =
     let yaml, body = of_string "---\n---\n# Body" in
-    Printf.printf "yaml: %sbody: %s\n" (pp_yaml yaml) body;
+    Printf.printf "yaml: %sbody: %s\n" (to_string yaml) body;
     [%expect
       {|
     yaml: