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..de7062a 100644 --- a/lib/utils.ml +++ b/lib/utils.ml @@ -45,109 +45,29 @@ 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 +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 diff --git a/lib/views.ml b/lib/views.ml index eb285f6..a800402 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 (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 (Utils.Omd.html_of_string data) + H.Unsafe.data (Utils.md_to_html ~adjust_heading:2 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..950af28 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 = Builder_web__Utils.md_to_html let test_simple () = let markdown = {|# Hello world|} in let html = markdown_to_html markdown in - Alcotest.(check string "simple html" "
foo
\n" html) + Alcotest.(check string "relative link" "\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" - "\n" html) + "\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" "\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 = {|