From 5feb615e123599178965cbadd7fff660cc40c100 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Fri, 25 Aug 2023 11:04:35 +0200 Subject: [PATCH 1/3] replace omd with cmarkit --- builder-web.opam | 2 +- lib/dune | 2 +- lib/utils.ml | 104 --------------------------------------- lib/views.ml | 4 +- test/dune | 2 +- test/markdown_to_html.ml | 31 ++++++------ 6 files changed, 20 insertions(+), 125 deletions(-) diff --git a/builder-web.opam b/builder-web.opam index 75ac81c..6417594 100644 --- a/builder-web.opam +++ b/builder-web.opam @@ -45,7 +45,7 @@ depends: [ "cmdliner" {>= "1.1.0"} "uri" "fmt" {>= "0.8.7"} - "omd" {>= "2.0.0~alpha3"} + "cmarkit" "tar" "owee" "solo5-elftool" {>= "0.3.0"} diff --git a/lib/dune b/lib/dune index c0fab85..654f735 100644 --- a/lib/dune +++ b/lib/dune @@ -11,7 +11,7 @@ caqti-lwt opamdiff ptime.clock.os - omd + cmarkit tar owee solo5-elftool diff --git a/lib/utils.ml b/lib/utils.ml index 57cc779..142718d 100644 --- a/lib/utils.ml +++ b/lib/utils.ml @@ -45,110 +45,6 @@ let compare_pkgs p1 p2 = in diff_map (parse_pkgs p1) (parse_pkgs p2) -module Omd = struct - - let make_safe omd = - let rec safe_block = function - | Omd.Paragraph (attr, inline) -> - safe_inline inline - |> Option.map (fun inline -> Omd.Paragraph (attr, inline)) - | Omd.List (attr, typ, spacing, blocks) -> - let blocks = List.filter_map (fun b -> - let b = List.filter_map safe_block b in - if b = [] then None else Some b) - blocks - in - if blocks = [] then None else - Some (Omd.List (attr, typ, spacing, blocks)) - | Omd.Blockquote (attr, blocks) -> - let blocks = List.filter_map safe_block blocks in - if blocks = [] then None else - Some (Omd.Blockquote (attr, blocks)) - | Omd.Heading (attr, level, inline) -> - safe_inline inline - |> Option.map (fun inline -> Omd.Heading (attr, level, inline)) - | Omd.Html_block _ -> None - | Omd.Definition_list (attr, def_elts) -> - let def_elts = List.filter_map safe_def_elts def_elts in - if def_elts = [] then None else - Some (Omd.Definition_list (attr, def_elts)) - | Omd.Code_block _ - | Omd.Thematic_break _ as v -> Some v - | Omd.Table (attr, header_row, rows) -> - let header_row = - List.fold_left (fun acc (cell, alignment) -> - match acc with - | None -> None - | Some xs -> - Option.map (fun cell -> xs @ [ cell, alignment ]) - (safe_inline cell)) - (Some []) header_row - in - Option.map - (fun header_row -> - let rows = - List.filter_map (fun row -> - List.fold_left (fun acc cell -> - match acc with - | None -> None - | Some xs -> Option.map (fun cell -> xs @ [ cell ]) - (safe_inline cell)) - (Some []) row) - rows - in - Omd.Table (attr, header_row, rows)) - header_row - and safe_def_elts { term ; defs } = - let defs = List.filter_map safe_inline defs in - safe_inline term - |> Option.map (fun term -> { Omd.term ; defs }) - and safe_inline = function - | Concat (attr, inline) -> - Some (Concat (attr, List.filter_map safe_inline inline)) - | Emph (attr, inline) -> - safe_inline inline - |> Option.map (fun inline -> Omd.Emph (attr, inline)) - | Strong (attr, inline) -> - safe_inline inline - |> Option.map (fun inline -> Omd.Strong (attr, inline)) - | Link (attr, link) -> - begin match safe_link link with - | `No_label | `Relative -> safe_inline link.Omd.label - | `Link l -> Some (Omd.Link (attr, l)) - end - | Image (attr, link) -> - begin match safe_link link with - | `No_label | `Relative -> None - | `Link l -> Some (Omd.Image (attr, l)) - end - | Html _ -> None - | Text _ - | Code _ - | Hard_break _ - | Soft_break _ as v -> Some v - and safe_link ({ label ; destination ; _ } as l) = - let absolute_link = - String.(length destination >= 2 && equal (sub destination 0 2) "//") || - String.(length destination >= 7 && equal (sub destination 0 7) "http://") || - String.(length destination >= 8 && equal (sub destination 0 8) "https://") - in - if absolute_link then - match safe_inline label with - | None -> `No_label - | Some label -> `Link { l with label } - else - `Relative - in - List.filter_map safe_block omd - - let html_of_string markdown = - markdown - |> Omd.of_string - |> make_safe - |> Omd.to_html - -end - module Path = struct let to_url ~path ~queries = diff --git a/lib/views.ml b/lib/views.ml index eb285f6..61ee7c9 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -285,7 +285,7 @@ have questions or suggestions. let make_header = [ - H.Unsafe.data (Utils.Omd.html_of_string data); + H.Unsafe.data (Cmarkit_html.of_doc ~safe:true (Cmarkit.Doc.of_string ~heading_auto_ids:true data)); H.form ~a:H.[a_action "/hash"; a_method `Get] [ H.label [ H.txt "Search artifact by SHA256"; @@ -383,7 +383,7 @@ module Job = struct [ H.h2 ~a:H.[a_id "readme"] [H.txt "README"]; H.a ~a:H.[a_href "#builds"] [H.txt "Skip to builds"]; - H.Unsafe.data (Utils.Omd.html_of_string data) + H.Unsafe.data (Cmarkit_html.of_doc ~safe:true (Cmarkit.Doc.of_string ~heading_auto_ids:true data)) ] ) diff --git a/test/dune b/test/dune index b854a8d..704dc18 100644 --- a/test/dune +++ b/test/dune @@ -6,7 +6,7 @@ (test (name markdown_to_html) (modules markdown_to_html) - (libraries builder_web alcotest)) + (libraries builder_web cmarkit alcotest)) (test (name router) diff --git a/test/markdown_to_html.ml b/test/markdown_to_html.ml index e9c3b17..c3a2c76 100644 --- a/test/markdown_to_html.ml +++ b/test/markdown_to_html.ml @@ -1,14 +1,14 @@ -let markdown_to_html = Builder_web__Utils.Omd.html_of_string +let markdown_to_html data = Cmarkit_html.of_doc ~safe:true (Cmarkit.Doc.of_string ~heading_auto_ids:true data) let test_simple () = let markdown = {|# Hello world|} in let html = markdown_to_html markdown in - Alcotest.(check string "simple html" "

Hello world

\n" html) + Alcotest.(check string "simple html" "

Hello world

\n" html) let test_html_script () = let markdown = {|# |} in let html = markdown_to_html markdown in - Alcotest.(check string "html script header" "

Hello world

\n" html) + Alcotest.(check string "html script header" "

Hello world

\n" html) let test_preserve_span_content () = let markdown = {|* My ref @@ -16,10 +16,8 @@ let test_preserve_span_content () = let html = markdown_to_html markdown in Alcotest.(check string "html span content preserved" {| |} html) @@ -27,20 +25,21 @@ let test_preserve_span_content () = let test_remove_script () = let markdown = {||} in let html = markdown_to_html markdown in - Alcotest.(check string "html script removed" "" html) + Alcotest.(check string "html script removed" "\n" html) let test_list_with_html_block_and_markdown () = let markdown = "*
Hello, World!
*this is not html*" in let html = markdown_to_html markdown in Alcotest.(check string "list with html block and markdown" - (*"\n"*) "" + (*"\n"*) + "\n" html) let test_list_with_inline_html_and_markdown () = let markdown = "* Hello, World! *this is not html*" in let html = markdown_to_html markdown in Alcotest.(check string "list with html block and markdown" - "\n" + "\n" html) let test_absolute_link () = @@ -51,35 +50,35 @@ let test_absolute_link () = let test_relative_link () = let markdown = "[foo](../foo.jpg)" in let html = markdown_to_html markdown in - Alcotest.(check string "relative link" "

foo

\n" html) + Alcotest.(check string "relative link" "

foo

\n" html) let test_absolute_image () = let markdown = "![alttext](https://foo.com/bar.jpg)" in let html = markdown_to_html markdown in Alcotest.(check string "absolute image" - "

\"alttext\"

\n" html) + "

\"alttext\"

\n" html) let test_absolute_image_no_alt () = let markdown = "![](https://foo.com/bar.jpg)" in let html = markdown_to_html markdown in Alcotest.(check string "absolute image" - "

\"\"

\n" html) + "

\"\"

\n" html) let test_relative_image () = let markdown = "![](/bar.jpg)" in let html = markdown_to_html markdown in - Alcotest.(check string "relative image" "" html) + Alcotest.(check string "relative image" "

\"\"

\n" html) let test_absolute_image_script_alt () = let markdown = "![](https://foo.com/bar.jpg)" in let html = markdown_to_html markdown in Alcotest.(check string "absolute image with script alt text" - "

\"\"

\n" html) + "

\"\"

\n" html) let test_fragment_link () = let markdown = "[fragment](#fragment)" in let html = markdown_to_html markdown in - Alcotest.(check string "fragment link" "

fragment

\n" html) + Alcotest.(check string "fragment link" "

fragment

\n" html) let markdown_tests = [ Alcotest.test_case "Simple" `Quick test_simple; From 1293e081c6711009f4993da8ffd7b8136dca9c38 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Fri, 25 Aug 2023 11:32:17 +0200 Subject: [PATCH 2/3] Adjust heading from README to at least level 2 (fixes #164) --- lib/utils.ml | 24 ++++++++++++++++++++++++ lib/views.ml | 4 ++-- test/markdown_to_html.ml | 2 +- 3 files changed, 27 insertions(+), 3 deletions(-) diff --git a/lib/utils.ml b/lib/utils.ml index 142718d..de7062a 100644 --- a/lib/utils.ml +++ b/lib/utils.ml @@ -45,6 +45,30 @@ let compare_pkgs p1 p2 = in diff_map (parse_pkgs p1) (parse_pkgs p2) +let md_to_html ?adjust_heading ?(safe = true) data = + let open Cmarkit in + let doc = Doc.of_string ~heading_auto_ids:true data in + let doc = + Option.fold ~none:doc + ~some:(fun lvl -> + let block _m = function + | Block.Heading (h, meta) -> + let open Block.Heading in + let level = level h + and id = id h + and layout = layout h + and inline = inline h + in + let h' = make ?id ~layout ~level:(level + lvl) inline in + Mapper.ret (Block.Heading (h', meta)) + | _ -> Mapper.default + in + let mapper = Mapper.make ~block () in + Mapper.map_doc mapper doc) + adjust_heading + in + Cmarkit_html.of_doc ~safe doc + module Path = struct let to_url ~path ~queries = diff --git a/lib/views.ml b/lib/views.ml index 61ee7c9..a800402 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -285,7 +285,7 @@ have questions or suggestions. let make_header = [ - H.Unsafe.data (Cmarkit_html.of_doc ~safe:true (Cmarkit.Doc.of_string ~heading_auto_ids:true data)); + H.Unsafe.data (Utils.md_to_html data); H.form ~a:H.[a_action "/hash"; a_method `Get] [ H.label [ H.txt "Search artifact by SHA256"; @@ -383,7 +383,7 @@ module Job = struct [ H.h2 ~a:H.[a_id "readme"] [H.txt "README"]; H.a ~a:H.[a_href "#builds"] [H.txt "Skip to builds"]; - H.Unsafe.data (Cmarkit_html.of_doc ~safe:true (Cmarkit.Doc.of_string ~heading_auto_ids:true data)) + H.Unsafe.data (Utils.md_to_html ~adjust_heading:2 data) ] ) diff --git a/test/markdown_to_html.ml b/test/markdown_to_html.ml index c3a2c76..19bb825 100644 --- a/test/markdown_to_html.ml +++ b/test/markdown_to_html.ml @@ -1,4 +1,4 @@ -let markdown_to_html data = Cmarkit_html.of_doc ~safe:true (Cmarkit.Doc.of_string ~heading_auto_ids:true data) +let markdown_to_html = Builder_web__Utils.md_to_html let test_simple () = let markdown = {|# Hello world|} in From 4222f151626d36cea809e471cc074f9ef6cd397a Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Sat, 9 Sep 2023 10:35:24 +0200 Subject: [PATCH 3/3] add test for heading adjustment --- test/markdown_to_html.ml | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/test/markdown_to_html.ml b/test/markdown_to_html.ml index 19bb825..950af28 100644 --- a/test/markdown_to_html.ml +++ b/test/markdown_to_html.ml @@ -80,6 +80,30 @@ let test_fragment_link () = let html = markdown_to_html markdown in Alcotest.(check string "fragment link" "

fragment

\n" html) +let test_heading_adjustment () = + let markdown = {|# foo +## bar +# baz +## bazbar +### bazbarbar +#### bazbarbarbar +##### bazbarbarbarbar +###### bazbarbarbarbarbar +|} + in + let html = markdown_to_html ~adjust_heading:2 markdown in + (* NB: the maximum heading is 6 in cmarkit, thus we reduce the structure *) + let exp = {|

foo

+

bar

+

baz

+

bazbar

+
bazbarbar
+
bazbarbarbar
+
bazbarbarbarbar
+
bazbarbarbarbarbar
+|} in + Alcotest.(check string "header adjustment works fine" exp html) + let markdown_tests = [ Alcotest.test_case "Simple" `Quick test_simple; Alcotest.test_case "script header" `Quick test_html_script; @@ -94,6 +118,7 @@ let markdown_tests = [ Alcotest.test_case "relative image" `Quick test_relative_image; Alcotest.test_case "absolute image with script alt" `Quick test_absolute_image_script_alt; Alcotest.test_case "fragment link" `Quick test_fragment_link; + Alcotest.test_case "heading adjustment" `Quick test_heading_adjustment; ] let () =