1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
type alignment = L | C | R
module Column = struct
type t = {
align : alignment;
min_length : int;
max_length : int;
left_border : string;
right_border : string;
}
let default =
{
align = L;
min_length = 0;
max_length = max_int;
left_border = "";
right_border = "";
}
let make ?(min_length = 0) ?(max_length = max_int) ?(left_border = "")
?(right_border = "") ?(align = L) () =
{ align; min_length; max_length; left_border; right_border }
let pp ppf t k s =
Format.pp_print_string ppf t.left_border;
let l = String.length s in
(if k < l then (
for i = 0 to k - 4 do
Format.pp_print_char ppf (String.get s i)
done;
for _ = 1 to min 3 k do
Format.pp_print_char ppf '.'
done)
else
match t.align with
| L ->
Format.pp_print_string ppf s;
for _ = 1 to k - l do
Format.pp_print_char ppf ' '
done
| C ->
for _ = 1 to (k - l) / 2 do
Format.pp_print_char ppf ' '
done;
Format.pp_print_string ppf s;
for _ = 1 to (k - l + 1) / 2 do
Format.pp_print_char ppf ' '
done
| R ->
for _ = 1 to k - l do
Format.pp_print_char ppf ' '
done;
Format.pp_print_string ppf s);
Format.fprintf ppf "%s" t.right_border
end
type t = {
header : Column.t array;
sizes : int array;
mutable next : int;
mutable rows : string array option array;
}
let make =
if Array.length header = 0 then raise @@ Invalid_argument "empty table"
else
let sizes = Array.map (fun c -> c.Column.min_length) header in
let rows = Array.make 64 None in
{ header; sizes; next = 0; rows }
let appendi t row =
let length = Array.length t.rows in
if t.next = length then
t.rows <-
Array.init (2 * length) (fun i -> if i < length then t.rows.(i) else None);
t.rows.(t.next) <- row;
t.next <- t.next + 1
let append t data =
if Array.length data <> Array.length t.header then
raise @@ Invalid_argument "column lengths mismatch";
Array.iteri
(fun i s ->
let l = String.length s in
if t.sizes.(i) < l && l <= t.header.(i).Column.max_length then
t.sizes.(i) <- l)
data;
appendi t (Some data)
let pp ppf t =
let pp_row row =
Format.pp_open_hovbox ppf 0;
let l = Array.length t.header - 1 in
for c = 0 to l - 1 do
Column.pp ppf t.header.(c) t.sizes.(c) row.(c);
Format.pp_print_space ppf ()
done;
Column.pp ppf t.header.(l) t.sizes.(l) row.(l);
Format.pp_close_box ppf ()
in
Format.pp_open_vbox ppf 0;
for r = 0 to t.next - 2 do
pp_row @@ Option.get t.rows.(r);
Format.pp_force_newline ppf ()
done;
pp_row @@ Option.get t.rows.(t.next - 1);
Format.pp_close_box ppf ()