From 6d7b3fa733d71b986faaece2ef021c62d9d2bde0 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 27 Jan 2024 23:49:02 -0500 Subject: [PATCH] format --- .ocamlformat | 15 + dune | 1 - examples/lambda.ml | 101 ++--- src/PrintBox.ml | 127 +++--- src/PrintBox.mli | 71 ++-- src/printbox-html/PrintBox_html.ml | 283 +++++++------ src/printbox-html/PrintBox_html.mli | 15 +- src/printbox-md/PrintBox_md.ml | 528 +++++++++++++++--------- src/printbox-md/PrintBox_md.mli | 26 +- src/printbox-md/dune | 3 +- src/printbox-md/readme.ml | 434 +++++++++++++------- src/printbox-text/PrintBox_text.ml | 604 ++++++++++++++++------------ test/dune | 8 +- test/test1.ml | 157 +++++--- test/test_ann_0_3.ml | 52 ++- test/test_blending.ml | 28 +- test/test_html.ml | 28 +- test/test_md.ml | 149 ++++--- 18 files changed, 1589 insertions(+), 1041 deletions(-) create mode 100644 .ocamlformat diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 0000000..2124d7d --- /dev/null +++ b/.ocamlformat @@ -0,0 +1,15 @@ +version = 0.24.1 +profile=conventional +margin=80 +if-then-else=k-r +parens-ite=true +parens-tuple=multi-line-only +sequence-style=terminator +type-decl=sparse +break-cases=toplevel +cases-exp-indent=2 +field-space=tight-decl +leading-nested-match-parens=true +module-item-spacing=compact +quiet=true +ocaml-version=4.08.0 diff --git a/dune b/dune index 4b43da6..349e030 100644 --- a/dune +++ b/dune @@ -1,4 +1,3 @@ - (mdx (package printbox-html) (libraries printbox printbox-text printbox-html) diff --git a/examples/lambda.ml b/examples/lambda.ml index 03fd6bf..b7974a8 100644 --- a/examples/lambda.ml +++ b/examples/lambda.ml @@ -1,7 +1,5 @@ - (** Example of printing trees: lambda-term evaluation *) - type term = | Lambda of string * term | App of term * term @@ -14,92 +12,99 @@ let _gensym = incr r; s -module SSet = Set.Make(String) -module SMap = Map.Make(String) +module SSet = Set.Make (String) +module SMap = Map.Make (String) -let rec fvars t = match t with +let rec fvars t = + match t with | Var s -> SSet.singleton s - | Lambda (v,t') -> - let set' = fvars t' in - SSet.remove v set' + | Lambda (v, t') -> + let set' = fvars t' in + SSet.remove v set' | App (t1, t2) -> SSet.union (fvars t1) (fvars t2) (* replace [var] with the term [by] *) -let rec replace t ~var ~by = match t with - | Var s -> if s=var then by else t - | App (t1,t2) -> App (replace t1 ~var ~by, replace t2 ~var ~by) - | Lambda (v, _t') when v=var -> t (* no risk *) +let rec replace t ~var ~by = + match t with + | Var s -> + if s = var then + by + else + t + | App (t1, t2) -> App (replace t1 ~var ~by, replace t2 ~var ~by) + | Lambda (v, _t') when v = var -> t (* no risk *) | Lambda (v, t') -> Lambda (v, replace t' ~var ~by) (* rename [t] so that [var] doesn't occur in it *) let rename ~var t = - if SSet.mem var (fvars t) - then replace t ~var ~by:(Var (_gensym ())) - else t + if SSet.mem var (fvars t) then + replace t ~var ~by:(Var (_gensym ())) + else + t -let (>>=) o f = match o with +let ( >>= ) o f = + match o with | None -> None | Some x -> f x -let rec one_step t = match t with +let rec one_step t = + match t with | App (Lambda (var, t1), t2) -> - let t2' = rename ~var t2 in - Some (replace t1 ~var ~by:t2') + let t2' = rename ~var t2 in + Some (replace t1 ~var ~by:t2') | App (t1, t2) -> - begin match one_step t1 with - | None -> - one_step t2 >>= fun t2' -> - Some (App (t1,t2')) - | Some t1' -> - Some (App (t1',t2)) - end + (match one_step t1 with + | None -> one_step t2 >>= fun t2' -> Some (App (t1, t2')) + | Some t1' -> Some (App (t1', t2))) | Var _ -> None - | Lambda (v,t') -> - one_step t' >>= fun t'' -> - Some (Lambda (v, t'')) + | Lambda (v, t') -> one_step t' >>= fun t'' -> Some (Lambda (v, t'')) let normal_form t = - let rec aux acc t = match one_step t with - | None -> List.rev (t::acc) - | Some t' -> aux (t::acc) t' + let rec aux acc t = + match one_step t with + | None -> List.rev (t :: acc) + | Some t' -> aux (t :: acc) t' in aux [] t let _split_fuel f = - assert (f>=2); - if f=2 then 1,1 - else - let x = 1+Random.int (f-1) in - f-x, x + assert (f >= 2); + if f = 2 then + 1, 1 + else ( + let x = 1 + Random.int (f - 1) in + f - x, x + ) let _random_var () = let v = [| "x"; "y"; "z"; "u"; "w" |] in v.(Random.int (Array.length v)) -let _choose_var ~vars = match vars with +let _choose_var ~vars = + match vars with | [] -> Var (_random_var ()) - | _::_ -> - let i = Random.int (List.length vars) in - List.nth vars i + | _ :: _ -> + let i = Random.int (List.length vars) in + List.nth vars i let rec _random_term fuel vars = match Random.int 2 with | _ when fuel = 1 -> _choose_var ~vars | 0 -> - let f1,f2 = _split_fuel fuel in - App (_random_term f1 vars, _random_term f2 vars) + let f1, f2 = _split_fuel fuel in + App (_random_term f1 vars, _random_term f2 vars) | 1 -> - let v = _random_var () in - Lambda (v, _random_term (fuel-1) (Var v::vars)) + let v = _random_var () in + Lambda (v, _random_term (fuel - 1) (Var v :: vars)) | _ -> assert false let print_term t = PrintBox.mk_tree (function | Var v -> PrintBox.line v, [] - | App (t1,t2) -> PrintBox.line "app", [t1;t2] - | Lambda (v,t') -> PrintBox.line "lambda", [Var v; t'] - ) t + | App (t1, t2) -> PrintBox.line "app", [ t1; t2 ] + | Lambda (v, t') -> PrintBox.line "lambda", [ Var v; t' ]) + t let print_reduction t = let l = normal_form t in diff --git a/src/PrintBox.ml b/src/PrintBox.ml index 770b361..6e90767 100644 --- a/src/PrintBox.ml +++ b/src/PrintBox.ml @@ -2,7 +2,10 @@ (** {1 Pretty-Printing of Boxes} *) -type position = { x:int ; y: int } +type position = { + x: int; + y: int; +} module Style = struct type color = @@ -22,12 +25,13 @@ module Style = struct preformatted: bool; } - let default = {bold=false; bg_color=None; fg_color=None; preformatted=false} - let set_bg_color c self = {self with bg_color=Some c} - let set_fg_color c self = {self with fg_color=Some c} - let set_bold b self = {self with bold=b} - let set_preformatted b self = {self with preformatted=b} + let default = + { bold = false; bg_color = None; fg_color = None; preformatted = false } + let set_bg_color c self = { self with bg_color = Some c } + let set_fg_color c self = { self with fg_color = Some c } + let set_bold b self = { self with bold = b } + let set_preformatted b self = { self with preformatted = b } let bold : t = set_bold true default let preformatted : t = set_preformatted true default let bg_color c : t = set_bg_color c default @@ -43,11 +47,11 @@ type view = | Frame of t | Pad of position * t (* vertical and horizontal padding *) | Align of { - h: [`Left | `Center | `Right]; - v: [`Top | `Center | `Bottom]; + h: [ `Left | `Center | `Right ]; + v: [ `Top | `Center | `Bottom ]; inner: t; } - | Grid of [`Bars | `None] * t array array + | Grid of [ `Bars | `None ] * t array array | Tree of int * t * t array | Link of { uri: string; @@ -57,93 +61,94 @@ type view = and t = view let empty = Empty -let[@inline] view (t:t) : view = t - -let[@inline] line_ s = Text {l=[s]; style=Style.default} +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"; - Text {l=[s]; style} + Text { l = [ s ]; style } let line s = line_with_style Style.default s let[@inline] mk_text_ s : string list = - if String.contains s '\n' then String.split_on_char '\n' s else [s] + if String.contains s '\n' then + String.split_on_char '\n' s + else + [ s ] -let[@inline] text s = Text {l=mk_text_ s; style=Style.default} -let[@inline] text_with_style style s = Text {l=mk_text_ s; style} +let[@inline] text s = Text { l = mk_text_ s; style = Style.default } +let[@inline] text_with_style style s = Text { l = mk_text_ s; style } let sprintf_with_style style format = let buffer = Buffer.create 64 in Printf.kbprintf (fun _ -> text_with_style style (Buffer.contents buffer)) - buffer - format + buffer format let sprintf format = sprintf_with_style Style.default format let asprintf format = Format.kasprintf text format -let asprintf_with_style style format = Format.kasprintf (text_with_style style) format -let[@inline] lines l = Text {l; style=Style.default} -let[@inline] lines_with_style style l = Text {l; style} +let asprintf_with_style style format = + Format.kasprintf (text_with_style style) format +let[@inline] lines l = Text { l; style = Style.default } +let[@inline] lines_with_style style l = Text { l; style } let int x = line_ (string_of_int x) let float x = line_ (string_of_float x) let bool x = line_ (string_of_bool x) - let int_ = int let float_ = float let bool_ = bool - let[@inline] frame b = Frame b let pad' ~col ~lines b = - assert (col >=0 || lines >= 0); - if col=0 && lines=0 - then b - else Pad ({x=col;y=lines}, b) + assert (col >= 0 || lines >= 0); + if col = 0 && lines = 0 then + b + else + Pad ({ x = col; y = lines }, b) let pad b = pad' ~col:1 ~lines:1 b - let hpad col b = pad' ~col ~lines:0 b let vpad lines b = pad' ~col:0 ~lines b - -let align ~h ~v b : t = Align {h; v; inner=b} +let align ~h ~v b : t = Align { h; v; inner = b } let align_bottom b = align ~h:`Left ~v:`Bottom b let align_right b = align ~h:`Right ~v:`Top b let align_bottom_right b = align ~h:`Right ~v:`Bottom b let center_h b = align ~h:`Center ~v:`Top b let center_v b = align ~h:`Left ~v:`Center b let center_hv b = align ~h:`Center ~v:`Center b +let map_matrix f m = Array.map (Array.map f) m -let map_matrix f m = - Array.map (Array.map f) m - -let grid ?(pad=fun b->b) ?(bars=true) m = +let grid ?(pad = fun b -> b) ?(bars = true) m = let m = map_matrix pad m in - Grid ((if bars then `Bars else `None), m) + Grid + ( (if bars then + `Bars + else + `None), + m ) let grid_l ?pad ?bars l = grid ?pad ?bars (Array.of_list l |> Array.map Array.of_list) let init_grid ?bars ~line ~col f = - let m = Array.init line (fun j-> Array.init col (fun i -> f ~line:j ~col:i)) in + let m = + Array.init line (fun j -> Array.init col (fun i -> f ~line:j ~col:i)) + in grid ?bars m let vlist ?pad ?bars l = let a = Array.of_list l in grid ?pad ?bars (Array.map (fun line -> [| line |]) a) -let hlist ?pad ?bars l = - grid ?pad ?bars [| Array.of_list l |] - +let hlist ?pad ?bars l = grid ?pad ?bars [| Array.of_list l |] let hlist_map ?bars f l = hlist ?bars (List.map f l) let vlist_map ?bars f l = vlist ?bars (List.map f l) let grid_map ?bars f m = grid ?bars (Array.map (Array.map f) m) - let grid_map_l ?bars f m = grid_l ?bars (List.map (List.map f) m) -let grid_text ?(pad=fun x->x) ?bars m = +let grid_text ?(pad = fun x -> x) ?bars m = grid_map ?bars (fun x -> pad (text x)) m let grid_text_l ?pad ?bars l = @@ -151,21 +156,22 @@ let grid_text_l ?pad ?bars l = let record ?pad ?bars l = let fields, vals = List.split l in - grid_l ?pad ?bars [List.map text fields; vals] + grid_l ?pad ?bars [ List.map text fields; vals ] let v_record ?pad ?bars l = - grid_l ?pad ?bars (List.map (fun (f,v) -> [text f; v]) l) + grid_l ?pad ?bars (List.map (fun (f, v) -> [ text f; v ]) l) let dim_matrix m = - if Array.length m = 0 then {x=0;y=0} - else {y=Array.length m; x=Array.length m.(0); } + if Array.length m = 0 then + { x = 0; y = 0 } + else + { y = Array.length m; x = Array.length m.(0) } let transpose m = let dim = dim_matrix m in - Array.init dim.x - (fun i -> Array.init dim.y (fun j -> m.(j).(i))) + Array.init dim.x (fun i -> Array.init dim.y (fun j -> m.(j).(i))) -let tree ?(indent=0) node children = +let tree ?(indent = 0) node children = if indent < 0 then invalid_arg "tree: need non-negative indent"; let children = List.filter @@ -176,22 +182,23 @@ let tree ?(indent=0) node children = in match children with | [] -> node - | _::_ -> + | _ :: _ -> let children = Array.of_list children in Tree (indent, node, children) let mk_tree ?indent f root = - let rec make x = match f x with + let rec make x = + match f x with | b, [] -> b | b, children -> tree ?indent b (List.map make children) in make root -let link ~uri inner : t = Link {uri; inner} +let link ~uri inner : t = Link { uri; inner } (** {2 Simple Structural Interface} *) -type 'a ktree = unit -> [`Nil | `Node of 'a * 'a ktree list] +type 'a ktree = unit -> [ `Nil | `Node of 'a * 'a ktree list ] type box = t module Simple = struct @@ -212,23 +219,21 @@ module Simple = struct | `Vlist l -> vlist (List.map to_box l) | `Hlist l -> hlist (List.map to_box l) | `Table a -> grid (map_matrix to_box a) - | `Tree (b,l) -> tree (to_box b) (List.map to_box l) + | `Tree (b, l) -> tree (to_box b) (List.map to_box l) - let rec of_ktree t = match t () with + let rec of_ktree t = + match t () with | `Nil -> `Empty | `Node (x, l) -> `Tree (x, List.map of_ktree l) - let rec map_ktree f t = match t () with + let rec map_ktree f t = + match t () with | `Nil -> `Empty | `Node (x, l) -> `Tree (f x, List.map (map_ktree f) l) let sprintf format = let buffer = Buffer.create 64 in - Printf.kbprintf - (fun _ -> `Text (Buffer.contents buffer)) - buffer - format + Printf.kbprintf (fun _ -> `Text (Buffer.contents buffer)) buffer format - let asprintf format = - Format.kasprintf (fun s -> `Text s) format + let asprintf format = Format.kasprintf (fun s -> `Text s) format end diff --git a/src/PrintBox.mli b/src/PrintBox.mli index caf8433..fbb8b25 100644 --- a/src/PrintBox.mli +++ b/src/PrintBox.mli @@ -54,7 +54,10 @@ *) -type position = { x:int ; y: int } +type position = { + x: int; + y: int; +} (** Positions are relative to the upper-left corner, that is, when [x] increases we go toward the right, and when [y] increases we go toward the bottom (same order as a printer) *) @@ -75,30 +78,22 @@ module Style : sig type t = { bold: bool; - bg_color: color option; (** backgroud color *) - fg_color: color option; (** foreground color *) + bg_color: color option; (** backgroud color *) + fg_color: color option; (** foreground color *) preformatted: bool; - (** where supported, the text rendering should be monospaced and respect whitespace *) + (** where supported, the text rendering should be monospaced and respect whitespace *) } (** Basic styling (color, bold). @since 0.3 *) val default : t - val set_bg_color : color -> t -> t - val set_fg_color : color -> t -> t - val set_bold : bool -> t -> t - val set_preformatted : bool -> t -> t - val bg_color : color -> t - val fg_color : color -> t - val bold : t - val preformatted : t end @@ -123,11 +118,11 @@ type view = private | Frame of t | Pad of position * t (* vertical and horizontal padding *) | Align of { - h: [`Left | `Center | `Right]; - v: [`Top | `Center | `Bottom]; + h: [ `Left | `Center | `Right ]; + v: [ `Top | `Center | `Bottom ]; inner: t; - } (** Alignment within the surrounding box *) - | Grid of [`Bars | `None] * t array array + } (** Alignment within the surrounding box *) + | Grid of [ `Bars | `None ] * t array array | Tree of int * t * t array (* int: indent *) | Link of { uri: string; @@ -163,9 +158,7 @@ val lines : string list -> t [lines l] is the same as [text (String.concat "\n" l)]. *) val int_ : int -> t - val bool_ : bool -> t - val float_ : float -> t val int : int -> t @@ -192,7 +185,8 @@ val vpad : int -> t -> t val hpad : int -> t -> t (** Pad horizontally by [n] spaces *) -val align : h:[`Left | `Right | `Center] -> v:[`Top | `Bottom | `Center] -> t -> t +val align : + h:[ `Left | `Right | `Center ] -> v:[ `Top | `Bottom | `Center ] -> t -> t (** Control alignment of the given box wrt its surrounding box, if any. @param h horizontal alignment @param v vertical alignment @@ -222,10 +216,7 @@ val center_hv : t -> t (** Try to center within the surrounding box, as in [align ~h:`Center ~v:`Center] @since 0.3 *) -val grid : - ?pad:(t -> t) -> - ?bars:bool -> - t array array -> t +val grid : ?pad:(t -> t) -> ?bars:bool -> t array array -> t (** Grid of boxes (no frame between boxes). The matrix is indexed with lines first, then columns. The array must be a proper matrix, that is, all lines must have the same number of columns! @@ -234,36 +225,25 @@ val grid : @param bars if true, each item of the grid will be framed. default value is [true] *) -val grid_text : - ?pad:(t -> t) -> ?bars:bool -> - string array array -> t +val grid_text : ?pad:(t -> t) -> ?bars:bool -> string array array -> t (** Same as {!grid}, but wraps every cell into a {!text} box *) val transpose : 'a array array -> 'a array array (** Transpose a matrix *) -val init_grid : ?bars:bool -> - line:int -> col:int -> (line:int -> col:int -> t) -> t +val init_grid : + ?bars:bool -> line:int -> col:int -> (line:int -> col:int -> t) -> t (** Same as {!grid} but takes the matrix as a function *) -val grid_l : - ?pad:(t -> t) -> - ?bars:bool -> - t list list -> t +val grid_l : ?pad:(t -> t) -> ?bars:bool -> t list list -> t (** Same as {!grid} but from lists. @since 0.3 *) -val grid_text_l : - ?pad:(t -> t) -> - ?bars:bool -> - string list list -> t +val grid_text_l : ?pad:(t -> t) -> ?bars:bool -> string list list -> t (** Same as {!grid_text} but from lists. @since 0.3 *) -val record : - ?pad:(t -> t) -> - ?bars:bool -> - (string * t) list -> t +val record : ?pad:(t -> t) -> ?bars:bool -> (string * t) list -> t (** A record displayed as a table, each field being a columng [(label,value)]. {[ # frame @@ record ["a", int 1; "b", float 3.14; "c", bool true];; @@ -275,10 +255,7 @@ val record : ]} @since 0.3 *) -val v_record : - ?pad:(t -> t) -> - ?bars:bool -> - (string * t) list -> t +val v_record : ?pad:(t -> t) -> ?bars:bool -> (string * t) list -> t (** Like {!record}, but printed vertically rather than horizontally. {[ # frame @@ v_record ["a", int 1; "b", float 3.14; "c", bool true];; @@ -305,7 +282,6 @@ val grid_map_l : ?bars:bool -> ('a -> t) -> 'a list list -> t @since 0.4 *) val vlist_map : ?bars:bool -> ('a -> t) -> 'a list -> t - val hlist_map : ?bars:bool -> ('a -> t) -> 'a list -> t val tree : ?indent:int -> t -> t list -> t @@ -340,13 +316,14 @@ val sprintf_with_style : Style.t -> ('a, Buffer.t, unit, t) format4 -> 'a (** Formatting for {!text}, with style @since 0.3 *) -val asprintf_with_style : Style.t -> ('a, Format.formatter, unit, t) format4 -> 'a +val asprintf_with_style : + Style.t -> ('a, Format.formatter, unit, t) format4 -> 'a (** Formatting for {!text}, with style. @since 0.3 *) (** {2 Simple Structural Interface} *) -type 'a ktree = unit -> [`Nil | `Node of 'a * 'a ktree list] +type 'a ktree = unit -> [ `Nil | `Node of 'a * 'a ktree list ] type box = t module Simple : sig diff --git a/src/printbox-html/PrintBox_html.ml b/src/printbox-html/PrintBox_html.ml index ef4754d..743419c 100644 --- a/src/printbox-html/PrintBox_html.ml +++ b/src/printbox-html/PrintBox_html.ml @@ -3,7 +3,6 @@ (** {1 Output HTML} *) open Tyxml - module B = PrintBox module H = Html @@ -11,24 +10,24 @@ type 'a html = 'a Html.elt let prelude = let l = - [ "table, th, td { border-collapse: collapse; }" - ; "table.framed { border: 2px solid black; }" - ; "table.framed th, table.framed td { border: 1px solid black; }" - ; "th, td { padding: 3px; }" - ; "tr:nth-child(even) { background-color: #eee; }" - ; "tr:nth-child(odd) { background-color: #fff; }" - ; ".align-right { text-align: right; }" - ; ".center { text-align: center; }" + [ + "table, th, td { border-collapse: collapse; }"; + "table.framed { border: 2px solid black; }"; + "table.framed th, table.framed td { border: 1px solid black; }"; + "th, td { padding: 3px; }"; + "tr:nth-child(even) { background-color: #eee; }"; + "tr:nth-child(odd) { background-color: #fff; }"; + ".align-right { text-align: right; }"; + ".center { text-align: center; }"; ] in H.style (List.map H.pcdata l) -let prelude_str = - Format.asprintf "%a@." (H.pp_elt ()) prelude +let prelude_str = Format.asprintf "%a@." (H.pp_elt ()) prelude -let attrs_of_style (s:B.Style.t) : _ list * _ = +let attrs_of_style (s : B.Style.t) : _ list * _ = let open B.Style in - let {bold;bg_color;fg_color;preformatted} = s in + let { bold; bg_color; fg_color; preformatted } = s in let encode_color = function | Red -> "red" | Blue -> "blue" @@ -40,13 +39,27 @@ let attrs_of_style (s:B.Style.t) : _ list * _ = | White -> "white" in let s = - (match bg_color with None -> [] | Some c -> ["background-color", encode_color c]) @ - (match fg_color with None -> [] | Some c -> ["color", encode_color c]) @ - (if preformatted then ["font-family", "monospace"] else []) + (match bg_color with + | None -> [] + | Some c -> [ "background-color", encode_color c ]) + @ (match fg_color with + | None -> [] + | Some c -> [ "color", encode_color c ]) + @ + if preformatted then + [ "font-family", "monospace" ] + else + [] in - let a = match s with + let a = + match s with | [] -> [] - | s -> [H.a_style @@ String.concat ";" @@ List.map (fun (k,v) -> k ^ ": " ^ v) s] in + | s -> + [ + H.a_style @@ String.concat ";" + @@ List.map (fun (k, v) -> k ^ ": " ^ v) s; + ] + in a, bold module Config = struct @@ -62,125 +75,159 @@ module Config = struct tree_summary: bool; } - let default : t = { - cls_table=[]; - a_table=[]; - cls_text=[]; - a_text=[]; - cls_row=[]; - a_row=[]; - cls_col=[]; - a_col=[]; - tree_summary=false; - } + let default : t = + { + cls_table = []; + a_table = []; + cls_text = []; + a_text = []; + cls_row = []; + a_row = []; + cls_col = []; + a_col = []; + tree_summary = false; + } - let cls_table x c = {c with cls_table=x} - let a_table x c = {c with a_table=x} - let cls_text x c = {c with cls_text=x} - let a_text x c = {c with a_text=x} - let cls_row x c = {c with cls_row=x} - let a_row x c = {c with a_row=x} - let cls_col x c = {c with cls_col=x} - let a_col x c = {c with a_col=x} - let tree_summary x c = {c with tree_summary=x} + let cls_table x c = { c with cls_table = x } + let a_table x c = { c with a_table = x } + let cls_text x c = { c with cls_text = x } + let a_text x c = { c with a_text = x } + let cls_row x c = { c with cls_row = x } + let a_row x c = { c with a_row = x } + let cls_col x c = { c with cls_col = x } + let a_col x c = { c with a_col = x } + let tree_summary x c = { c with tree_summary = x } end -let to_html_rec ~config (b: B.t) = +let to_html_rec ~config (b : B.t) = let open Config in - let h_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 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 + 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 + 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 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 [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 ] - | B.Align {h=`Right;inner=b;v=_} -> - H.div ~a:[H.a_class ["align-right"]] [ fix b ] - | B.Align {h=`Center;inner=b;v=_} -> - H.div ~a:[H.a_class ["center"]] [ fix b ] - | B.Align {inner=b;_} -> fix b - | B.Grid (bars, a) -> - let class_ = match bars with - | `Bars -> "framed" - | `None -> "non-framed" - in - 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) - 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 - | 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) - ] - | B.Link _ -> assert false + 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 [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 ] + | B.Align { h = `Right; inner = b; v = _ } -> + H.div ~a:[ H.a_class [ "align-right" ] ] [ fix b ] + | B.Align { h = `Center; inner = b; v = _ } -> + H.div ~a:[ H.a_class [ "center" ] ] [ fix b ] + | B.Align { inner = b; _ } -> fix b + | B.Grid (bars, a) -> + let class_ = + match bars with + | `Bars -> "framed" + | `None -> "non-framed" + in + 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 + 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 + | 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) ] + | B.Link _ -> assert false in let rec to_html_rec b = match B.view b with | B.Tree (_, b, l) when config.tree_summary -> let l = Array.to_list l in (match B.view b with - | B.Text {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.Text { 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 [h_text_to_html ~border:true ~l:tl ~style ()]) - [ H.ul (List.map (fun x -> H.li [to_html_rec x]) l) ] + | B.Text { 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 - [ 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]] + [ 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 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]] + | 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 in to_html_rec b -let to_html ?(config=Config.default) b = H.div [to_html_rec ~config b] +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) @@ -188,22 +235,22 @@ let to_string ?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 = +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 = "" in + let meta_str = + "" + in let footer_str = - "" + "" in - Format.asprintf "%s%s@[%a@]%s@." - meta_str prelude_str (H.pp_elt ()) (to_html ?config b) footer_str + Format.asprintf "%s%s@[%a@]%s@." meta_str + prelude_str (H.pp_elt ()) (to_html ?config b) footer_str diff --git a/src/printbox-html/PrintBox_html.mli b/src/printbox-html/PrintBox_html.mli index 5ce8b77..8972141 100644 --- a/src/printbox-html/PrintBox_html.mli +++ b/src/printbox-html/PrintBox_html.mli @@ -1,4 +1,3 @@ - (* This file is free software. See file "license" for more details. *) (** {1 Output HTML} *) @@ -7,7 +6,7 @@ open Tyxml type 'a html = 'a Html.elt -val prelude : [> Html_types.style] html +val prelude : [> Html_types.style ] html (** HTML text to embed in the "", defining the style for tables *) val prelude_str : string @@ -29,19 +28,25 @@ module Config : sig val a_row : Html_types.div_attrib Html.attrib list -> t -> t val cls_col : string list -> t -> t val a_col : Html_types.div_attrib Html.attrib list -> t -> t + val tree_summary : bool -> t -> t (** When set to true, the trees are rendered collapsed using the [] HTML5 element. *) end -val to_html : ?config:Config.t -> PrintBox.t -> [`Div] html +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 + ?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 diff --git a/src/printbox-md/PrintBox_md.ml b/src/printbox-md/PrintBox_md.ml index a953cfe..1f79423 100644 --- a/src/printbox-md/PrintBox_md.ml +++ b/src/printbox-md/PrintBox_md.ml @@ -3,358 +3,506 @@ module B = PrintBox module Config = struct - type preformatted = Code_block | Code_quote + type preformatted = + | Code_block + | Code_quote + type t = { - tables: [`Text | `Html]; - vlists: [`Line_break | `List | `As_table]; - hlists: [`Minimal | `As_table]; + tables: [ `Text | `Html ]; + vlists: [ `Line_break | `List | `As_table ]; + hlists: [ `Minimal | `As_table ]; foldable_trees: bool; multiline_preformatted: preformatted; one_line_preformatted: preformatted; - frames: [`Quotation | `As_table]; + frames: [ `Quotation | `As_table ]; tab_width: int; } - let default = { - tables=`Text; - vlists=`List; - hlists=`Minimal; - foldable_trees=false; - multiline_preformatted=Code_block; - one_line_preformatted=Code_quote; - frames=`Quotation; - tab_width=4; - } - let uniform = { - tables=`Html; - vlists=`Line_break; - hlists=`As_table; - foldable_trees=true; - multiline_preformatted=Code_block; - one_line_preformatted=Code_quote; - frames=`As_table; - tab_width=4; - } + let default = + { + tables = `Text; + vlists = `List; + hlists = `Minimal; + foldable_trees = false; + multiline_preformatted = Code_block; + one_line_preformatted = Code_quote; + frames = `Quotation; + tab_width = 4; + } - let html_tables c = {c with tables=`Html} - let text_tables c = {c with tables=`Text} - let vlists x c = {c with vlists=x} - let hlists x c = {c with hlists=x} - let foldable_trees c = {c with foldable_trees=true} - let unfolded_trees c = {c with foldable_trees=false} - let multiline_preformatted x c = {c with multiline_preformatted=x} - let one_line_preformatted x c = {c with one_line_preformatted=x} - let tab_width x c = {c with tab_width=x} - let quotation_frames c = {c with frames=`Quotation} - let table_frames c = {c with frames=`As_table} + let uniform = + { + tables = `Html; + vlists = `Line_break; + hlists = `As_table; + foldable_trees = true; + multiline_preformatted = Code_block; + one_line_preformatted = Code_quote; + frames = `As_table; + tab_width = 4; + } + + let html_tables c = { c with tables = `Html } + let text_tables c = { c with tables = `Text } + let vlists x c = { c with vlists = x } + let hlists x c = { c with hlists = x } + let foldable_trees c = { c with foldable_trees = true } + let unfolded_trees c = { c with foldable_trees = false } + let multiline_preformatted x c = { c with multiline_preformatted = x } + let one_line_preformatted x c = { c with one_line_preformatted = x } + let tab_width x c = { c with tab_width = x } + let quotation_frames c = { c with frames = `Quotation } + let table_frames c = { c with frames = `As_table } end - let style_format c ~no_md ~multiline (s:B.Style.t) = +let style_format c ~no_md ~multiline (s : B.Style.t) = let open B.Style in (* Colors require support for styles: see issue #37 *) - let {bold; bg_color = _; fg_color = _; preformatted} = s in + let { bold; bg_color = _; fg_color = _; preformatted } = s in let preformatted_conf = - if multiline then c.Config.multiline_preformatted - else c.Config.one_line_preformatted in + if multiline then + c.Config.multiline_preformatted + else + c.Config.one_line_preformatted + in let code_block = - not no_md && preformatted && preformatted_conf = Config.Code_block in + (not no_md) && preformatted && preformatted_conf = Config.Code_block + in let code_quote = - not no_md && preformatted && preformatted_conf = Config.Code_quote in + (not no_md) && preformatted && preformatted_conf = Config.Code_quote + in let bold_pre, bold_post = match bold, no_md with | false, _ -> "", "" | true, false -> "**", "**" - | true, true -> "", "" in + | true, true -> "", "" + in let code_pre, code_post = - if code_block || code_quote || not preformatted then "", "" - else "", "" in + if code_block || code_quote || not preformatted then + "", "" + else + "", "" + in bold_pre ^ code_pre, code_post ^ bold_post, code_block, code_quote let break_lines l = let lines = List.concat @@ List.map (String.split_on_char '\n') l in - List.filter_map (fun s -> + List.filter_map + (fun s -> let len = String.length s in - if len = 0 then None - else if s.[len - 1] = '\r' then Some (String.sub s 0 (len - 1)) - else Some s) + if len = 0 then + None + else if s.[len - 1] = '\r' then + Some (String.sub s 0 (len - 1)) + else + Some s) lines let pp_string_escaped ~tab_width ~code_block ~code_quote ~html out s = let open Format in - if code_block then pp_print_string out s - else + if code_block then + pp_print_string out s + else ( let len = String.length s in - let opt_char i = if i < len then Some s.[i] else None in + let opt_char i = + if i < len then + Some s.[i] + else + None + in let print_spaces nbsp n_spaces = - if n_spaces > 0 then + if n_spaces > 0 then ( let halfsp = Array.to_list @@ Array.make ((n_spaces + 1) / 2) " " in - let trailing = if n_spaces mod 2 = 0 then nbsp else "" in - fprintf out "%s%s" (String.concat nbsp halfsp) trailing in + let trailing = + if n_spaces mod 2 = 0 then + nbsp + else + "" + in + fprintf out "%s%s" (String.concat nbsp halfsp) trailing + ) + in let print_next_spaces i = - match opt_char i, opt_char (i+1), opt_char (i+2) with - | Some ' ', Some ' ', Some ' ' when i = 0 -> pp_print_string out "·"; 1 - | Some ' ', Some ' ', Some ' ' -> pp_print_string out " ·"; 2 - | Some ' ', Some ' ', _ -> pp_print_string out "· "; 2 + match opt_char i, opt_char (i + 1), opt_char (i + 2) with + | Some ' ', Some ' ', Some ' ' when i = 0 -> + pp_print_string out "·"; + 1 + | Some ' ', Some ' ', Some ' ' -> + pp_print_string out " ·"; + 2 + | Some ' ', Some ' ', _ -> + pp_print_string out "· "; + 2 | Some '\t', Some ' ', _ when i = 0 && tab_width mod 2 = 0 -> - pp_print_string out "·"; print_spaces "·" tab_width; 2 + pp_print_string out "·"; + print_spaces "·" tab_width; + 2 | Some '\t', Some '\t', Some ' ' when i = 0 && tab_width mod 2 = 0 -> - pp_print_string out "·"; print_spaces "·" (tab_width - 1); - pp_print_string out "·"; print_spaces "·" tab_width; 2 + pp_print_string out "·"; + print_spaces "·" (tab_width - 1); + pp_print_string out "·"; + print_spaces "·" tab_width; + 2 | Some '\t', _, _ when i = 0 -> - pp_print_string out "·"; print_spaces "·" (tab_width - 1); 1 + pp_print_string out "·"; + print_spaces "·" (tab_width - 1); + 1 | Some '\t', Some ' ', _ when tab_width mod 2 = 1 -> - print_spaces "·" (tab_width + 1); 2 + print_spaces "·" (tab_width + 1); + 2 | Some '\t', Some '\t', _ when tab_width mod 2 = 1 -> - print_spaces "·" (2 * tab_width); 2 - | Some '\t', _, _ -> print_spaces "·" tab_width; 1 - | Some ' ', _, _ -> pp_print_string out " "; 1 - | _ -> assert false in + print_spaces "·" (2 * tab_width); + 2 + | Some '\t', _, _ -> + print_spaces "·" tab_width; + 1 + | Some ' ', _, _ -> + pp_print_string out " "; + 1 + | _ -> assert false + in let print_next_chars = if html then fun i -> - match opt_char i with - | Some '<' -> pp_print_string out "<"; 1 - | Some '>' -> pp_print_string out ">"; 1 - | Some '&' -> pp_print_string out "&"; 1 - | Some '\t' | Some ' ' -> print_next_spaces i - | Some c -> pp_print_char out c; 1 - | None -> len + match opt_char i with + | Some '<' -> + pp_print_string out "<"; + 1 + | Some '>' -> + pp_print_string out ">"; + 1 + | Some '&' -> + pp_print_string out "&"; + 1 + | Some '\t' | Some ' ' -> print_next_spaces i + | Some c -> + pp_print_char out c; + 1 + | None -> len else if code_quote then fun i -> - match opt_char i with - | Some '\t' | Some ' ' -> print_next_spaces i - | Some c -> pp_print_char out c; 1 - | None -> len + match opt_char i with + | Some '\t' | Some ' ' -> print_next_spaces i + | Some c -> + pp_print_char out c; + 1 + | None -> len else fun i -> - match opt_char i, opt_char (i+1), opt_char (i+2) with - | Some '<', _, _ -> pp_print_string out "\\<"; 1 - | Some '>', _, _ -> pp_print_string out "\\>"; 1 - | Some '`', _, _ -> pp_print_string out "\\`"; 1 - | Some ' ', Some '*', Some ' ' -> pp_print_string out " * "; 3 - | Some '*', _, _ -> pp_print_string out "\\*"; 1 - | Some ' ', Some '_', Some ' ' -> pp_print_string out " _ "; 3 - | Some c1, Some '_', Some c2 when c1 <> ' ' && c2 <> ' ' -> fprintf out "%c_%c" c1 c2; 3 - | Some '_', _, _ -> pp_print_string out "\\_"; 1 - | Some '\t', _, _ | Some ' ', _, _ -> print_next_spaces i - | Some c, _, _ -> pp_print_char out c; 1 - | _ -> len + match opt_char i, opt_char (i + 1), opt_char (i + 2) with + | Some '<', _, _ -> + pp_print_string out "\\<"; + 1 + | Some '>', _, _ -> + pp_print_string out "\\>"; + 1 + | Some '`', _, _ -> + pp_print_string out "\\`"; + 1 + | Some ' ', Some '*', Some ' ' -> + pp_print_string out " * "; + 3 + | Some '*', _, _ -> + pp_print_string out "\\*"; + 1 + | Some ' ', Some '_', Some ' ' -> + pp_print_string out " _ "; + 3 + | Some c1, Some '_', Some c2 when c1 <> ' ' && c2 <> ' ' -> + fprintf out "%c_%c" c1 c2; + 3 + | Some '_', _, _ -> + pp_print_string out "\\_"; + 1 + | Some '\t', _, _ | Some ' ', _, _ -> print_next_spaces i + | Some c, _, _ -> + pp_print_char out c; + 1 + | _ -> len in let i = ref 0 in let quote_pre, quote_post = - if code_quote && String.contains s '`' then "`` ", " ``" else "`", "`" in + if code_quote && String.contains s '`' then + "`` ", " ``" + else + "`", "`" + in if code_quote then pp_print_string out quote_pre; - while !i < len do i := !i + print_next_chars !i done; + while !i < len do + i := !i + print_next_chars !i + done; if code_quote then pp_print_string out quote_post + ) let rec multiline_heuristic c b = match B.view b with | B.Empty -> false - | B.Text {l=[]; _} -> false - | B.Text {l=[s]; _} -> String.contains s '\n' + | B.Text { l = []; _ } -> false + | B.Text { l = [ s ]; _ } -> String.contains s '\n' | B.Text _ -> true | B.Frame _ when c.Config.frames = `As_table -> true | B.Frame b -> multiline_heuristic c b | B.Pad (_, _) -> true - | B.Align {inner; _} -> multiline_heuristic c inner - | B.Grid (_, [|_|]) when c.Config.hlists = `As_table -> true + | B.Align { inner; _ } -> multiline_heuristic c inner + | B.Grid (_, [| _ |]) when c.Config.hlists = `As_table -> true | B.Grid (_, rows) -> - Array.length rows > 1 || Array.exists (Array.exists @@ multiline_heuristic c) rows + Array.length rows > 1 + || Array.exists (Array.exists @@ multiline_heuristic c) rows | B.Tree (_, header, children) -> Array.length children > 0 || multiline_heuristic c header - | B.Link {inner; _} -> multiline_heuristic c inner + | B.Link { inner; _ } -> multiline_heuristic c inner let rec line_of_length_heuristic_exn c b = match B.view b with - | B.Empty | B.Text {l=[]; _} -> 0 - | B.Text {l=[s]; style} -> - let from_bold = if style.B.Style.bold then 4 else 0 in + | B.Empty | B.Text { l = []; _ } -> 0 + | B.Text { l = [ s ]; style } -> + let from_bold = + if style.B.Style.bold then + 4 + else + 0 + in let from_code = - if style.B.Style.preformatted then if String.contains s '`' then 6 else 2 else 0 in - if String.contains s '\n' then raise Not_found else String.length s + from_bold + from_code + if style.B.Style.preformatted then + if String.contains s '`' then + 6 + else + 2 + else + 0 + in + if String.contains s '\n' then + raise Not_found + else + String.length s + from_bold + from_code | B.Text _ -> raise Not_found | B.Frame _ when c.Config.frames = `As_table -> raise Not_found | B.Frame b -> (* "> " or "[]" *) line_of_length_heuristic_exn c b + 2 | B.Pad (_, _) -> raise Not_found - | B.Align {inner; _} -> line_of_length_heuristic_exn c inner - | B.Grid (_, [||]) | B.Grid (_, [|[||]|]) -> 0 - | B.Grid (`None, [|row|]) when c.Config.hlists = `Minimal -> + | B.Align { inner; _ } -> line_of_length_heuristic_exn c inner + | B.Grid (_, [||]) | B.Grid (_, [| [||] |]) -> 0 + | B.Grid (`None, [| row |]) when c.Config.hlists = `Minimal -> (* "   " *) - (Array.length row - 1) * 8 + - Array.fold_left (+) 0 (Array.map (line_of_length_heuristic_exn c) row) - | B.Grid (`Bars, [|row|]) when c.Config.hlists = `Minimal -> + ((Array.length row - 1) * 8) + + Array.fold_left ( + ) 0 (Array.map (line_of_length_heuristic_exn c) row) + | B.Grid (`Bars, [| row |]) when c.Config.hlists = `Minimal -> (* " | " *) - (Array.length row - 1) * 3 + - Array.fold_left (+) 0 (Array.map (line_of_length_heuristic_exn c) row) + ((Array.length row - 1) * 3) + + Array.fold_left ( + ) 0 (Array.map (line_of_length_heuristic_exn c) row) | B.Grid _ -> raise Not_found | B.Tree (_, header, [||]) -> line_of_length_heuristic_exn c header | B.Tree _ -> raise Not_found - | B.Link {inner; uri} -> line_of_length_heuristic_exn c inner + String.length uri + 4 + | B.Link { inner; uri } -> + line_of_length_heuristic_exn c inner + String.length uri + 4 let is_native_table c rows = let rec header h = match B.view h with - | B.Text {l=[_]; style={B.Style.bold=true; _}} -> true + | B.Text { l = [ _ ]; style = { B.Style.bold = true; _ } } -> true | B.Frame b -> header b - | _ -> false in - Array.for_all header rows.(0) && - Array.for_all (fun row -> Array.for_all (Fun.negate @@ multiline_heuristic c) row) rows + | _ -> false + in + Array.for_all header rows.(0) + && Array.for_all + (fun row -> Array.for_all (Fun.negate @@ multiline_heuristic c) row) + rows let rec remove_bold b = match B.view b with - | B.Empty | B.Text {l=[]; _} -> B.empty - | B.Text {l; style} -> B.lines_with_style (B.Style.set_bold false style) l + | B.Empty | B.Text { l = []; _ } -> B.empty + | B.Text { l; style } -> B.lines_with_style (B.Style.set_bold false style) l | B.Frame b -> B.frame @@ remove_bold b | B.Pad (pos, b) -> B.pad' ~col:pos.B.x ~lines:pos.B.y @@ remove_bold b - | B.Align {h; v; inner} -> B.align ~h ~v @@ remove_bold inner + | B.Align { h; v; inner } -> B.align ~h ~v @@ remove_bold inner | B.Grid _ -> assert false | B.Tree (_, header, [||]) -> remove_bold header | B.Tree _ -> assert false - | B.Link {inner; uri} -> B.link ~uri @@ remove_bold inner - + | B.Link { inner; uri } -> B.link ~uri @@ remove_bold inner + let pp c out b = let open Format in (* We cannot use Format for indentation, because we need to insert ">" at the right places. *) let rec loop ~no_block ~no_md ~prefix b = - let br = if no_md then "
" else " " in + let br = + if no_md then + "
" + else + " " + in match B.view b with | B.Empty -> () - | B.Text {l; style} -> + | B.Text { l; style } -> let l = break_lines l in let multiline = List.length l > 1 in let sty_pre, sty_post, code_block, code_quote = - style_format c ~no_md ~multiline style in + style_format c ~no_md ~multiline style + in let preformat = - pp_string_escaped ~tab_width:c.Config.tab_width ~code_block ~code_quote ~html:no_md in + pp_string_escaped ~tab_width:c.Config.tab_width ~code_block ~code_quote + ~html:no_md + in pp_print_string out sty_pre; if code_block then fprintf out "@,%s```@,%s" prefix prefix; pp_print_list ~pp_sep:(fun out () -> - if not code_block then pp_print_string out br; - fprintf out "@,%s" prefix) + if not code_block then pp_print_string out br; + fprintf out "@,%s" prefix) preformat out l; if code_block then fprintf out "@,%s```@,%s" prefix prefix; pp_print_string out sty_post - | B.Frame fb -> ( - match c.Config.frames, c.Config.tables, no_block with + | B.Frame fb -> + (match c.Config.frames, c.Config.tables, no_block with | `As_table, `Html, _ -> (* Don't indent in case there's an embedded multiline preformatted text. *) PrintBox_html.pp ~flush:false ~indent:false () out b; if not no_md then fprintf out "@,%s@,%s" prefix prefix | `As_table, `Text, _ -> let style = B.Style.preformatted in - let l = break_lines [PrintBox_text.to_string_with ~style:false b] in + let l = break_lines [ PrintBox_text.to_string_with ~style:false b ] in loop ~no_block ~no_md ~prefix (B.lines_with_style style l) | _, _, true -> (* E.g. in a first Markdown table cell, "> " would mess up rendering. *) - fprintf out "[%a]" (fun _out -> loop ~no_block ~no_md ~prefix:(prefix ^ " ")) fb - | _ -> fprintf out "> %a" - (fun _out -> loop ~no_block ~no_md ~prefix:(prefix ^ "> ")) fb) - | B.Pad (_, b) -> + fprintf out "[%a]" + (fun _out -> loop ~no_block ~no_md ~prefix:(prefix ^ " ")) + fb + | _ -> + fprintf out "> %a" + (fun _out -> loop ~no_block ~no_md ~prefix:(prefix ^ "> ")) + fb) + | B.Pad (_, b) -> (* NOT IMPLEMENTED YET *) loop ~no_block ~no_md ~prefix b - | B.Align {h = _; v=_; inner} -> + | B.Align { h = _; v = _; inner } -> (* NOT IMPLEMENTED YET *) loop ~no_block ~no_md ~prefix inner - | B.Grid (bars, [|row|]) - when c.Config.hlists = `Minimal && - Array.for_all (Fun.negate @@ multiline_heuristic c) row -> + | B.Grid (bars, [| row |]) + when c.Config.hlists = `Minimal + && Array.for_all (Fun.negate @@ multiline_heuristic c) row -> let len = Array.length row in - Array.iteri (fun i r -> + Array.iteri + (fun i r -> loop ~no_block:true ~no_md ~prefix r; - if i < len - 1 then ( - if bars = `Bars then fprintf out " | " else fprintf out "   ")) + if i < len - 1 then + if bars = `Bars then + fprintf out " | " + else + fprintf out "   ") row | B.Grid (bars, rows) - when c.Config.vlists <> `As_table && - Array.for_all (fun row -> Array.length row = 1) rows -> ( + when c.Config.vlists <> `As_table + && Array.for_all (fun row -> Array.length row = 1) rows -> let len = Array.length rows in - match c.Config.vlists with + (match c.Config.vlists with | `As_table -> assert false | `List -> - Array.iteri (fun i r -> + Array.iteri + (fun i r -> pp_print_string out "- "; loop ~no_block ~no_md ~prefix:(prefix ^ " ") r.(0); if i < len - 1 then ( if bars = `Bars then fprintf out "@,%s > ---" prefix; - fprintf out "@,%s" prefix)) + fprintf out "@,%s" prefix + )) rows | `Line_break -> - Array.iteri (fun i r -> + Array.iteri + (fun i r -> loop ~no_block ~no_md ~prefix r.(0); - if i < len - 1 then ( - if bars = `Bars then fprintf out "%s@,%s> ---@,%s" br prefix prefix - else fprintf out "%s@,%s@,%s" br prefix prefix)) + if i < len - 1 then + if bars = `Bars then + fprintf out "%s@,%s> ---@,%s" br prefix prefix + else + fprintf out "%s@,%s@,%s" br prefix prefix) rows) | B.Grid (_, [||]) -> () | B.Grid (bars, rows) when bars <> `None && is_native_table c rows -> let n_rows = Array.length rows and n_cols = Array.length rows.(0) in let lengths = - Array.fold_left (Array.map2 (fun len b -> max len @@ line_of_length_heuristic_exn c b)) + Array.fold_left + (Array.map2 (fun len b -> max len @@ line_of_length_heuristic_exn c b)) (Array.map (fun b -> line_of_length_heuristic_exn c b - 4) rows.(0)) - @@ Array.sub rows 1 (n_rows - 1) in - Array.iteri (fun i header -> + @@ Array.sub rows 1 (n_rows - 1) + in + Array.iteri + (fun i header -> let header = remove_bold header in loop ~no_block:true ~no_md ~prefix:"" header; - if i < n_cols - 1 then + if i < n_cols - 1 then ( let len = line_of_length_heuristic_exn c header in - fprintf out "%s|" (String.make (max 0 @@ lengths.(i) - len) ' ') - ) rows.(0); + fprintf out "%s|" (String.make (max 0 @@ (lengths.(i) - len)) ' ') + )) + rows.(0); fprintf out "@,%s" prefix; - Array.iteri (fun j _ -> + Array.iteri + (fun j _ -> pp_print_string out @@ String.make lengths.(j) '-'; - if j < n_cols - 1 then pp_print_char out '|' - ) rows.(0); - Array.iteri (fun i row -> - if i > 0 then Array.iteri (fun j b -> - loop ~no_block:true ~no_md ~prefix:"" b; - if j < n_cols - 1 then - let len = line_of_length_heuristic_exn c b in - fprintf out "%s|" (String.make (max 0 @@ lengths.(j) - len) ' ') - ) row; - if i < n_rows - 1 then fprintf out "@,%s" prefix; - ) rows + if j < n_cols - 1 then pp_print_char out '|') + rows.(0); + Array.iteri + (fun i row -> + if i > 0 then + Array.iteri + (fun j b -> + loop ~no_block:true ~no_md ~prefix:"" b; + if j < n_cols - 1 then ( + let len = line_of_length_heuristic_exn c b in + fprintf out "%s|" + (String.make (max 0 @@ (lengths.(j) - len)) ' ') + )) + row; + if i < n_rows - 1 then fprintf out "@,%s" prefix) + rows | B.Grid (_, _) when c.Config.tables = `Html && String.length prefix = 0 -> PrintBox_html.pp ~flush:false ~indent:(not no_block) () out b; if not no_md then fprintf out "@,%s@,%s" prefix prefix - | B.Grid (_, _) -> ( - match c.Config.tables with + | B.Grid (_, _) -> + (match c.Config.tables with | `Text -> - let style = B.Style.preformatted in - let l = break_lines [PrintBox_text.to_string_with ~style:false b] in - loop ~no_block ~no_md ~prefix (B.lines_with_style style l) + let style = B.Style.preformatted in + let l = break_lines [ PrintBox_text.to_string_with ~style:false b ] in + loop ~no_block ~no_md ~prefix (B.lines_with_style style l) | `Html -> - let table = PrintBox_html.(if no_block then to_string else to_string_indent) b in - let lines = break_lines [table] in + let table = + PrintBox_html.( + if no_block then + to_string + else + to_string_indent) + b + in + let lines = break_lines [ table ] in pp_print_list ~pp_sep:(fun out () -> if not no_block then fprintf out "@,%s" prefix) pp_print_string out lines); - if not no_md then fprintf out "@,%s@,%s" prefix prefix + if not no_md then fprintf out "@,%s@,%s" prefix prefix | B.Tree (_extra_indent, header, [||]) -> loop ~no_block ~no_md ~prefix header | B.Tree (extra_indent, header, body) -> - if c.Config.foldable_trees - then + if c.Config.foldable_trees then fprintf out "
%a@,%s@,%s- " - (fun _out -> loop ~no_block:true ~no_md:true ~prefix) header prefix prefix - else (loop ~no_block ~no_md ~prefix header; fprintf out "@,%s- " prefix); + (fun _out -> loop ~no_block:true ~no_md:true ~prefix) + header prefix prefix + else ( + loop ~no_block ~no_md ~prefix header; + fprintf out "@,%s- " prefix + ); let pp_sep out () = fprintf out "@,%s- " prefix in let subprefix = prefix ^ String.make (2 + extra_indent) ' ' in - pp_print_list - ~pp_sep + pp_print_list ~pp_sep (fun _out sub -> loop ~no_block ~no_md ~prefix:subprefix sub) - out @@ Array.to_list body; - if c.Config.foldable_trees - then fprintf out "@,%s
@,%s@,%s" prefix prefix prefix - | B.Link {uri; inner} -> + out + @@ Array.to_list body; + if c.Config.foldable_trees then + fprintf out "@,%s@,%s@,%s" prefix prefix prefix + | B.Link { uri; inner } -> pp_print_string out "["; loop ~no_block:true ~no_md ~prefix:(prefix ^ " ") inner; - fprintf out "](%s)" uri in + fprintf out "](%s)" uri + in pp_open_vbox out 0; loop ~no_block:false ~no_md:false ~prefix:"" b; pp_close_box out () -let to_string c b = - Format.asprintf "%a@." (pp c) b +let to_string c b = Format.asprintf "%a@." (pp c) b diff --git a/src/printbox-md/PrintBox_md.mli b/src/printbox-md/PrintBox_md.mli index a627e81..ca9f134 100644 --- a/src/printbox-md/PrintBox_md.mli +++ b/src/printbox-md/PrintBox_md.mli @@ -4,8 +4,10 @@ (** {2 Markdown configuration} *) module Config : sig - type preformatted = Code_block | Code_quote - (** The output option for preformatted-style text, and for outputting tables as text. + type preformatted = + | Code_block + | Code_quote + (** The output option for preformatted-style text, and for outputting tables as text. - [Code_block]: use Markdown's backquoted-block style: [```], equivalent to HTML's [
].
         Downside: Markdown's style classes make it extra prominent.
       - [Code_quote]: use Markdown's inline code style: single quote [`].
@@ -21,11 +23,11 @@ module Config : sig
 
   val html_tables : t -> t
   (** Output tables via {!PrintBox_html}. Already the case for the {!uniform} config. *)
-  
+
   val text_tables : t -> t
   (** Output tables via {!PrintBox_text}. Already the case for the {!default} config. *)
-  
-  val vlists : [`Line_break | `List | `As_table] -> t -> t
+
+  val vlists : [ `Line_break | `List | `As_table ] -> t -> t
   (** How to output {!PrintBox.vlist} boxes, i.e. single-column grids.
       - [`Line_break]: when the {!PrintBox.vlist} has bars, it puts a quoted horizontal rule
         ["> ---"] at the bottom of a row, otherwise puts an extra empty line.
@@ -35,13 +37,13 @@ module Config : sig
         It is set in the {!default} config.
       - [`As_table] falls back to the general table printing mechanism. *)
 
-  val hlists : [`Minimal | `As_table] -> t -> t
+  val hlists : [ `Minimal | `As_table ] -> t -> t
   (** How to output {!PrintBox.hlist} boxes, i.e. single-row grids, curently only if they fit
       in one line.
       - [`Minimal] uses spaces and a horizontal bar [" | "] to separate columns.
         It is set in the {!default} config.
       - [`As_table] falls back to the general table printing mechanism. *)
-  
+
   val foldable_trees : t -> t
   (** Output trees so every node with children is foldable.
       Already the case for the {!uniform} config. *)
@@ -52,18 +54,18 @@ module Config : sig
 
   val multiline_preformatted : preformatted -> t -> t
   (* How to output multiline preformatted text, including tables when output as text. *)
-  
+
   val one_line_preformatted : preformatted -> t -> t
   (* How to output single-line preformatted text. *)
-  
+
   val tab_width : int -> t -> t
   (* One tab is this many spaces. *)
-  
-  val quotation_frames :  t -> t
+
+  val quotation_frames : t -> t
   (** Output frames using Markdown's quotation syntax [> ], or surrouding by [[]] if inline.
       Already the case for the {!default} config. *)
 
-  val table_frames :  t -> t
+  val table_frames : t -> t
   (** Output frames by falling back to the mechanism used to output tables.
       Already the case for the {!uniform} config. *)
 end
diff --git a/src/printbox-md/dune b/src/printbox-md/dune
index a1f0e01..a56abd8 100644
--- a/src/printbox-md/dune
+++ b/src/printbox-md/dune
@@ -16,5 +16,6 @@
  (target README.md)
  (mode (promote))
  (action
-  (with-outputs-to %{target}
+  (with-outputs-to
+   %{target}
    (run %{dep:readme.exe}))))
diff --git a/src/printbox-md/readme.ml b/src/printbox-md/readme.ml
index 37322bd..22c168f 100644
--- a/src/printbox-md/readme.ml
+++ b/src/printbox-md/readme.ml
@@ -6,174 +6,318 @@ module MD = PrintBox_md
 let () = print_endline {|# PrintBox-md: a Markdown backend for PrintBox
 |}
 
-let () = print_endline MD.(to_string Config.default
-  @@ B.link ~uri:"readme.ml"
-  @@ B.line "This file was generated by the readme executable.")
+let () =
+  print_endline
+    MD.(
+      to_string Config.default @@ B.link ~uri:"readme.ml"
+      @@ B.line "This file was generated by the readme executable.")
 
-let () = print_endline {|## Coverage of Markdown and `PrintBox` constructions
+let () =
+  print_endline
+    {|## Coverage of Markdown and `PrintBox` constructions
 
 ### Single-line and multiline text
 |}
 
-let () = print_endline MD.(to_string Config.default @@ B.lines [
-    "Multiline text is printed using Markdown's syntax for forced line breaks:";
-    "  a pair of trailing whitespace.";
-    "    Line wrapping is not prevented unless the text is styled as preformatted.";
-    "  However, we pay attention to whitespace in the text     --    ";
-    "we don't allow HTML to ignore the spaces."
-  ])
-
-let () = print_endline MD.(to_string Config.default @@ B.lines_with_style B.Style.preformatted [
-    "Preformatted text like this one can be output in two different styles:";
-    "  Code_block and Code_quote.";
-    "    The style can be changed for both multiline and single-line text."
-  ])
-
-let () = print_endline MD.(to_string Config.(multiline_preformatted Code_quote default)
-  @@ B.lines_with_style B.Style.preformatted [
-    "So it is possible to use [Code_quote] even with multiline text,";
-    "  which leads to a contrasting visual effect.";
-    "    Since Markdown's code quotes would otherwise     ignore whitespace,";
-    "  we use our trick to preserve -->                   these spaces."
-  ])
+let () =
+  print_endline
+    MD.(
+      to_string Config.default
+      @@ B.lines
+           [
+             "Multiline text is printed using Markdown's syntax for forced \
+              line breaks:";
+             "  a pair of trailing whitespace.";
+             "    Line wrapping is not prevented unless the text is styled as \
+              preformatted.";
+             "  However, we pay attention to whitespace in the text     --    ";
+             "we don't allow HTML to ignore the spaces.";
+           ])
+
+let () =
+  print_endline
+    MD.(
+      to_string Config.default
+      @@ B.lines_with_style B.Style.preformatted
+           [
+             "Preformatted text like this one can be output in two different \
+              styles:";
+             "  Code_block and Code_quote.";
+             "    The style can be changed for both multiline and single-line \
+              text.";
+           ])
+
+let () =
+  print_endline
+    MD.(
+      to_string Config.(multiline_preformatted Code_quote default)
+      @@ B.lines_with_style B.Style.preformatted
+           [
+             "So it is possible to use [Code_quote] even with multiline text,";
+             "  which leads to a contrasting visual effect.";
+             "    Since Markdown's code quotes would otherwise     ignore \
+              whitespace,";
+             "  we use our trick to preserve -->                   these \
+              spaces.";
+           ])
 
 let () = print_endline {|### Horizontal boxes i.e. `PrintBox.hlist`
 |}
-  
-let () = print_endline MD.(to_string Config.default @@ B.(hlist ~bars:false [
-    line "The";
-    line_with_style Style.preformatted "`Minimal";
-    line "style for horizontal boxes simply puts all entries on a line, ";
-    line "separated by extra spaces,"
-  ]))
-
-let () = print_endline MD.(to_string Config.default @@ B.(hlist ~bars:true [
-    line "or if `Bars are set,";
-    line " by the"; line "vertical dash."
-  ]))
-
-let () = print_endline MD.(to_string Config.(html_tables default) @@ B.(hlist ~bars:true [
-    lines ["It only works when"; "all the elements fit"];
-    line "logically speaking,"; line_with_style Style.bold "on a single line."
-  ]))
-
-let () = print_endline MD.(to_string Config.(html_tables @@ hlists `As_table default)
-  @@ B.(hlist ~bars:false [
-    line "Otherwise, the fallback behavior is as if";
-    line_with_style Style.preformatted "`As_table";
-    line "was used to configure horizontal boxes."
-  ]))
+
+let () =
+  print_endline
+    MD.(
+      to_string Config.default
+      @@ B.(
+           hlist ~bars:false
+             [
+               line "The";
+               line_with_style Style.preformatted "`Minimal";
+               line
+                 "style for horizontal boxes simply puts all entries on a \
+                  line, ";
+               line "separated by extra spaces,";
+             ]))
+
+let () =
+  print_endline
+    MD.(
+      to_string Config.default
+      @@ B.(
+           hlist ~bars:true
+             [
+               line "or if `Bars are set,";
+               line " by the";
+               line "vertical dash.";
+             ]))
+
+let () =
+  print_endline
+    MD.(
+      to_string Config.(html_tables default)
+      @@ B.(
+           hlist ~bars:true
+             [
+               lines [ "It only works when"; "all the elements fit" ];
+               line "logically speaking,";
+               line_with_style Style.bold "on a single line.";
+             ]))
+
+let () =
+  print_endline
+    MD.(
+      to_string Config.(html_tables @@ hlists `As_table default)
+      @@ B.(
+           hlist ~bars:false
+             [
+               line "Otherwise, the fallback behavior is as if";
+               line_with_style Style.preformatted "`As_table";
+               line "was used to configure horizontal boxes.";
+             ]))
 
 let () = print_endline {|### Vertical boxes i.e. `PrintBox.vlist`
 |}
 
-let () = print_endline MD.(to_string Config.(vlists `List default)
-  @@ B.(vlist ~bars:false [
-    line "Vertical boxes can be configured in three ways:";
-    hlist ~bars:false [
-      line_with_style Style.preformatted "`Line_break";
-      line "which simply adds an empty line after each entry"];
-    hlist ~bars:false [
-      line_with_style Style.preformatted "`List";
-      line "which lists the entries"];
-    hlist ~bars:false [
-      line "and the fallback we saw already,";
-      line_with_style Style.preformatted "`As_table"];
-  ]))
-
-let () = print_endline MD.(to_string Config.(vlists `Line_break default)
-  @@ B.(vlist ~bars:true [
-    line "Vertical boxes with bars";
-    hlist ~bars:false [
-      line_with_style Style.preformatted "(vlist ~bars:true)";
-      line "use a quoted horizontal ruler"];
-    line "to separate the entries (here with style `Line_break)."
-  ]))
+let () =
+  print_endline
+    MD.(
+      to_string Config.(vlists `List default)
+      @@ B.(
+           vlist ~bars:false
+             [
+               line "Vertical boxes can be configured in three ways:";
+               hlist ~bars:false
+                 [
+                   line_with_style Style.preformatted "`Line_break";
+                   line "which simply adds an empty line after each entry";
+                 ];
+               hlist ~bars:false
+                 [
+                   line_with_style Style.preformatted "`List";
+                   line "which lists the entries";
+                 ];
+               hlist ~bars:false
+                 [
+                   line "and the fallback we saw already,";
+                   line_with_style Style.preformatted "`As_table";
+                 ];
+             ]))
+
+let () =
+  print_endline
+    MD.(
+      to_string Config.(vlists `Line_break default)
+      @@ B.(
+           vlist ~bars:true
+             [
+               line "Vertical boxes with bars";
+               hlist ~bars:false
+                 [
+                   line_with_style Style.preformatted "(vlist ~bars:true)";
+                   line "use a quoted horizontal ruler";
+                 ];
+               line "to separate the entries (here with style `Line_break).";
+             ]))
 
 let () = print_endline {|### Frames
 |}
 
-let () = print_endline MD.(to_string Config.(vlists `Line_break default)
-  @@ B.(
-    frame @@ vlist ~bars:true [
-      line "Frames use quotation to make their content prominent";
-      hlist ~bars:false [
-        line "except when in a non-block position";
-        frame @@ line "then they use"; line "square brackets"];
-      line "(which also helps with conciseness)."
-  ]))
-
-let () = print_endline MD.(to_string Config.(table_frames @@ vlists `Line_break default)
-  @@ B.(
-    frame @@ vlist ~bars:true [
-      line "There is also a fallback";
-      hlist ~bars:false [
-        line "which generates all";
-        frame @@ line "frames, using"; line "the same approach as for tables"]
-  ]))
-
-let () = print_endline MD.(to_string Config.(table_frames @@ vlists `List default)
-  @@ B.(
-    vlist ~bars:false [
-      line "This even works OK-ish";
-      line "when the frame";
-      frame @@ line "is nested";
-      line "inside Markdown."
-  ]))
-
-let () =
-  print_endline MD.(to_string Config.(html_tables @@ table_frames @@ vlists `List default)
-  @@ B.(
-    vlist ~bars:false [
-      line "And suprisingly it works even better";
-      vlist ~bars:false [
-        line "when tables are configured";
-        frame @@ line "to fallback on";
-        line "HTML -- but it doesn't work on GitHub Preview."];
-      line "(GitHub ignores styles on 
 and  tags.)"
-  ]))
+let () =
+  print_endline
+    MD.(
+      to_string Config.(vlists `Line_break default)
+      @@ B.(
+           frame
+           @@ vlist ~bars:true
+                [
+                  line "Frames use quotation to make their content prominent";
+                  hlist ~bars:false
+                    [
+                      line "except when in a non-block position";
+                      frame @@ line "then they use";
+                      line "square brackets";
+                    ];
+                  line "(which also helps with conciseness).";
+                ]))
+
+let () =
+  print_endline
+    MD.(
+      to_string Config.(table_frames @@ vlists `Line_break default)
+      @@ B.(
+           frame
+           @@ vlist ~bars:true
+                [
+                  line "There is also a fallback";
+                  hlist ~bars:false
+                    [
+                      line "which generates all";
+                      frame @@ line "frames, using";
+                      line "the same approach as for tables";
+                    ];
+                ]))
+
+let () =
+  print_endline
+    MD.(
+      to_string Config.(table_frames @@ vlists `List default)
+      @@ B.(
+           vlist ~bars:false
+             [
+               line "This even works OK-ish";
+               line "when the frame";
+               frame @@ line "is nested";
+               line "inside Markdown.";
+             ]))
+
+let () =
+  print_endline
+    MD.(
+      to_string Config.(html_tables @@ table_frames @@ vlists `List default)
+      @@ B.(
+           vlist ~bars:false
+             [
+               line "And suprisingly it works even better";
+               vlist ~bars:false
+                 [
+                   line "when tables are configured";
+                   frame @@ line "to fallback on";
+                   line "HTML -- but it doesn't work on GitHub Preview.";
+                 ];
+               line "(GitHub ignores styles on 
 and  tags.)";
+             ]))
 
 let () = print_endline {|### Trees
 |}
 
-let () = print_endline MD.(to_string Config.default
-  @@ B.(
-    tree (line "Trees are rendered as:") [
-      line "The head element";
-      frame @@ line "followed by";
-      line "a list of the child elements."
-  ]))
+let () =
+  print_endline
+    MD.(
+      to_string Config.default
+      @@ B.(
+           tree
+             (line "Trees are rendered as:")
+             [
+               line "The head element";
+               frame @@ line "followed by";
+               line "a list of the child elements.";
+             ]))
 
-let () = print_endline MD.(to_string Config.(foldable_trees default)
-  @@ B.(
-    tree (line "Trees can be made foldable:") [
-      line "The head element";
-      frame @@ line "is the summary";
-      tree (line "and the children...") [line_with_style Style.bold "are the details."]
-  ]))
+let () =
+  print_endline
+    MD.(
+      to_string Config.(foldable_trees default)
+      @@ B.(
+           tree
+             (line "Trees can be made foldable:")
+             [
+               line "The head element";
+               frame @@ line "is the summary";
+               tree
+                 (line "and the children...")
+                 [ line_with_style Style.bold "are the details." ];
+             ]))
 
-let () = print_endline {|### Tables
+let () =
+  print_endline
+    {|### Tables
 
 There is a special case carved out for Markdown syntax tables.
 |}
 
-let () = print_endline MD.(to_string Config.default
-  @@ B.(
-    let bold = text_with_style Style.bold in
-    grid_l [
-      [ bold "Header"; bold "cells"; frame @@ bold "must be"; bold "bold." ];
-      [ line "Rows"; frame @@ line "must be"; line "single"; line "line." ];
-      [ frame @@ line "Only"; line "then"; bold "we get"; line "a Markdown table." ];
-    ]))
-
-let () = print_endline MD.(to_string Config.(html_tables default)
-  @@ B.(
-    let bold = text_with_style Style.bold in
-    let code = text_with_style Style.preformatted in
-    grid_l [
-      [ bold "Tables"; bold "that meet"; frame @@ bold "neither"; bold "of:" ];
-      [ frame @@ bold "Markdown's native"; line "restrictions,";
-        line "special cases:"; code "hlist\nvlist" ];
-      [ line "End up"; line "as either";
-        line "of the fallbacks:"; code "printbox-text\nprintbox-html" ];
-    ]))
+let () =
+  print_endline
+    MD.(
+      to_string Config.default
+      @@ B.(
+           let bold = text_with_style Style.bold in
+           grid_l
+             [
+               [
+                 bold "Header";
+                 bold "cells";
+                 frame @@ bold "must be";
+                 bold "bold.";
+               ];
+               [
+                 line "Rows";
+                 frame @@ line "must be";
+                 line "single";
+                 line "line.";
+               ];
+               [
+                 frame @@ line "Only";
+                 line "then";
+                 bold "we get";
+                 line "a Markdown table.";
+               ];
+             ]))
+
+let () =
+  print_endline
+    MD.(
+      to_string Config.(html_tables default)
+      @@ B.(
+           let bold = text_with_style Style.bold in
+           let code = text_with_style Style.preformatted in
+           grid_l
+             [
+               [
+                 bold "Tables";
+                 bold "that meet";
+                 frame @@ bold "neither";
+                 bold "of:";
+               ];
+               [
+                 frame @@ bold "Markdown's native";
+                 line "restrictions,";
+                 line "special cases:";
+                 code "hlist\nvlist";
+               ];
+               [
+                 line "End up";
+                 line "as either";
+                 line "of the fallbacks:";
+                 code "printbox-text\nprintbox-html";
+               ];
+             ]))
diff --git a/src/printbox-text/PrintBox_text.ml b/src/printbox-text/PrintBox_text.ml
index 80324ac..75ee517 100644
--- a/src/printbox-text/PrintBox_text.ml
+++ b/src/printbox-text/PrintBox_text.ml
@@ -5,8 +5,8 @@
 module B = PrintBox
 
 type position = PrintBox.position = {
-  x:int;
-  y:int;
+  x: int;
+  y: int;
 }
 
 module Style_ansi : sig
@@ -24,24 +24,32 @@ end = struct
     | Cyan -> 6
     | White -> 7
 
-  let codes_of_style (self:t) : int list =
-    let {bold;fg_color;bg_color;preformatted=_} = self in
-    (if bold then [1] else []) @
-    (match bg_color with None -> [] | Some c -> [40 + int_of_color_ c]) @
-    (match fg_color with None -> [] | Some c -> [30 + int_of_color_ c])
+  let codes_of_style (self : t) : int list =
+    let { bold; fg_color; bg_color; preformatted = _ } = self in
+    (if bold then
+      [ 1 ]
+    else
+      [])
+    @ (match bg_color with
+      | None -> []
+      | Some c -> [ 40 + int_of_color_ c ])
+    @
+    match fg_color with
+    | None -> []
+    | Some c -> [ 30 + int_of_color_ c ]
 
   let ansi_l_to_str_ = function
     | [] -> "", ""
-    | [a] -> Printf.sprintf "\x1b[%dm" a, "\x1b[0m"
-    | [a;b] -> Printf.sprintf "\x1b[%d;%dm" a b, "\x1b[0m"
+    | [ a ] -> Printf.sprintf "\x1b[%dm" a, "\x1b[0m"
+    | [ a; b ] -> Printf.sprintf "\x1b[%d;%dm" a b, "\x1b[0m"
     | l ->
       let buf = Buffer.create 16 in
       let pp_num c = Buffer.add_string buf (string_of_int c) in
       Buffer.add_string buf "\x1b[";
       List.iteri
         (fun i c ->
-           if i>0 then Buffer.add_char buf ';';
-           pp_num c)
+          if i > 0 then Buffer.add_char buf ';';
+          pp_num c)
         l;
       Buffer.add_string buf "m";
       Buffer.contents buf, "\x1b[0m"
@@ -57,26 +65,27 @@ module Pos = struct
     | 0 -> compare pos1.x pos2.x
     | x -> x
 
-  let origin = {x=0; y=0;}
-
-  let[@inline] move pos x y = {x=pos.x + x; y=pos.y + y}
-  let[@inline] (+) pos1 pos2 = move pos1 pos2.x pos2.y
-  let[@inline] (-) pos1 pos2 = move pos1 (-pos2.x) (-pos2.y)
-  let[@inline] ( * ) n pos =  {x = n*pos.x; y=n*pos.y}
+  let origin = { x = 0; y = 0 }
+  let[@inline] move pos x y = { x = pos.x + x; y = pos.y + y }
+  let[@inline] ( + ) pos1 pos2 = move pos1 pos2.x pos2.y
+  let[@inline] ( - ) pos1 pos2 = move pos1 (-pos2.x) (-pos2.y)
+  let[@inline] ( * ) n pos = { x = n * pos.x; y = n * pos.y }
   let[@inline] move_x pos x = move pos x 0
   let[@inline] move_y pos y = move pos 0 y
 end
 
-module M = Map.Make(Pos)
+module M = Map.Make (Pos)
 
 (* String length *)
 
-let str_display_len_ = ref (fun s i len ->
-    Uutf.String.fold_utf_8 ~pos:i ~len:len
-      (fun n _ c -> match c with
-         | `Malformed _ -> 0
-         | `Uchar c -> n + max 0 (Uucp.Break.tty_width_hint c))
-      0 s)
+let str_display_len_ =
+  ref (fun s i len ->
+      Uutf.String.fold_utf_8 ~pos:i ~len
+        (fun n _ c ->
+          match c with
+          | `Malformed _ -> 0
+          | `Uchar c -> n + max 0 (Uucp.Break.tty_width_hint c))
+        0 s)
 
 let[@inline] set_string_len f = str_display_len_ := f
 let[@inline] str_display_width_ s i len : int = !str_display_len_ s i len
@@ -85,12 +94,16 @@ let[@inline] str_display_width_ s i len : int = !str_display_len_ s i len
 
 module Output : sig
   type t
+
   val create : unit -> t
+
   (* val put_char : t -> position -> char -> unit *)
   val put_string : t -> position -> string -> unit
   val put_sub_string : t -> position -> string -> int -> int -> unit
+
   val put_sub_string_brack :
     t -> position -> pre:string -> string -> int -> int -> post:string -> unit
+
   val to_string : ?indent:int -> t -> string
   val to_chan : ?indent:int -> out_channel -> t -> unit
   val pp : Format.formatter -> t -> unit
@@ -101,7 +114,11 @@ end = struct
   type printable =
     (* | Char of char *)
     | String of string
-    | Str_slice of {s: string;i: int;len: int}
+    | Str_slice of {
+        s: string;
+        i: int;
+        len: int;
+      }
     | Str_slice_bracket of {
         pre: string; (* prefix *)
         s: string;
@@ -110,51 +127,55 @@ end = struct
         post: string; (* suffix *)
       }
 
-  type t = {
-    mutable m: printable M.t;
-  }
+  type t = { mutable m: printable M.t }
 
   (* Note: we trust the user not to mess things up relating to
      strings overlapping because of bad positions *)
   (* let[@inline] put_char (self:t) pos c =
      self.m <- M.add pos (Char c) self.m *)
 
-  let[@inline] put_string (self:t) pos s =
+  let[@inline] put_string (self : t) pos s =
     self.m <- M.add pos (String s) self.m
 
-  let[@inline] put_sub_string (self:t) pos s i len =
-    self.m <- M.add pos (Str_slice {s;i;len}) self.m
+  let[@inline] put_sub_string (self : t) pos s i len =
+    self.m <- M.add pos (Str_slice { s; i; len }) self.m
 
-  let[@inline] put_sub_string_brack (self:t) pos ~pre s i len ~post =
-    self.m <- M.add pos (Str_slice_bracket {pre;s;i;len;post}) self.m
+  let[@inline] put_sub_string_brack (self : t) pos ~pre s i len ~post =
+    self.m <- M.add pos (Str_slice_bracket { pre; s; i; len; post }) self.m
 
-  let create () : t = {m=M.empty}
+  let create () : t = { m = M.empty }
 
   module type OUT = sig
     type t
+
     val output_char : t -> char -> unit
     val output_string : t -> string -> unit
     val output_substring : t -> string -> int -> int -> unit
     val newline : t -> unit
   end
 
-  module Make_out(O : OUT) : sig
+  module Make_out (O : OUT) : sig
     val render : ?indent:int -> O.t -> t -> unit
   end = struct
-    let goto ?(indent=0) (out:O.t) start dest =
+    let goto ?(indent = 0) (out : O.t) start dest =
       (* Go to the line before the one we want *)
       for _i = start.y to dest.y - 2 do
-        O.newline out;
+        O.newline out
       done;
       (* Emit the last line and indent it *)
       if start.y < dest.y then (
         O.newline out;
         for _i = 1 to indent do
-          O.output_char out ' ';
+          O.output_char out ' '
         done
       );
       (* Now that we are on the correct line, go the right column. *)
-      let x_start = if start.y < dest.y then 0 else start.x in
+      let x_start =
+        if start.y < dest.y then
+          0
+        else
+          start.x
+      in
       for _i = x_start to dest.x - 1 do
         O.output_char out ' '
       done
@@ -166,7 +187,7 @@ end = struct
       | Str_slice (s,i,len) -> Printf.sprintf "%S[%d,%d]" s i len
     *)
 
-    let to_buf_aux_ ?(indent=0) (out:O.t) start_pos p curr_pos =
+    let to_buf_aux_ ?(indent = 0) (out : O.t) start_pos p curr_pos =
       assert (Pos.compare curr_pos start_pos <= 0);
       (* Go up to the expected location *)
       goto ~indent out curr_pos start_pos;
@@ -179,11 +200,11 @@ end = struct
         O.output_string out s;
         let l = !str_display_len_ s 0 (String.length s) in
         Pos.move_x start_pos l
-      | Str_slice {s; i; len} ->
+      | Str_slice { s; i; len } ->
         O.output_substring out s i len;
         let l = str_display_width_ s i len in
         Pos.move_x start_pos l
-      | Str_slice_bracket {pre; s; i; len; post} ->
+      | Str_slice_bracket { pre; s; i; len; post } ->
         O.output_string out pre;
         O.output_substring out s i len;
         (* We could use Bytes.unsafe_of_string as long as !string_len
@@ -193,52 +214,64 @@ end = struct
         let l = str_display_width_ s i len in
         Pos.move_x start_pos l
 
-    let render ?(indent=0) (out:O.t) (self:t) : unit =
-      for _i = 1 to indent do O.output_char out ' ' done;
+    let render ?(indent = 0) (out : O.t) (self : t) : unit =
+      for _i = 1 to indent do
+        O.output_char out ' '
+      done;
       ignore (M.fold (to_buf_aux_ ~indent out) self.m Pos.origin : position);
       ()
   end
 
-  module Out_buf = Make_out(struct
-      type t = Buffer.t
-      let output_char = Buffer.add_char
-      let output_string = Buffer.add_string
-      let output_substring = Buffer.add_substring
-      let newline b = Buffer.add_char b '\n'
-    end)
+  module Out_buf = Make_out (struct
+    type t = Buffer.t
+
+    let output_char = Buffer.add_char
+    let output_string = Buffer.add_string
+    let output_substring = Buffer.add_substring
+    let newline b = Buffer.add_char b '\n'
+  end)
 
   let to_string ?indent self : string =
     let buf = Buffer.create 42 in
     Out_buf.render ?indent buf self;
     Buffer.contents buf
 
-  module Out_chan = Make_out(struct
-      type t = out_channel
-      let output_char = output_char
-      let output_string = output_string
-      let output_substring = output_substring
-      let newline oc = output_char oc '\n'
-    end)
-
-  let to_chan ?indent oc self : unit =
-    Out_chan.render ?indent oc self
-
-  module Out_format = Make_out(struct
-      type t = Format.formatter
-      let output_char = Format.pp_print_char
-      let output_string = Format.pp_print_string
-      let output_substring out s i len =
-        let s = if i=0 && len=String.length s then s else String.sub s i len in
-        Format.pp_print_string out s
-      let newline out = Format.pp_print_cut out ()
-    end)
-
-  let pp out (self:t) : unit =
+  module Out_chan = Make_out (struct
+    type t = out_channel
+
+    let output_char = output_char
+    let output_string = output_string
+    let output_substring = output_substring
+    let newline oc = output_char oc '\n'
+  end)
+
+  let to_chan ?indent oc self : unit = Out_chan.render ?indent oc self
+
+  module Out_format = Make_out (struct
+    type t = Format.formatter
+
+    let output_char = Format.pp_print_char
+    let output_string = Format.pp_print_string
+
+    let output_substring out s i len =
+      let s =
+        if i = 0 && len = String.length s then
+          s
+        else
+          String.sub s i len
+      in
+      Format.pp_print_string out s
+
+    let newline out = Format.pp_print_cut out ()
+  end)
+
+  let pp out (self : t) : unit =
     Format.fprintf out "@[%a@]" (Out_format.render ~indent:0) self
 end
 
 module Box_inner : sig
   type t
+
   val of_box : B.box -> t
   val render : ansi:bool -> Output.t -> t -> unit
 end = struct
@@ -251,16 +284,16 @@ end = struct
     | Frame of 'a
     | Pad of position * 'a (* vertical and horizontal padding *)
     | Align of {
-        h: [`Left | `Center | `Right];
-        v: [`Top | `Center | `Bottom];
-        inner: 'a (* dynamic centering/alignment *)
+        h: [ `Left | `Center | `Right ];
+        v: [ `Top | `Center | `Bottom ];
+        inner: 'a; (* dynamic centering/alignment *)
       }
-    | Grid of [`Bars | `None] * 'a array array
+    | Grid of [ `Bars | `None ] * 'a array array
     | Tree of int * 'a * 'a array
 
   type t = {
-    shape : t shape;
-    size : position lazy_t;
+    shape: t shape;
+    size: position lazy_t;
   }
 
   type display_conn_basic = {
@@ -275,34 +308,25 @@ end = struct
     mutable tree: display_conn_basic;
   }
 
-  let init_connection () = {
-    nontree = {
-      left = false;
-      right = false;
-      top = false;
-      bottom = false
-    };
-    tree = {
-      left = false;
-      right = false;
-      top = false;
-      bottom = false
+  let init_connection () =
+    {
+      nontree = { left = false; right = false; top = false; bottom = false };
+      tree = { left = false; right = false; top = false; bottom = false };
     }
-  }
 
   let update_conn ?left ?right ?top ?bottom con_type =
     (match left with
-     | None -> ()
-     | Some _ -> con_type.left <- true);
+    | None -> ()
+    | Some _ -> con_type.left <- true);
     (match right with
-     | None -> ();
-     | Some _ -> con_type.right <- true);
+    | None -> ()
+    | Some _ -> con_type.right <- true);
     (match top with
-     | None -> ();
-     | Some _ -> con_type.top <- true);
-    (match bottom with
-     | None -> ();
-     | Some _ -> con_type.bottom <- true)
+    | None -> ()
+    | Some _ -> con_type.top <- true);
+    match bottom with
+    | None -> ()
+    | Some _ -> con_type.bottom <- true
 
   let disp_conn ct conn =
     let conn_basic =
@@ -310,7 +334,9 @@ end = struct
       | `Nontree -> conn.nontree
       | `Tree -> conn.tree
     in
-    match conn_basic.left, conn_basic.right, conn_basic.top, conn_basic.bottom with
+    match
+      conn_basic.left, conn_basic.right, conn_basic.top, conn_basic.bottom
+    with
     | false, false, false, false -> false
     | true, false, false, false -> false
     | false, true, false, false -> false
@@ -337,32 +363,37 @@ end = struct
     | false, true, true, true -> "├"
     | true, true, true, true -> "┼"
 
-  type display_connection_map = {
-    mutable m: display_connections M.t
-  }
-  let has_border ?(ct=`Nontree) pos disp_map =
-    let c b = if b then 1 else 0 in
+  type display_connection_map = { mutable m: display_connections M.t }
+
+  let has_border ?(ct = `Nontree) pos disp_map =
+    let c b =
+      if b then
+        1
+      else
+        0
+    in
     try
-      let conn = match ct with
+      let conn =
+        match ct with
         | `Nontree -> (M.find pos disp_map).nontree
-        | `Tree -> (M.find pos disp_map).tree in
+        | `Tree -> (M.find pos disp_map).tree
+      in
       c conn.left + c conn.right + c conn.top + c conn.bottom > 1
     with Not_found -> false
 
-  let create_or_update ?(ct=`Nontree) ?left ?right ?top ?bottom pos disp_map =
-    let (new_el, tmp_disp_map) =
+  let create_or_update ?(ct = `Nontree) ?left ?right ?top ?bottom pos disp_map =
+    let new_el, tmp_disp_map =
       try
         let el = M.find pos disp_map in
-        (el, M.remove pos disp_map)
-      with Not_found -> (init_connection (), disp_map)
+        el, M.remove pos disp_map
+      with Not_found -> init_connection (), disp_map
     in
     (match ct with
-     | `Nontree -> update_conn ?left ?right ?top ?bottom new_el.nontree
-     | `Tree -> update_conn ?left ?right ?top ?bottom new_el.tree);
+    | `Nontree -> update_conn ?left ?right ?top ?bottom new_el.nontree
+    | `Tree -> update_conn ?left ?right ?top ?bottom new_el.tree);
     M.add pos new_el tmp_disp_map
 
   let size box = Lazy.force box.size
-
   let shape b = b.shape
 
   let _array_foldi f acc a =
@@ -374,9 +405,9 @@ end = struct
   let _height_line a =
     _array_foldi
       (fun h _ box ->
-         let s = size box in
-         max h s.y
-      ) 0 a
+        let s = size box in
+        max h s.y)
+      0 a
 
   (* how large is the [i]-th column of [m]? *)
   let _width_column m i =
@@ -391,11 +422,11 @@ end = struct
     let w = ref 0 and h = ref 0 in
     Array.iter
       (fun b ->
-         let s = size b in
-         w := max !w s.x;
-         h := !h + s.y
-      ) a;
-    {x= !w; y= !h;}
+        let s = size b in
+        w := max !w s.x;
+        h := !h + s.y)
+      a;
+    { x = !w; y = !h }
 
   (* from a matrix [m] (line,column), return two arrays [lines] and [columns],
      with [col.(i)] being the start offset of column [i] and
@@ -405,16 +436,21 @@ end = struct
   let _size_matrix ~bars m =
     let dim = PrintBox.dim_matrix m in
     (* +1 is for keeping room for the vertical/horizontal line/column *)
-    let additional_space = if bars then 1 else 0 in
+    let additional_space =
+      if bars then
+        1
+      else
+        0
+    in
     (* columns *)
     let columns = Array.make (dim.x + 1) 0 in
     for i = 0 to dim.x - 1 do
-      columns.(i+1) <- columns.(i) + (_width_column m i) + additional_space
+      columns.(i + 1) <- columns.(i) + _width_column m i + additional_space
     done;
     (* lines *)
     let lines = Array.make (dim.y + 1) 0 in
-    for j = 0 to dim.y-1 do
-      lines.(j+1) <- lines.(j) + (_height_line m.(j)) + additional_space
+    for j = 0 to dim.y - 1 do
+      lines.(j + 1) <- lines.(j) + _height_line m.(j) + additional_space
     done;
     (* no trailing bars, adjust *)
     columns.(dim.x) <- columns.(dim.x) - additional_space;
@@ -423,70 +459,64 @@ end = struct
 
   let size_of_shape = function
     | Empty -> Pos.origin
-    | Text {l;style=_} ->
+    | Text { l; style = _ } ->
       let width =
         List.fold_left
-          (fun acc (s,i,len) -> max acc (str_display_width_ s i len))
+          (fun acc (s, i, len) -> max acc (str_display_width_ s i len))
           0 l
       in
-      { x=width; y=List.length l; }
+      { x = width; y = List.length l }
     | Frame t -> Pos.move (size t) 2 2
-    | Pad (dim, b') ->
-      Pos.(size b' + (2 * dim))
-    | Align {inner=b';_} -> size b'
-    | Grid (style,m) ->
-      let bars = match style with
+    | Pad (dim, b') -> Pos.(size b' + (2 * dim))
+    | Align { inner = b'; _ } -> size b'
+    | Grid (style, m) ->
+      let bars =
+        match style with
         | `Bars -> true
         | `None -> false
       in
       let dim = B.dim_matrix m in
       let lines, columns, _space_for_bars = _size_matrix ~bars m in
-      { y=lines.(dim.y); x=columns.(dim.x)}
+      { y = lines.(dim.y); x = columns.(dim.x) }
     | Tree (indent, node, children) ->
       let dim_children = _dim_vertical_array children in
       let s = size node in
-      { x=max s.x (dim_children.x+3+indent)
-      ; y=s.y + dim_children.y
-      }
+      { x = max s.x (dim_children.x + 3 + indent); y = s.y + dim_children.y }
 
-  let[@unroll 2] rec lines_ s i (k: string -> int -> int -> unit) : unit =
+  let[@unroll 2] rec lines_ s i (k : string -> int -> int -> unit) : unit =
     match String.index_from s i '\n' with
     | j ->
       k s i (j - i);
-      lines_ s (j+1) k
+      lines_ s (j + 1) k
     | exception Not_found ->
-      if i < String.length s then (
-        k s i (String.length s - i)
-      )
+      if i < String.length s then k s i (String.length s - i)
 
   let lines_l_ l k =
     match l with
     | [] -> ()
-    | [s] -> lines_ s 0 k
-    | s1::s2::tl ->
+    | [ s ] -> lines_ s 0 k
+    | s1 :: s2 :: tl ->
       lines_ s1 0 k;
       lines_ s2 0 k;
       List.iter (fun s -> lines_ s 0 k) tl
 
-  let rec of_box (b:B.t) : t =
+  let rec of_box (b : B.t) : t =
     let shape =
       match B.view b with
       | B.Empty -> Empty
-      | B.Text {l;style} ->
+      | B.Text { l; style } ->
         (* split into lines *)
         let acc = ref [] in
-        lines_l_ l (fun s i len -> acc := (s,i,len) :: !acc);
-        Text {l=List.rev !acc; style}
+        lines_l_ l (fun s i len -> acc := (s, i, len) :: !acc);
+        Text { l = List.rev !acc; style }
       | B.Frame t -> Frame (of_box t)
       | B.Pad (dim, t) -> Pad (dim, of_box t)
-      | B.Align {h;v;inner} -> Align {h;v;inner=of_box inner}
+      | B.Align { h; v; inner } -> Align { h; v; inner = of_box inner }
       | B.Grid (bars, m) -> Grid (bars, B.map_matrix of_box m)
       | B.Tree (i, b, l) -> Tree (i, of_box b, Array.map of_box l)
-      | B.Link {inner;uri} ->
+      | B.Link { inner; uri } ->
         (* just encode as a record *)
-        let self =
-          of_box (B.v_record ["uri", B.text uri; "inner", inner])
-        in
+        let self = of_box (B.v_record [ "uri", B.text uri; "inner", inner ]) in
         self.shape
     in
     { shape; size = lazy (size_of_shape shape) }
@@ -494,16 +524,22 @@ end = struct
   (** {3 Rendering} *)
 
   let write_vline_ ?ct conn_map pos n =
-    conn_map.m <- create_or_update ?ct ~bottom:true (Pos.move_y pos ~-1) conn_map.m;
-    for j=0 to n-1 do
-      conn_map.m <- create_or_update ?ct ~top:true ~bottom:true (Pos.move_y pos j) conn_map.m;
+    conn_map.m <-
+      create_or_update ?ct ~bottom:true (Pos.move_y pos ~-1) conn_map.m;
+    for j = 0 to n - 1 do
+      conn_map.m <-
+        create_or_update ?ct ~top:true ~bottom:true (Pos.move_y pos j)
+          conn_map.m
     done;
     conn_map.m <- create_or_update ?ct ~top:true (Pos.move_y pos n) conn_map.m
 
   let write_hline_ ?ct conn_map pos n =
-    conn_map.m <-  create_or_update ?ct ~right:true (Pos.move_x pos ~-1) conn_map.m;
-    for i=0 to n-1 do
-      conn_map.m <- create_or_update ?ct ~left:true ~right:true (Pos.move_x pos i) conn_map.m;
+    conn_map.m <-
+      create_or_update ?ct ~right:true (Pos.move_x pos ~-1) conn_map.m;
+    for i = 0 to n - 1 do
+      conn_map.m <-
+        create_or_update ?ct ~left:true ~right:true (Pos.move_x pos i)
+          conn_map.m
     done;
     conn_map.m <- create_or_update ?ct ~left:true (Pos.move_x pos n) conn_map.m
 
@@ -511,68 +547,86 @@ end = struct
       at the given position. [expected_size] is the size of the
       available surrounding space. [offset] is the offset of the box
       w.r.t the surrounding box *)
-  let pre_render ~ansi ?(offset=Pos.origin) ?expected_size ~out b pos =
-    let conn_m : display_connection_map = {m=M.empty} in
-    let rec render_rec ~ansi ?(offset=offset) ?expected_size b pos =
+  let pre_render ~ansi ?(offset = Pos.origin) ?expected_size ~out b pos =
+    let conn_m : display_connection_map = { m = M.empty } in
+    let rec render_rec ~ansi ?(offset = offset) ?expected_size b pos =
       match shape b with
       | Empty -> conn_m.m
-      | Text {l;style} ->
+      | Text { l; style } ->
         let ansi_prelude, ansi_suffix =
-          if ansi then Style_ansi.brackets style else "", "" in
+          if ansi then
+            Style_ansi.brackets style
+          else
+            "", ""
+        in
         let has_style = ansi_prelude <> "" || ansi_suffix <> "" in
         List.iteri
-          (fun line_idx (s,s_i,len)->
-             if has_style then (
-               Output.put_sub_string_brack out (Pos.move_y pos line_idx)
-                 ~pre:ansi_prelude s s_i len ~post:ansi_suffix
-             ) else (
-               Output.put_sub_string out (Pos.move_y pos line_idx) s s_i len
-             ))
+          (fun line_idx (s, s_i, len) ->
+            if has_style then
+              Output.put_sub_string_brack out (Pos.move_y pos line_idx)
+                ~pre:ansi_prelude s s_i len ~post:ansi_suffix
+            else
+              Output.put_sub_string out (Pos.move_y pos line_idx) s s_i len)
           l;
         conn_m.m
       | Frame b' ->
-        let {x;y} = size b' in
+        let { x; y } = size b' in
         conn_m.m <- create_or_update ~right:true ~bottom:true pos conn_m.m;
-        conn_m.m <- create_or_update ~left:true ~top:true (Pos.move pos (x+1) (y+1)) conn_m.m;
-        conn_m.m <- create_or_update ~top:true ~right:true (Pos.move pos 0 (y+1)) conn_m.m;
-        conn_m.m <- create_or_update ~left:true ~bottom:true (Pos.move pos (x+1) 0) conn_m.m;
+        conn_m.m <-
+          create_or_update ~left:true ~top:true
+            (Pos.move pos (x + 1) (y + 1))
+            conn_m.m;
+        conn_m.m <-
+          create_or_update ~top:true ~right:true
+            (Pos.move pos 0 (y + 1))
+            conn_m.m;
+        conn_m.m <-
+          create_or_update ~left:true ~bottom:true
+            (Pos.move pos (x + 1) 0)
+            conn_m.m;
         write_hline_ conn_m (Pos.move_x pos 1) x;
-        write_hline_ conn_m (Pos.move pos 1 (y+1)) x;
+        write_hline_ conn_m (Pos.move pos 1 (y + 1)) x;
         write_vline_ conn_m (Pos.move_y pos 1) y;
-        write_vline_ conn_m (Pos.move pos (x+1) 1) y;
-        let expected_size = match expected_size with
+        write_vline_ conn_m (Pos.move pos (x + 1) 1) y;
+        let expected_size =
+          match expected_size with
           | Some p -> Some (Pos.move p (-2) (-2)) (* remove space for bars *)
           | None -> None
         in
         render_rec ~ansi ?expected_size b' (Pos.move pos 1 1)
       | Pad (dim, b') ->
-        let expected_size = match expected_size with
+        let expected_size =
+          match expected_size with
           | None -> None
-          | Some p -> Some Pos.(p - (2*dim))
+          | Some p -> Some Pos.(p - (2 * dim))
         in
-        render_rec ~offset:Pos.(offset+dim) ~ansi ?expected_size b' Pos.(pos + dim)
-      | Align {h;v;inner=b'} ->
-        begin match expected_size with
-          | Some expected_size ->
-            (* add padding on the left *)
-            let hpad = match h with
-              | `Left -> 0
-              | `Center -> max 0 ((expected_size.x - (size b').x) / 2)
-              | `Right -> max 0 (expected_size.x - (size b').x)
-            and vpad = match v with
-              | `Top -> 0
-              | `Center -> max 0 ((expected_size.y - (size b').y) / 2)
-              | `Bottom -> max 0 (expected_size.y - (size b').y)
-            in
-            let pos' = Pos.move pos hpad vpad in
-            (* just render [b'] with new offset *)
-            render_rec ~offset ~ansi b' pos';
-          | None ->
-            render_rec ~ansi ~offset b' pos
-        end
-      | Grid (style,m) ->
+        render_rec
+          ~offset:Pos.(offset + dim)
+          ~ansi ?expected_size b'
+          Pos.(pos + dim)
+      | Align { h; v; inner = b' } ->
+        (match expected_size with
+        | Some expected_size ->
+          (* add padding on the left *)
+          let hpad =
+            match h with
+            | `Left -> 0
+            | `Center -> max 0 ((expected_size.x - (size b').x) / 2)
+            | `Right -> max 0 (expected_size.x - (size b').x)
+          and vpad =
+            match v with
+            | `Top -> 0
+            | `Center -> max 0 ((expected_size.y - (size b').y) / 2)
+            | `Bottom -> max 0 (expected_size.y - (size b').y)
+          in
+          let pos' = Pos.move pos hpad vpad in
+          (* just render [b'] with new offset *)
+          render_rec ~offset ~ansi b' pos'
+        | None -> render_rec ~ansi ~offset b' pos)
+      | Grid (style, m) ->
         let dim = B.dim_matrix m in
-        let bars = match style with
+        let bars =
+          match style with
           | `None -> false
           | `Bars -> true
         in
@@ -581,40 +635,63 @@ end = struct
         (* write boxes *)
         for j = 0 to dim.y - 1 do
           for i = 0 to dim.x - 1 do
-            let expected_x = match expected_size with
-              | Some es when i=dim.x-1 -> es.x - columns.(i)
-              | _ -> columns.(i+1) - columns.(i) - (if i=dim.x-1 then 0 else space_for_bars)
-            and expected_y = match expected_size with
-              | Some es when j=dim.y-1 -> es.y - lines.(j)
-              | _ -> lines.(j+1) - lines.(j)- (if j=dim.y-1 then 0 else space_for_bars)
+            let expected_x =
+              match expected_size with
+              | Some es when i = dim.x - 1 -> es.x - columns.(i)
+              | _ ->
+                columns.(i + 1)
+                - columns.(i)
+                -
+                if i = dim.x - 1 then
+                  0
+                else
+                  space_for_bars
+            and expected_y =
+              match expected_size with
+              | Some es when j = dim.y - 1 -> es.y - lines.(j)
+              | _ ->
+                lines.(j + 1)
+                - lines.(j)
+                -
+                if j = dim.y - 1 then
+                  0
+                else
+                  space_for_bars
             in
-            let expected_size = {x=expected_x; y=expected_y} in
-            let pos' = Pos.move pos (columns.(i)) (lines.(j)) in
+            let expected_size = { x = expected_x; y = expected_y } in
+            let pos' = Pos.move pos columns.(i) lines.(j) in
             conn_m.m <- render_rec ~ansi ~expected_size m.(j).(i) pos'
-          done;
+          done
         done;
 
-        let len_hlines, len_vlines = match expected_size with
+        let len_hlines, len_vlines =
+          match expected_size with
           | None -> columns.(dim.x), lines.(dim.y)
-          | Some {x;y} -> x,y
+          | Some { x; y } -> x, y
         in
 
         (* write frame if needed *)
-        begin match style with
-          | `None -> ()
-          | `Bars ->
-            for j=1 to dim.y - 1 do
-              write_hline_ conn_m (Pos.move pos (-offset.x) (lines.(j)-1)) len_hlines
-            done;
-            for i=1 to dim.x - 1 do
-              write_vline_ conn_m (Pos.move pos (columns.(i)-1) (-offset.y)) len_vlines
-            done;
-            for j=1 to dim.y - 1 do
-              for i=1 to dim.x - 1 do
-                conn_m.m <- create_or_update ~left:true ~right:true ~top:true ~bottom:true (Pos.move pos (columns.(i)-1) (lines.(j)-1)) conn_m.m
-              done
+        (match style with
+        | `None -> ()
+        | `Bars ->
+          for j = 1 to dim.y - 1 do
+            write_hline_ conn_m
+              (Pos.move pos (-offset.x) (lines.(j) - 1))
+              len_hlines
+          done;
+          for i = 1 to dim.x - 1 do
+            write_vline_ conn_m
+              (Pos.move pos (columns.(i) - 1) (-offset.y))
+              len_vlines
+          done;
+          for j = 1 to dim.y - 1 do
+            for i = 1 to dim.x - 1 do
+              conn_m.m <-
+                create_or_update ~left:true ~right:true ~top:true ~bottom:true
+                  (Pos.move pos (columns.(i) - 1) (lines.(j) - 1))
+                  conn_m.m
             done
-        end;
+          done);
         conn_m.m
       | Tree (indent, n, a) ->
         conn_m.m <- render_rec ~ansi n pos;
@@ -622,36 +699,54 @@ end = struct
         let pos' = Pos.move pos indent (size n).y in
         assert (Array.length a > 0);
         if (size n).y > 0 && has_border (Pos.move_y pos' ~-1) conn_m.m then
-           conn_m.m <- create_or_update ~ct:`Nontree ~bottom:true (Pos.move_y pos' ~-1) conn_m.m;
+          conn_m.m <-
+            create_or_update ~ct:`Nontree ~bottom:true (Pos.move_y pos' ~-1)
+              conn_m.m;
         (* To blend-in an empty tree root with a "wall" to the left: *)
         (* if (size n).y = 0 then
-          conn_m.m <- create_or_update ~ct:`Nontree ~right:true (Pos.move_x pos' ~-1) conn_m.m; *)
-        let _ = _array_foldi
+           conn_m.m <- create_or_update ~ct:`Nontree ~right:true (Pos.move_x pos' ~-1) conn_m.m; *)
+        let _ =
+          _array_foldi
             (fun pos' i b ->
-               let s = if pos'.y = pos.y then "──" else "└─" in
-               if pos'.y <> pos.y then
-                 conn_m.m <- create_or_update ~ct:`Tree ~top:true ~right:true pos' conn_m.m
-               else
-                 conn_m.m <- create_or_update ~ct:`Tree ~left:true ~right:true pos' conn_m.m;
-               conn_m.m <- create_or_update ~ct:`Tree ~left:true ~right:true (Pos.move_x pos' 1) conn_m.m;
-               conn_m.m <- create_or_update ~ct:`Tree ~top:true (Pos.move_y pos' 1) conn_m.m;
-               if i 0 && has_border child_pos conn_m.m then
-                  conn_m.m <- create_or_update ~ct:`Nontree ~left:true child_pos conn_m.m;
-               Pos.move_y pos' (size b).y
-            ) pos' a
+              let s =
+                if pos'.y = pos.y then
+                  "──"
+                else
+                  "└─"
+              in
+              if pos'.y <> pos.y then
+                conn_m.m <-
+                  create_or_update ~ct:`Tree ~top:true ~right:true pos' conn_m.m
+              else
+                conn_m.m <-
+                  create_or_update ~ct:`Tree ~left:true ~right:true pos'
+                    conn_m.m;
+              conn_m.m <-
+                create_or_update ~ct:`Tree ~left:true ~right:true
+                  (Pos.move_x pos' 1) conn_m.m;
+              conn_m.m <-
+                create_or_update ~ct:`Tree ~top:true (Pos.move_y pos' 1)
+                  conn_m.m;
+              if i < Array.length a - 1 then
+                write_vline_ ~ct:`Tree conn_m (Pos.move_y pos' 1)
+                  ((size b).y - 1);
+              let child_pos =
+                Pos.move_x pos' (str_display_width_ s 0 (String.length s))
+              in
+              conn_m.m <- render_rec ~ansi b child_pos;
+              if (size b).x > 0 && has_border child_pos conn_m.m then
+                conn_m.m <-
+                  create_or_update ~ct:`Nontree ~left:true child_pos conn_m.m;
+              Pos.move_y pos' (size b).y)
+            pos' a
         in
         conn_m.m
     in
-    render_rec ~ansi:ansi ~offset:offset ?expected_size:expected_size b pos
+    render_rec ~ansi ~offset ?expected_size b pos
 
   let post_render ~out conn_map =
     let render_conn_pos pos conn =
-      if (pos.x >= 0) && (pos.y >=0) then
+      if pos.x >= 0 && pos.y >= 0 then
         if disp_conn `Nontree conn then
           Output.put_string out pos (disp_conn_char conn.nontree)
         else if disp_conn `Tree conn then
@@ -659,18 +754,17 @@ end = struct
     in
     M.iter render_conn_pos conn_map
 
-  let render ~ansi out b =
-    post_render ~out (pre_render ~ansi ~out b Pos.origin)
+  let render ~ansi out b = post_render ~out (pre_render ~ansi ~out b Pos.origin)
 end
 
 let to_string_with ~style b =
-  let buf = Output.create() in
+  let buf = Output.create () in
   Box_inner.render ~ansi:style buf (Box_inner.of_box b);
   Output.to_string buf
 
 let to_string = to_string_with ~style:true
 
-let output ?(style=true) ?(indent=0) oc b =
+let output ?(style = true) ?(indent = 0) oc b =
   let buf = Output.create () in
   Box_inner.render ~ansi:style buf (Box_inner.of_box b);
   Output.to_chan ~indent oc buf;
diff --git a/test/dune b/test/dune
index 1446576..b2e3679 100644
--- a/test/dune
+++ b/test/dune
@@ -1,6 +1,6 @@
-
 (env
-  (_ (flags :standard -warn-error -a)))
+ (_
+  (flags :standard -warn-error -a)))
 
 (test
  (name test_ann_0_3)
@@ -14,7 +14,6 @@
  (package printbox-text)
  (libraries printbox printbox-text))
 
-
 (test
  (name test_blending)
  (modules test_blending)
@@ -38,4 +37,5 @@
  (deps test_md.expected)
  (targets test_md.expected.md)
  (mode promote)
- (action (copy %{deps} %{targets})))
+ (action
+  (copy %{deps} %{targets})))
diff --git a/test/test1.ml b/test/test1.ml
index ad63ce4..7aabf1e 100644
--- a/test/test1.ml
+++ b/test/test1.ml
@@ -2,8 +2,7 @@ module B = PrintBox
 
 (* make a square *)
 let square n =
-  Array.init n
-    (fun i -> Array.init n (fun j -> B.sprintf "(%d,%d)" i j))
+  Array.init n (fun i -> Array.init n (fun j -> B.sprintf "(%d,%d)" i j))
   |> B.grid
 
 let () =
@@ -15,94 +14,138 @@ let () =
 
 let tree =
   B.tree (B.text "root")
-    [ B.tree (B.text "a") [B.text "a1\na1"; B.text "a2\na2\na2"];
-      B.tree (B.text "b") [B.text "b1\nb1"; B.text "b2"; B.text "b3"];
+    [
+      B.tree (B.text "a") [ B.text "a1\na1"; B.text "a2\na2\na2" ];
+      B.tree (B.text "b") [ B.text "b1\nb1"; B.text "b2"; B.text "b3" ];
     ]
 
-let () =
-  PrintBox_text.output stdout tree
-
-let () =
-  Printf.printf "\n\n"
+let () = PrintBox_text.output stdout tree
+let () = Printf.printf "\n\n"
 
 let grid =
-  B.frame @@ B.grid_l
-    [ [B.text "the center of the triangle is"; B.empty];
-      [B.center_hv @@ B.text "lil' ol' me";
-       B.pad' ~col:0 ~lines:6 @@ B.text "t\na\nl\nl"];
-      [B.align_right (B.text "i'm aligned right"); B.empty];
-       [ B.text "loooooooooooooooooooooooooooooooooong"; B.empty; ];
-    ]
+  B.frame
+  @@ B.grid_l
+       [
+         [ B.text "the center of the triangle is"; B.empty ];
+         [
+           B.center_hv @@ B.text "lil' ol' me";
+           B.pad' ~col:0 ~lines:6 @@ B.text "t\na\nl\nl";
+         ];
+         [ B.align_right (B.text "i'm aligned right"); B.empty ];
+         [ B.text "loooooooooooooooooooooooooooooooooong"; B.empty ];
+       ]
 
 let () =
   PrintBox_text.output stdout grid;
   print_endline ""
 
-let b2 = PrintBox.(
+let b2 =
+  PrintBox.(
     let style = Style.(fg_color Red) in
-    frame @@ grid_l [
-      [text_with_style style "a\nb";
-       line_with_style Style.(set_bold true @@ bg_color Green) "OH!"];
-      [text "c"; text "ballot"];
-    ])
+    frame
+    @@ grid_l
+         [
+           [
+             text_with_style style "a\nb";
+             line_with_style Style.(set_bold true @@ bg_color Green) "OH!";
+           ];
+           [ text "c"; text "ballot" ];
+         ])
 
 let () =
-  PrintBox_text.output stdout b2; Printf.printf "\n\n"
+  PrintBox_text.output stdout b2;
+  Printf.printf "\n\n"
 
 let grid2 =
-  B.frame @@ B.record ~pad:B.align_right ["name1", B.int 1; "foo", B.bool true]
+  B.frame
+  @@ B.record ~pad:B.align_right [ "name1", B.int 1; "foo", B.bool true ]
 
 let () =
-  PrintBox_text.output stdout grid2; print_endline ""
+  PrintBox_text.output stdout grid2;
+  print_endline ""
 
 let grid3 =
-  B.frame @@ B.v_record ~pad:B.center_h
-    ["name_int_long", B.int 1; "foo", B.bool true; "bar!", B.int 42]
+  B.frame
+  @@ B.v_record ~pad:B.center_h
+       [ "name_int_long", B.int 1; "foo", B.bool true; "bar!", B.int 42 ]
 
 let () =
-  PrintBox_text.output stdout grid3; print_endline ""
+  PrintBox_text.output stdout grid3;
+  print_endline ""
 
 module Box_in = struct
   let b =
     let open B in
-    frame @@ grid_l [
-      [ text "a"; text "looooooooooooooooooooooooo\noonng"];
-      [ text "bx"; center_hv @@ frame @@ record ["x", int 1; "y", int 2]];
-      [ pad' ~col:2 ~lines:2 @@ text "?";
-        center_hv @@ record ["x", int 10; "y", int 20]];
-    ]
+    frame
+    @@ grid_l
+         [
+           [ text "a"; text "looooooooooooooooooooooooo\noonng" ];
+           [
+             text "bx"; center_hv @@ frame @@ record [ "x", int 1; "y", int 2 ];
+           ];
+           [
+             pad' ~col:2 ~lines:2 @@ text "?";
+             center_hv @@ record [ "x", int 10; "y", int 20 ];
+           ];
+         ]
 
   let () = print_endline @@ PrintBox_text.to_string b
 end
 
 let _b =
   let open PrintBox in
-  frame @@ record [
-    ("subject", text_with_style Style.bold "announce: printbox 0.3");
-    ("explanation",
-    frame @@ text {|PrintBox is a library for rendering nested tables,
-    trees, and similar structures in monospace text or HTML.|});
-    ("github",
-    text_with_style Style.(bg_color Blue) "https://github.com/c-cube/printbox/releases/tag/0.3");
-    ("contributors",
-     vlist_map (text_with_style Style.(fg_color Green)) ["Simon"; "Guillaume"; "Matt"]);
-    ("dependencies",
-    tree empty
-      [tree (text "mandatory")
-         [text "dune"; text "bytes"];
-       tree (text "optional")
-         [text "uutf"; text "uucp"; text "tyxml"]]);
-    ("expected reaction", text "🎉");
-  ]
+  frame
+  @@ record
+       [
+         "subject", text_with_style Style.bold "announce: printbox 0.3";
+         ( "explanation",
+           frame
+           @@ text
+                {|PrintBox is a library for rendering nested tables,
+    trees, and similar structures in monospace text or HTML.|}
+         );
+         ( "github",
+           text_with_style
+             Style.(bg_color Blue)
+             "https://github.com/c-cube/printbox/releases/tag/0.3" );
+         ( "contributors",
+           vlist_map
+             (text_with_style Style.(fg_color Green))
+             [ "Simon"; "Guillaume"; "Matt" ] );
+         ( "dependencies",
+           tree empty
+             [
+               tree (text "mandatory") [ text "dune"; text "bytes" ];
+               tree (text "optional") [ text "uutf"; text "uucp"; text "tyxml" ];
+             ] );
+         "expected reaction", text "🎉";
+       ]
 
 module Unicode = struct
   let b =
-    B.(frame @@ vlist [text "nice unicode! 💪"; frame @@
-    hlist [
-      vlist[text "oï ωεird nums:\nπ/2\nτ/4";
-        center_hv @@ tree (text "0")[text "1"; tree (text "ω") [text "ω²"]]];
-      frame @@ frame @@ frame
-      @@ vlist [text "sum=Σ_i a·xᵢ²\n—————\n1+1"; align_right @@ text "Ōₒ\nÀ"]]]);;
+    B.(
+      frame
+      @@ vlist
+           [
+             text "nice unicode! 💪";
+             frame
+             @@ hlist
+                  [
+                    vlist
+                      [
+                        text "oï ωεird nums:\nπ/2\nτ/4";
+                        center_hv
+                        @@ tree (text "0")
+                             [ text "1"; tree (text "ω") [ text "ω²" ] ];
+                      ];
+                    frame @@ frame @@ frame
+                    @@ vlist
+                         [
+                           text "sum=Σ_i a·xᵢ²\n—————\n1+1";
+                           align_right @@ text "Ōₒ\nÀ";
+                         ];
+                  ];
+           ])
 
   let () = print_endline @@ PrintBox_text.to_string b
 end
diff --git a/test/test_ann_0_3.ml b/test/test_ann_0_3.ml
index 9f69ec7..d95a2c1 100644
--- a/test/test_ann_0_3.ml
+++ b/test/test_ann_0_3.ml
@@ -1,22 +1,38 @@
-
 let b =
   let open PrintBox in
-  frame @@ grid_l [
-    [text "subject"; text_with_style Style.bold "announce: printbox 0.3"];
-    [text "explanation";
-    frame @@ text {|PrintBox is a library for rendering nested tables,
-    trees, and similar structures in monospace text or HTML.|}];
-    [text "github";
-    text_with_style Style.(bg_color Blue) "https://github.com/c-cube/printbox/releases/tag/0.3"];
-    [text "contributors";
-     vlist_map (text_with_style Style.(fg_color Green)) ["Simon"; "Guillaume"; "Matt"]];
-    [text "dependencies";
-    tree empty
-      [tree (text "mandatory")
-         [text "dune"; text "bytes"; text "uutf"; text "uucp"];
-       tree (text "optional")
-         [text "tyxml"]]];
-    [text "expected reaction"; text "🎉"];
-  ]
+  frame
+  @@ grid_l
+       [
+         [ text "subject"; text_with_style Style.bold "announce: printbox 0.3" ];
+         [
+           text "explanation";
+           frame
+           @@ text
+                {|PrintBox is a library for rendering nested tables,
+    trees, and similar structures in monospace text or HTML.|};
+         ];
+         [
+           text "github";
+           text_with_style
+             Style.(bg_color Blue)
+             "https://github.com/c-cube/printbox/releases/tag/0.3";
+         ];
+         [
+           text "contributors";
+           vlist_map
+             (text_with_style Style.(fg_color Green))
+             [ "Simon"; "Guillaume"; "Matt" ];
+         ];
+         [
+           text "dependencies";
+           tree empty
+             [
+               tree (text "mandatory")
+                 [ text "dune"; text "bytes"; text "uutf"; text "uucp" ];
+               tree (text "optional") [ text "tyxml" ];
+             ];
+         ];
+         [ text "expected reaction"; text "🎉" ];
+       ]
 
 let () = print_endline @@ PrintBox_text.to_string b
diff --git a/test/test_blending.ml b/test/test_blending.ml
index 08e2a5d..5a15b4b 100644
--- a/test/test_blending.ml
+++ b/test/test_blending.ml
@@ -1,18 +1,20 @@
 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";
-    frame @@ tree (frame @@ text "header 6") [
-      tree (frame @@ text "child 6") [frame @@ text "subchild 6"]
+  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";
+      frame
+      @@ tree
+           (frame @@ text "header 6")
+           [ tree (frame @@ text "child 6") [ frame @@ text "subchild 6" ] ];
     ]
-  ]
 
 let () = print_endline @@ PrintBox_text.to_string b
diff --git a/test/test_html.ml b/test/test_html.ml
index 195dcdd..e0bf080 100644
--- a/test/test_html.ml
+++ b/test/test_html.ml
@@ -1,16 +1,18 @@
 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"
-  ]
+  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
+let () =
+  print_endline
+  @@ PrintBox_html.(to_string ~config:Config.(tree_summary true default)) b
diff --git a/test/test_md.ml b/test/test_md.ml
index d8664ad..abac1ef 100644
--- a/test/test_md.ml
+++ b/test/test_md.ml
@@ -1,76 +1,119 @@
 let b =
   let open PrintBox in
   let table =
-    frame @@ grid_l [
-      [ text "a"; text "looooooooooooooooooooooooo\noonng"];
-      [ text "bx"; center_hv @@ frame @@ record ["x", int 1; "y", int 2]];
-      [ pad' ~col:2 ~lines:2 @@ text "?";
-        center_hv @@ record ["x", int 10; "y", int 20]];
-    ] in
+    frame
+    @@ grid_l
+         [
+           [ text "a"; text "looooooooooooooooooooooooo\noonng" ];
+           [
+             text "bx"; center_hv @@ frame @@ record [ "x", int 1; "y", int 2 ];
+           ];
+           [
+             pad' ~col:2 ~lines:2 @@ text "?";
+             center_hv @@ record [ "x", int 10; "y", int 20 ];
+           ];
+         ]
+  in
   let bold = text_with_style Style.bold in
   let native =
-    grid_l [
-      [ bold "header 1"; bold "header 2"; frame @@ bold "header 3" ];
-      [ line "cell 1.1"; frame @@ line "cell 1.2"; line "cell 1.3" ];
-      [ frame @@ line "cell 2.1"; line "cell 2.2"; bold "cell 2.3" ];
-    ] in
-  tree (frame @@ text "root") [
-    frame @@ text "child 1";
-    text_with_style Style.preformatted "child 2";
-    lines ["line 1"; "line 2"; "line 3"];
-    vlist ~bars:false [
-      line "a row 1"; lines ["a row 2.1"; "a row 2.2"]; frame @@ line "a row 3"];
-    vlist ~bars:true [
-      line "b row 1"; lines ["b row 2.1"; "b row 2.2"]; bold "b row 3"];
-    hlist ~bars:false [
-      bold "a longiiish column 1"; line "a longiiish column 2";
-      frame @@ line "a longiiish column 3"; line "a longiiish column 4"];
-    hlist ~bars:true [
-      line "b longiiish column 1"; bold "b longiiish column 2";
-      line "b longiiish column 3"; frame @@ line "b longiiish column 4"];
-    frame @@ vlist ~bars:true [
-      line "c row 1"; lines ["c row 2.1"; "c row 2.2"]; line "c row 3"
-    ];
-    frame @@ tree empty [
-      tree (frame @@ text "header 3") [frame @@ text "subchild 3"]
-    ];
-    tree empty [
-      tree (frame @@ text "header 4") [
-        tree (text "") [text_with_style Style.preformatted ""];
-        text "& **subchild** 4"]
-    ];
-    frame @@ tree (text_with_style Style.preformatted "header 5")
-      [lines_with_style Style.preformatted
-        ["subchild 5"; "  body 5"; "    subbody 5";
-         "\tone tab end of sub 5"; "end of 5"]];
-    frame table;
-    native;
-    frame native
-  ]
+    grid_l
+      [
+        [ bold "header 1"; bold "header 2"; frame @@ bold "header 3" ];
+        [ line "cell 1.1"; frame @@ line "cell 1.2"; line "cell 1.3" ];
+        [ frame @@ line "cell 2.1"; line "cell 2.2"; bold "cell 2.3" ];
+      ]
+  in
+  tree
+    (frame @@ text "root")
+    [
+      frame @@ text "child 1";
+      text_with_style Style.preformatted "child 2";
+      lines [ "line 1"; "line 2"; "line 3" ];
+      vlist ~bars:false
+        [
+          line "a row 1";
+          lines [ "a row 2.1"; "a row 2.2" ];
+          frame @@ line "a row 3";
+        ];
+      vlist ~bars:true
+        [ line "b row 1"; lines [ "b row 2.1"; "b row 2.2" ]; bold "b row 3" ];
+      hlist ~bars:false
+        [
+          bold "a longiiish column 1";
+          line "a longiiish column 2";
+          frame @@ line "a longiiish column 3";
+          line "a longiiish column 4";
+        ];
+      hlist ~bars:true
+        [
+          line "b longiiish column 1";
+          bold "b longiiish column 2";
+          line "b longiiish column 3";
+          frame @@ line "b longiiish column 4";
+        ];
+      frame
+      @@ vlist ~bars:true
+           [
+             line "c row 1"; lines [ "c row 2.1"; "c row 2.2" ]; line "c row 3";
+           ];
+      frame
+      @@ tree empty
+           [ tree (frame @@ text "header 3") [ frame @@ text "subchild 3" ] ];
+      tree empty
+        [
+          tree
+            (frame @@ text "header 4")
+            [
+              tree (text "")
+                [ text_with_style Style.preformatted "" ];
+              text "& **subchild** 4";
+            ];
+        ];
+      frame
+      @@ tree
+           (text_with_style Style.preformatted "header 5")
+           [
+             lines_with_style Style.preformatted
+               [
+                 "subchild 5";
+                 "  body 5";
+                 "    subbody 5";
+                 "\tone tab end of sub 5";
+                 "end of 5";
+               ];
+           ];
+      frame table;
+      native;
+      frame native;
+    ]
 
 let () = print_endline "Test default:"
-
 let () = print_endline @@ PrintBox_md.(to_string Config.default) b
-
 let () = print_endline "Test uniform unfolded:\n"
 
-let () = print_endline @@ PrintBox_md.(to_string Config.(unfolded_trees uniform)) b
+let () =
+  print_endline @@ PrintBox_md.(to_string Config.(unfolded_trees uniform)) b
 
 let () = print_endline "Test foldable:"
 
-let () = print_endline @@ PrintBox_md.(to_string Config.(foldable_trees default)) b
+let () =
+  print_endline @@ PrintBox_md.(to_string Config.(foldable_trees default)) b
 
 let () = print_endline "Test uniform tab=2, text tables:"
 
 let () =
-  print_endline @@
-  PrintBox_md.(to_string Config.(text_tables @@ tab_width 2 uniform)) b
+  print_endline
+  @@ PrintBox_md.(to_string Config.(text_tables @@ tab_width 2 uniform)) b
 
 let () = print_endline "Test single quote tab=2, text tables:"
 
 let () =
-  print_endline @@
-    PrintBox_md.(to_string Config.(
-       text_tables @@ tab_width 2 @@ multiline_preformatted Code_quote uniform)) b
+  print_endline
+  @@ PrintBox_md.(
+       to_string
+         Config.(
+           text_tables @@ tab_width 2
+           @@ multiline_preformatted Code_quote uniform))
+       b
 
 let () = print_endline "The end."