From bfdb7d322349bf6db8109863192248ae807edc8a Mon Sep 17 00:00:00 2001 From: Lukasz Stafiniak Date: Fri, 16 Feb 2024 16:34:54 +0100 Subject: [PATCH 1/4] Provide context for the `line` exception --- src/PrintBox.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/PrintBox.ml b/src/PrintBox.ml index 6e90767..b02e421 100644 --- a/src/PrintBox.ml +++ b/src/PrintBox.ml @@ -65,7 +65,7 @@ let[@inline] view (t : t) : view = t let[@inline] line_ s = Text { l = [ s ]; style = Style.default } let line_with_style style s = - if String.contains s '\n' then invalid_arg "PrintBox.line"; + if String.contains s '\n' then invalid_arg @@ "PrintBox.line: " ^ s; Text { l = [ s ]; style } let line s = line_with_style Style.default s From 669feb0da73ef1c52b5b674bedc9cba12169b64d Mon Sep 17 00:00:00 2001 From: Lukasz Stafiniak Date: Sat, 17 Feb 2024 20:57:08 +0100 Subject: [PATCH 2/4] More compact html output: no empty class annotations --- src/printbox-html/PrintBox_html.ml | 21 ++++++++---- src/printbox-md/README.md | 54 +++++++++++------------------- 2 files changed, 34 insertions(+), 41 deletions(-) diff --git a/src/printbox-html/PrintBox_html.ml b/src/printbox-html/PrintBox_html.ml index 743419c..aac88f5 100644 --- a/src/printbox-html/PrintBox_html.ml +++ b/src/printbox-html/PrintBox_html.ml @@ -62,6 +62,12 @@ let attrs_of_style (s : B.Style.t) : _ list * _ = in a, bold +let a_class l = + if List.exists (fun s -> s <> "") l then + [ H.a_class l ] + else + [] + module Config = struct type t = { cls_table: string list; @@ -116,7 +122,7 @@ let to_html_rec ~config (b : B.t) = else [] in - H.span ~a:((H.a_class config.cls_text :: a_border) @ a @ config.a_text) l + H.span ~a:(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 @@ -128,7 +134,7 @@ let to_html_rec ~config (b : B.t) = in if style.B.Style.preformatted then H.pre - ~a:((H.a_class config.cls_text :: a_border) @ a @ config.a_text) + ~a:(a_class config.cls_text @ a_border @ a @ config.a_text) [ H.txt @@ String.concat "\n" l ] else ( (* TODO: remove possible trailing '\r' *) @@ -151,7 +157,7 @@ let to_html_rec ~config (b : B.t) = [])) l in - H.div ~a:((H.a_class config.cls_text :: a_border) @ a @ config.a_text) l + H.div ~a:(a_class config.cls_text @ a_border @ a @ config.a_text) l ) in let loop @@ -164,7 +170,8 @@ let to_html_rec ~config (b : B.t) = 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 [h_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 ] @@ -182,11 +189,11 @@ let to_html_rec ~config (b : B.t) = let to_row a = Array.to_list a |> List.map (fun b -> - H.td ~a:(H.a_class config.cls_col :: config.a_col) [ fix b ]) - |> fun x -> H.tr ~a:(H.a_class config.cls_row :: config.a_row) x + H.td ~a:(a_class config.cls_col @ config.a_col) [ fix b ]) + |> fun x -> H.tr ~a:(a_class config.cls_row @ config.a_row) x in let rows = Array.to_list a |> List.map to_row in - H.table ~a:(H.a_class (class_ :: config.cls_table) :: config.a_table) rows + H.table ~a:(a_class (class_ :: config.cls_table) @ config.a_table) rows | B.Tree (_, b, l) -> let l = Array.to_list l in H.div [ fix b; H.ul (List.map (fun x -> H.li [ fix x ]) l) ] diff --git a/src/printbox-md/README.md b/src/printbox-md/README.md index fb0b222..eb80a5e 100644 --- a/src/printbox-md/README.md +++ b/src/printbox-md/README.md @@ -33,11 +33,9 @@ or if \`Bars are set, | by the | vertical dash.
- - - + + +
-
It only works when
all the elements fit
-
logically speaking,
on a single line.
It only works when
all the elements fit
logically speaking,
on a single line.
@@ -46,13 +44,9 @@ or if \`Bars are set, | by the | vertical dash.
- - - - + + +
Otherwise, the fallback behavior is as if
- 
`As_table
-
was used to configure horizontal boxes.
-
Otherwise, the fallback behavior is as if
`As_table
was used to configure horizontal boxes.
@@ -105,7 +99,7 @@ to separate the entries (here with style \`Line_break). - And suprisingly it works even better - - when tables are configured - -
to fallback on
+ -
to fallback on
- HTML -- but it doesn't work on GitHub Preview. @@ -143,29 +137,21 @@ Rows |[must be]|single |line.
- - - + + + - - - - + + + - - - - + + From e3aedeff1cba14749e6fa5f28b31ef8026437e04 Mon Sep 17 00:00:00 2001 From: Lukasz Stafiniak Date: Sat, 17 Feb 2024 21:02:01 +0100 Subject: [PATCH 3/4] Update tests with compact html --- README.md | 2 +- test/test_html.expected | 2 +- test/test_md.expected | 64 +++++++++++++++------------------------- test/test_md.expected.md | 64 +++++++++++++++------------------------- 4 files changed, 50 insertions(+), 82 deletions(-) diff --git a/README.md b/README.md index 4798d0f..ca7b9aa 100644 --- a/README.md +++ b/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 "ω²"]]));; -
0
  • 1
  • ω
    • ω²
+
0
  • 1
  • ω
    • ω²
- : unit = () ``` diff --git a/test/test_html.expected b/test/test_html.expected index 2f4ed0c..3bb5c37 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
  • header 5
    • subchild 5
  • 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_md.expected b/test/test_md.expected index 8b0302e..f7eabd9 100644 --- a/test/test_md.expected +++ b/test/test_md.expected @@ -72,10 +72,10 @@ Test default: Test uniform unfolded: -
root
+
root
--
child 1
+-
child 1
- `child 2` @@ -87,7 +87,7 @@ Test uniform unfolded: a row 2.1 a row 2.2 -
a row 3
+
a row 3
- b row 1 @@ -98,13 +98,10 @@ Test uniform unfolded: **b row 3** -
Tables
that meet
 -
neither
-
of:
Tables
that meet
neither
of:
-
-
Markdown's native
-
-
restrictions,
special cases:
hlist
-                                                             vlist
-
+
Markdown's native
+
restrictions,
special cases:
hlistvlist
End up
as either
of the fallbacks:
 - 
printbox-text
-                                                 printbox-html
+
End up
as either
of the fallbacks:
 + 
+     printbox-textprintbox-html
- - - - + + +
a longiiish column 1
a longiiish column 2
 -
a longiiish column 3
-
-
a longiiish column 4
a longiiish column 1
a longiiish column 2
a longiiish column 3
+
a longiiish column 4
@@ -112,65 +109,52 @@ Test uniform unfolded: -
- - - - + + +
b longiiish column 1
b longiiish column 2
b longiiish column 3
 -
b longiiish column 4
-
+
b longiiish column 1
b longiiish column 2
b longiiish column 3
b longiiish column 4
--
c row 1
c row 2.1
c row 2.2
c row 3
+-
c row 1
c row 2.1
c row 2.2
c row 3
--
  • header 3
    • subchild 3
+-
  • header 3
    • subchild 3
- - -
header 4
+ -
header 4
- \ - `` - & \*\*subchild\*\* 4 -- 
header 5
  • subchild 5
-  body 5
-    subbody 5
-	one tab end of sub 5
-end of 5
+- 
header 5
  • subchild 5  body 5    subbody 5	one tab end of sub 5end of 5
--
a
looooooooooooooooooooooooo
oonng
bx
x
y
1
2
?
x
y
10
20
+-
a
looooooooooooooooooooooooo
oonng
bx
x
y
1
2
?
x
y
10
20
-
- - - + + - - + + + - - - + +
header 1
header 2
 -
header 3
-
header 1
header 2
header 3
cell 1.1
 -
cell 1.2
-
cell 1.3
cell 1.1
cell 1.2
cell 1.3
-
cell 2.1
-
cell 2.2
cell 2.3
cell 2.1
cell 2.2
cell 2.3
--
header 1
header 2
header 3
cell 1.1
cell 1.2
cell 1.3
cell 2.1
cell 2.2
cell 2.3
+-
header 1
header 2
header 3
cell 1.1
cell 1.2
cell 1.3
cell 2.1
cell 2.2
cell 2.3
diff --git a/test/test_md.expected.md b/test/test_md.expected.md index 8b0302e..f7eabd9 100644 --- a/test/test_md.expected.md +++ b/test/test_md.expected.md @@ -72,10 +72,10 @@ Test default: Test uniform unfolded: -
root
+
root
--
child 1
+-
child 1
- `child 2` @@ -87,7 +87,7 @@ Test uniform unfolded: a row 2.1 a row 2.2 -
a row 3
+
a row 3
- b row 1 @@ -98,13 +98,10 @@ Test uniform unfolded: **b row 3** -
- - - - + + +
a longiiish column 1
a longiiish column 2
 -
a longiiish column 3
-
-
a longiiish column 4
a longiiish column 1
a longiiish column 2
a longiiish column 3
+
a longiiish column 4
@@ -112,65 +109,52 @@ Test uniform unfolded: -
- - - - + + +
b longiiish column 1
b longiiish column 2
b longiiish column 3
 -
b longiiish column 4
-
+
b longiiish column 1
b longiiish column 2
b longiiish column 3
b longiiish column 4
--
c row 1
c row 2.1
c row 2.2
c row 3
+-
c row 1
c row 2.1
c row 2.2
c row 3
--
  • header 3
    • subchild 3
+-
  • header 3
    • subchild 3
- - -
header 4
+ -
header 4
- \ - `` - & \*\*subchild\*\* 4 -- 
header 5
  • subchild 5
-  body 5
-    subbody 5
-	one tab end of sub 5
-end of 5
+- 
header 5
  • subchild 5  body 5    subbody 5	one tab end of sub 5end of 5
--
a
looooooooooooooooooooooooo
oonng
bx
x
y
1
2
?
x
y
10
20
+-
a
looooooooooooooooooooooooo
oonng
bx
x
y
1
2
?
x
y
10
20
-
- - - + + - - + + + - - - + +
header 1
header 2
 -
header 3
-
header 1
header 2
header 3
cell 1.1
 -
cell 1.2
-
cell 1.3
cell 1.1
cell 1.2
cell 1.3
-
cell 2.1
-
cell 2.2
cell 2.3
cell 2.1
cell 2.2
cell 2.3
--
header 1
header 2
header 3
cell 1.1
cell 1.2
cell 1.3
cell 2.1
cell 2.2
cell 2.3
+-
header 1
header 2
header 3
cell 1.1
cell 1.2
cell 1.3
cell 2.1
cell 2.2
cell 2.3
From 51d2fc51f93e1ff43f14f992d8850941906cfd7a Mon Sep 17 00:00:00 2001 From: Lukasz Stafiniak Date: Sat, 17 Feb 2024 22:14:30 +0100 Subject: [PATCH 4/4] Fixes #39: more compact markdown output Remove double empty lines after ``. --- src/printbox-md/PrintBox_md.ml | 4 +++- src/printbox-md/README.md | 2 -- test/test_md.expected | 15 --------------- test/test_md.expected.md | 15 --------------- 4 files changed, 3 insertions(+), 33 deletions(-) diff --git a/src/printbox-md/PrintBox_md.ml b/src/printbox-md/PrintBox_md.ml index 1f79423..0ea6ffd 100644 --- a/src/printbox-md/PrintBox_md.ml +++ b/src/printbox-md/PrintBox_md.ml @@ -494,8 +494,10 @@ let pp c out b = (fun _out sub -> loop ~no_block ~no_md ~prefix:subprefix sub) out @@ Array.to_list body; + (* Note: vlist and tree element separators move to a new line. + A non-html hlist or table as a parent would not produce correct results. *) if c.Config.foldable_trees then - fprintf out "@,%s@,%s@,%s" prefix prefix prefix + fprintf out "@,%s@,%s" prefix prefix | B.Link { uri; inner } -> pp_print_string out "["; loop ~no_block:true ~no_md ~prefix:(prefix ^ " ") inner; diff --git a/src/printbox-md/README.md b/src/printbox-md/README.md index eb80a5e..339a47e 100644 --- a/src/printbox-md/README.md +++ b/src/printbox-md/README.md @@ -121,11 +121,9 @@ Trees are rendered as: - **are the details.** - - ### Tables There is a special case carved out for Markdown syntax tables. diff --git a/test/test_md.expected b/test/test_md.expected index f7eabd9..4554c4b 100644 --- a/test/test_md.expected +++ b/test/test_md.expected @@ -191,10 +191,8 @@ Test foldable: > - > subchild 3 > > - > > > - > -
-
[header 4] @@ -204,14 +202,11 @@ Test foldable: - ``
- - & \*\*subchild\*\* 4
- - - >
header 5 > > - @@ -225,7 +220,6 @@ Test foldable: > >
> - > - > > > > ``` > > a │looooooooooooooooooooooooo @@ -257,7 +251,6 @@ Test foldable: - Test uniform tab=2, text tables:
┌────┐
│root│
@@ -345,14 +338,11 @@ Test uniform tab=2, text tables: - ``
- - & \*\*subchild\*\* 4 - - - ``` ┌───────────────────────┐ @@ -424,7 +414,6 @@ Test uniform tab=2, text tables: - Test single quote tab=2, text tables:
┌────┐
│root│
@@ -488,14 +477,11 @@ Test single quote tab=2, text tables: - ``
- - & \*\*subchild\*\* 4 - - - `┌───────────────────────┐` `│header 5 · · · · · · · │` `│└─subchild 5 · · · · · │` @@ -551,5 +537,4 @@ Test single quote tab=2, text tables: - The end. diff --git a/test/test_md.expected.md b/test/test_md.expected.md index f7eabd9..4554c4b 100644 --- a/test/test_md.expected.md +++ b/test/test_md.expected.md @@ -191,10 +191,8 @@ Test foldable: > - > subchild 3 > > - > > > - > -
-
[header 4] @@ -204,14 +202,11 @@ Test foldable: - ``
- - & \*\*subchild\*\* 4
- - - >
header 5 > > - @@ -225,7 +220,6 @@ Test foldable: > >
> - > - > > > > ``` > > a │looooooooooooooooooooooooo @@ -257,7 +251,6 @@ Test foldable: - Test uniform tab=2, text tables:
┌────┐
│root│
@@ -345,14 +338,11 @@ Test uniform tab=2, text tables: - ``
- - & \*\*subchild\*\* 4 - - - ``` ┌───────────────────────┐ @@ -424,7 +414,6 @@ Test uniform tab=2, text tables: - Test single quote tab=2, text tables:
┌────┐
│root│
@@ -488,14 +477,11 @@ Test single quote tab=2, text tables: - ``
- - & \*\*subchild\*\* 4 - - - `┌───────────────────────┐` `│header 5 · · · · · · · │` `│└─subchild 5 · · · · · │` @@ -551,5 +537,4 @@ Test single quote tab=2, text tables: - The end.