Markdown backend: complete implementation

.github/workflows/gh-pages.yml

@@ -26,7 +26,7 @@ jobs:
         run: opam pin -n .
 
       - name: Depext
-        run: opam depext -yt printbox printbox-html printbox-text
+        run: opam depext -yt printbox printbox-html printbox-md printbox-text
 
       - name: Deps
         run: opam install -d . --deps-only

.github/workflows/main.yml

@@ -26,7 +26,7 @@ jobs:
         dune-cache: true
         allow-prerelease-opam: true
     - run: opam pin -n .
-    - run: opam depext -yt printbox printbox-html printbox-text
+    - run: opam depext -yt printbox printbox-html printbox-md printbox-text
     - run: opam install -t . --deps-only
     - run: opam exec -- dune build @all
     - run: opam exec -- dune runtest

README.md

@@ -259,7 +259,7 @@ an alternative solution where trees are printed in HTML using the
 # print_endline PrintBox_html.(to_string
   ~config:Config.(tree_summary true default)
     B.(tree (text "0")[text "1"; tree (text "ω") [text "ω²"]]));;
-<div><details><summary><span class="">0</span></summary><ul><li><span class="">1</span></li><li><details><summary><span class="">ω</span></summary><ul><li><span class="">ω²</span></li></ul></details></li></ul></details></div>
+<div><details><summary><span class="">0</span></summary><ul><li><div class="">1</div></li><li><details><summary><span class="">ω</span></summary><ul><li><div class="">ω²</div></li></ul></details></li></ul></details></div>
 
 - : unit = ()
 ```

dune-project

@@ -35,3 +35,15 @@ Printbox allows to print nested boxes, lists, arrays, tables in several formats"
            (odoc :with-test)
            (tyxml (>= 4.3))
            (mdx (and (>= 1.4) :with-test))))
+
+(package
+  (name printbox-md)
+(synopsis "Printbox Markdown rendering")
+(description "
+Adds Markdown output handling to the printbox package, with fallback to text and simplified HTML.
+Printbox allows to print nested boxes, lists, arrays, tables in several formats")
+  (depends (printbox (= :version))
+           (printbox-text (and (= :version)))
+           (printbox-html (and (= :version)))
+           (odoc :with-test)
+           (mdx (and (>= 1.4) :with-test))))

printbox-md.opam

@@ -0,0 +1,37 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+version: "0.8"
+synopsis: "Printbox Markdown rendering"
+description: """
+
+Adds Markdown output handling to the printbox package, with fallback to text and simplified HTML.
+Printbox allows to print nested boxes, lists, arrays, tables in several formats"""
+maintainer: ["c-cube"]
+authors: ["Simon Cruanes" "Guillaume Bury"]
+license: "BSD-2-Clause"
+homepage: "https://github.com/c-cube/printbox"
+bug-reports: "https://github.com/c-cube/printbox/issues"
+depends: [
+  "dune" {>= "3.0"}
+  "printbox" {= version}
+  "printbox-text" {= version}
+  "printbox-html" {= version}
+  "odoc" {with-test}
+  "mdx" {>= "1.4" & with-test}
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/c-cube/printbox.git"

src/printbox-html/PrintBox_html.ml

@@ -87,19 +87,33 @@ end
 
 let to_html_rec ~config (b: B.t) =
   let open Config in
-  let text_to_html ?(border=false) ~l ~style () =
+  let h_text_to_html ?(border=false) ~l ~style () =
     let a, bold = attrs_of_style style in
     let l = List.map H.txt l in
     let l = if bold then List.map (fun x->H.b [x]) l else l in
     let a_border = if border then [H.a_style  "border:thin solid"] else [] in
     H.span ~a:(H.a_class config.cls_text :: a_border @ (a @ config.a_text)) l in
+  let v_text_to_html ?(border=false) ~l ~style () =
+    let a, bold = attrs_of_style style in
+    let a_border = if border then [H.a_style  "border:thin solid"] else [] in
+    if style.B.Style.preformatted then
+      H.pre ~a:(H.a_class config.cls_text :: a_border @ (a @ config.a_text))
+        [H.txt @@ String.concat "\n" l]
+    else
+      (* TODO: remove possible trailing '\r' *)
+      let l = List.map H.txt @@ List.concat @@ List.map (String.split_on_char '\n') l in
+      let len = List.length l in
+      let l =
+        List.concat @@ List.mapi
+          (fun i x-> (if bold then H.b [x] else x) :: if i < len - 1 then [H.br ()] else []) l in
+      H.div ~a:(H.a_class config.cls_text :: a_border @ (a @ config.a_text)) l in
   let loop :
     'tags. (B.t -> ([< Html_types.flow5 > `Pre `Span `Div `Ul `Table `P] as 'tags) html) -> B.t -> 'tags html =
     fun fix b ->
       match B.view b with
       | B.Empty -> (H.div [] :> [< Html_types.flow5 > `Pre `Span `Div `P `Table `Ul ] html)
-      | B.Text {l; style} when style.B.Style.preformatted -> H.pre [text_to_html ~l ~style ()]
-      | B.Text {l; style} -> text_to_html ~l ~style ()
+      (* | B.Text {l; style} when style.B.Style.preformatted -> H.pre [h_text_to_html ~l ~style ()] *)
+      | B.Text {l; style} -> v_text_to_html ~l ~style ()
       | B.Pad (_, b) -> fix b
       | B.Frame b ->
          H.div ~a:[H.a_style "border:thin solid"] [ fix b ]
@@ -137,12 +151,12 @@ let to_html_rec ~config (b: B.t) =
       let l = Array.to_list l in
       (match B.view b with
       | B.Text {l=tl; style} ->
-        H.details (H.summary [text_to_html ~l:tl ~style ()])
+        H.details (H.summary [h_text_to_html ~l:tl ~style ()])
         [ H.ul (List.map (fun x -> H.li [to_html_rec x]) l) ]
       | B.Frame b ->
         (match B.view b with
         | (B.Text {l=tl; style}) ->
-          H.details (H.summary [text_to_html ~border:true ~l:tl ~style ()])
+          H.details (H.summary [h_text_to_html ~border:true ~l:tl ~style ()])
             [ H.ul (List.map (fun x -> H.li [to_html_rec x]) l) ]
         | _ ->
           H.div
@@ -159,6 +173,7 @@ let to_html_rec ~config (b: B.t) =
     | _ -> loop to_html_rec b
   and to_html_nondet_rec b =
     match B.view b with
+    | B.Text {l; style} -> v_text_to_html ~l ~style ()
     | B.Link {uri; inner} ->
       H.div [H.a ~a:[H.a_href uri] [to_html_nondet_rec inner]]
     | _ -> loop to_html_nondet_rec b
@@ -170,6 +185,15 @@ let to_html ?(config=Config.default) b = H.div [to_html_rec ~config b]
 let to_string ?config b =
   Format.asprintf "@[%a@]@." (H.pp_elt ()) (to_html ?config b)
 
+let to_string_indent ?config b =
+  Format.asprintf "@[%a@]@." (H.pp_elt ~indent:true ()) (to_html ?config b)
+
+let pp ?(flush=true) ?config ?indent () pp b =
+  if flush then
+    Format.fprintf pp "@[%a@]@." (H.pp_elt ?indent ()) (to_html ?config b)
+  else
+    Format.fprintf pp "@[%a@]" (H.pp_elt ?indent ()) (to_html ?config b)
+
 let to_string_doc ?config b =
   let meta_str = "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\">" in
   let footer_str =

src/printbox-html/PrintBox_html.mli

@@ -37,7 +37,12 @@ end
 val to_html : ?config:Config.t -> PrintBox.t -> [`Div] html
 (** HTML for one box *)
 
+val pp :
+  ?flush:bool -> ?config:Config.t -> ?indent:bool -> unit -> Format.formatter -> PrintBox.t -> unit
+
 val to_string : ?config:Config.t -> PrintBox.t -> string
 
+val to_string_indent : ?config:Config.t -> PrintBox.t -> string
+
 val to_string_doc : ?config:Config.t -> PrintBox.t -> string
 (** Same as {!to_string}, but adds the prelude and some footer *)