From c43b4de2eb0823399f8c958f2c641bb912394e44 Mon Sep 17 00:00:00 2001 From: Lukasz Stafiniak Date: Fri, 22 Dec 2023 09:42:57 +0100 Subject: [PATCH 1/3] Output frames as div borders in HTML --- src/printbox-html/PrintBox_html.ml | 4 ++-- test/dune | 15 +++++++++++++-- test/test_html.expected | 2 ++ test/test_html.ml | 15 +++++++++++++++ 4 files changed, 32 insertions(+), 4 deletions(-) create mode 100644 test/test_html.expected create mode 100644 test/test_html.ml diff --git a/src/printbox-html/PrintBox_html.ml b/src/printbox-html/PrintBox_html.ml index 29722a1..066d065 100644 --- a/src/printbox-html/PrintBox_html.ml +++ b/src/printbox-html/PrintBox_html.ml @@ -99,8 +99,8 @@ let to_html_rec ~config (b: B.t) = | 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.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=_} -> diff --git a/test/dune b/test/dune index 99cccfe..fa32379 100644 --- a/test/dune +++ 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))) diff --git a/test/test_html.expected b/test/test_html.expected new file mode 100644 index 0000000..d42b27f --- /dev/null +++ b/test/test_html.expected @@ -0,0 +1,2 @@ +
root
  • child 1
  • child 2
    • header 3
      • subchild 3
    • header 4
      • subchild 4
  • child 5
+ diff --git a/test/test_html.ml b/test/test_html.ml new file mode 100644 index 0000000..8c842dd --- /dev/null +++ b/test/test_html.ml @@ -0,0 +1,15 @@ +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") [frame @@ text "subchild 4"] + ]; + frame @@ text "child 5" + ] + +let () = print_endline @@ PrintBox_html.to_string b From f18d6b52f44164315ce1da7b56bbd277fdd135df Mon Sep 17 00:00:00 2001 From: Lukasz Stafiniak Date: Fri, 22 Dec 2023 10:31:20 +0100 Subject: [PATCH 2/3] HTML: Allow frames in the summary / tree header --- src/printbox-html/PrintBox_html.ml | 32 ++++++++++++++++++++---------- 1 file changed, 22 insertions(+), 10 deletions(-) diff --git a/src/printbox-html/PrintBox_html.ml b/src/printbox-html/PrintBox_html.ml index 066d065..798de8c 100644 --- a/src/printbox-html/PrintBox_html.ml +++ b/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.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.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 From 3a317c371716a1e1221f2f7801f2c4b7da9438bd Mon Sep 17 00:00:00 2001 From: Lukasz Stafiniak Date: Fri, 22 Dec 2023 12:42:48 +0100 Subject: [PATCH 3/3] Test html folding --- test/test_html.expected | 2 +- test/test_html.ml | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/test/test_html.expected b/test/test_html.expected index d42b27f..9fc9624 100644 --- a/test/test_html.expected +++ b/test/test_html.expected @@ -1,2 +1,2 @@ -
root
  • child 1
  • child 2
    • header 3
      • subchild 3
    • header 4
      • subchild 4
  • child 5
+
root
  • child 1
  • child 2
    • header 3
      • subchild 3
    • header 4
      • subchild 4
  • header 5
    • subchild 5
  • child 5
diff --git a/test/test_html.ml b/test/test_html.ml index 8c842dd..195dcdd 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -7,9 +7,10 @@ let b = tree (frame @@ text "header 3") [frame @@ text "subchild 3"] ]; tree empty [ - tree (frame @@ text "header 4") [frame @@ text "subchild 4"] + 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 b +let () = print_endline @@ PrintBox_html.(to_string ~config:Config.(tree_summary true default)) b