Merge pull request #32 from lukstafi/master

Support frames in the HTML output

Author: c-cube

src/printbox-html/PrintBox_html.ml

@@ -87,20 +87,22 @@ end
 
 let to_html_rec ~config (b: B.t) =
   let open Config in
-  let text_to_html ~l ~style =
+  let 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
-    H.span ~a:(H.a_class config.cls_text :: (a @ config.a_text)) 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 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.Pad (_, b)
-      | B.Frame b -> fix b
+      | 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.Pad (_, b) -> fix b
+      | B.Frame b ->
+         H.div ~a:[H.a_style "border:thin solid"] [ fix b ]
       | B.Align {h=`Right;inner=b;v=_} ->
         H.div ~a:[H.a_class ["align-right"]] [ fix b ]
       | B.Align {h=`Center;inner=b;v=_} ->
@@ -135,13 +137,23 @@ 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 [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.ul (List.map (fun x -> H.li [to_html_rec x]) l) ]
+        | _ ->
           H.div
-        [ to_html_rec b
-        ; H.ul (List.map (fun x -> H.li [to_html_rec x]) l)
-        ])
+            [ to_html_rec b
+            ; H.ul (List.map (fun x -> H.li [to_html_rec x]) l)
+            ])
+      | _ ->
+        H.div
+          [ to_html_rec b
+          ; H.ul (List.map (fun x -> H.li [to_html_rec x]) l)
+          ])
     | B.Link {uri; inner} ->
       H.div [H.a ~a:[H.a_href uri] [to_html_nondet_rec inner]]
     | _ -> loop to_html_rec b

test/dune

@@ -1,7 +1,7 @@
 
 (executables
-  (names test1 test_ann_0_3 test_blending)
-  (libraries printbox printbox-text))
+  (names test1 test_ann_0_3 test_blending test_html)
+  (libraries printbox printbox-text printbox-html))
 
 (rule
   (targets test1.output)
@@ -32,3 +32,14 @@
   (alias runtest)
   (package printbox-text)
   (action (diff test_blending.expected test_blending.output)))
+
+
+(rule
+  (targets test_html.output)
+  (package printbox-html)
+  (action (with-stdout-to %{targets} (run ./test_html.exe))))
+
+(rule
+  (alias runtest)
+  (package printbox-html)
+  (action (diff test_html.expected test_html.output)))

test/test_html.expected

@@ -0,0 +1,2 @@
+<div><details><summary><span class="" style="border:thin solid">root</span></summary><ul><li><div style="border:thin solid"><span class="">child 1</span></div></li><li><span class="">child 2</span></li><li><div style="border:thin solid"><div><div></div><ul><li><details><summary><span class="" style="border:thin solid">header 3</span></summary><ul><li><div style="border:thin solid"><span class="">subchild 3</span></div></li></ul></details></li></ul></div></div></li><li><div><div></div><ul><li><details><summary><span class="" style="border:thin solid">header 4</span></summary><ul><li><span class="">subchild 4</span></li></ul></details></li></ul></div></li><li><div style="border:thin solid"><details><summary><span class="">header 5</span></summary><ul><li><span class="">subchild 5</span></li></ul></details></div></li><li><div style="border:thin solid"><span class="">child 5</span></div></li></ul></details></div>
+

test/test_html.ml

@@ -0,0 +1,16 @@
+let b =
+  let open PrintBox in
+  tree (frame @@ text "root") [
+    frame @@ text "child 1";
+    text "child 2";
+    frame @@ tree empty [
+      tree (frame @@ text "header 3") [frame @@ text "subchild 3"]
+    ];
+    tree empty [
+      tree (frame @@ text "header 4") [text "subchild 4"]
+    ];
+    frame @@ tree (text "header 5") [text "subchild 5"];
+    frame @@ text "child 5"
+  ]
+
+let () = print_endline @@ PrintBox_html.(to_string ~config:Config.(tree_summary true default)) b