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
let escape s =
let b = Buffer.create (String.length s) in
String.iter
(fun c ->
match c with
| '<' -> Buffer.add_string b "<"
| '>' -> Buffer.add_string b ">"
| '&' -> Buffer.add_string b "&"
| '"' -> Buffer.add_string b """
| c -> Buffer.add_char b c)
s;
Buffer.contents b
let alignment_attr = function
| Types.Left -> "left"
| Types.Right -> "right"
| Types.Center -> "center"
let render_th (c : Doc.aligned_text) =
"<th align=\""
^ alignment_attr c.Doc.alignment
^ "\">"
^ escape (String.trim c.Doc.text)
^ "</th>"
let render_td (c : Doc.aligned_text) =
"<td align=\""
^ alignment_attr c.Doc.alignment
^ "\">"
^ escape (String.trim c.Doc.text)
^ "</td>"
let render_tr cell_fn cells =
"<tr>" ^ String.concat "" (List.map cell_fn cells) ^ "</tr>"
let get_cells = function
| Doc.Block items -> List.filter_map (function Doc.Cell c -> Some c | _ -> None) items
| _ -> []
let render_rows cell_fn items =
List.concat_map
(function
| Doc.Block row_items ->
let cells =
List.filter_map (function Doc.Cell c -> Some c | _ -> None) row_items
in
if cells <> [] then [ render_tr cell_fn cells ]
else
List.filter_map
(function
| Doc.Block _ as b ->
let c = get_cells b in
if c <> [] then Some (render_tr cell_fn c) else None
| _ -> None)
row_items
| _ -> [])
items
let render doc =
match doc with
| Doc.Empty -> ""
| Doc.Cell c -> escape (String.trim c.Doc.text)
| Doc.Line -> ""
| Doc.Block items ->
let rec split acc = function
| [] -> (List.rev acc, false, [])
| Doc.Line :: rest -> (List.rev acc, true, rest)
| x :: rest -> split (x :: acc) rest
in
let before, has_line, after = split [] items in
let head =
if not has_line then ""
else
"<thead>\n"
^ String.concat "\n" (render_rows render_th before)
^ "\n</thead>"
in
let body_rows =
render_rows render_td (if has_line then after else before)
in
let body = "<tbody>\n" ^ String.concat "\n" body_rows ^ "\n</tbody>" in
let inner = if head = "" then body else head ^ "\n" ^ body in
"<table>\n" ^ inner ^ "\n</table>"