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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
open Types
let maybe_escape_char formatter ch =
match ch with
| '"' -> Format.pp_print_string formatter "\\\""
| '\\' -> Format.pp_print_string formatter "\\\\"
| '\n' -> Format.pp_print_string formatter "\\n"
| '\t' -> Format.pp_print_string formatter "\\t"
| _ ->
let code = Char.code ch in
if code <= 31 then Format.fprintf formatter "\\u%04x" code
else Format.pp_print_char formatter ch
let print_bool formatter value = Format.pp_print_bool formatter value
let print_int formatter value = Format.pp_print_int formatter value
let print_float formatter value =
let fractional = abs_float (value -. floor value) in
(* Even 1.'s fractional value is not equal to 0. *)
if fractional <= epsilon_float then Format.fprintf formatter "%.1f" value
else Format.pp_print_float formatter value
let print_string formatter value =
let has_newline = ref false in
let has_quote = ref false in
let has_doublequote = ref false in
String.iter
(function
| '\n' -> has_newline := true
| '\'' -> has_quote := true
| '"' -> has_doublequote := true
| _ -> () )
value;
match (!has_newline, !has_doublequote, !has_quote) with
| true, false, _ ->
Format.pp_print_string formatter {|"""|};
String.iter
(function
| '\n' -> Format.pp_print_newline formatter ()
| c -> maybe_escape_char formatter c )
value;
Format.pp_print_string formatter {|"""|}
| true, true, false ->
Format.pp_print_string formatter "'''\n";
Format.pp_print_string formatter value;
Format.pp_print_string formatter "'''"
| _ ->
Format.pp_print_char formatter '"';
String.iter (maybe_escape_char formatter) value;
Format.pp_print_char formatter '"'
let print_date fmt d = ISO8601.Permissive.pp_datetimezone fmt (d, 0.)
(* This function is a shim for [Format.pp_print_list] from ocaml 4.02 *)
let pp_print_list ~pp_sep print_item_func formatter values =
match values with
| [] -> ()
| [ e ] -> print_item_func formatter e
| e :: l ->
print_item_func formatter e;
List.iter
(fun v ->
pp_sep formatter ();
print_item_func formatter v )
l
let is_table _ = function
| TTable _ -> true
| TArray (NodeTable _) -> true
| _ -> false
let is_array_of_table _ = function TArray (NodeTable _) -> true | _ -> false
let rec print_array formatter toml_array sections =
let print_list values ~f:print_item_func =
let pp_sep formatter () = Format.pp_print_string formatter ", " in
Format.pp_print_char formatter '[';
pp_print_list ~pp_sep print_item_func formatter values;
Format.pp_print_char formatter ']'
in
match toml_array with
| NodeBool values -> print_list values ~f:print_bool
| NodeInt values -> print_list values ~f:print_int
| NodeFloat values -> print_list values ~f:print_float
| NodeString values -> print_list values ~f:print_string
| NodeDate values -> print_list values ~f:print_date
| NodeArray values ->
print_list values ~f:(fun formatter arr ->
print_array formatter arr sections )
| NodeTable values ->
List.iter
(fun tbl ->
(*
* Don't print the intermediate sections, if all values are arrays of tables,
* print [[x.y.z]] as appropriate instead of [[x]][[y]][[z]]
*)
if not (Types.Table.for_all is_array_of_table tbl) then
Format.fprintf formatter "[[%s]]\n"
(sections |> List.map Types.Table.Key.to_string |> String.concat ".");
print_table formatter tbl sections )
values
| NodeEmpty -> Format.pp_print_string formatter "[]"
and print_table formatter toml_table sections =
(*
* We need to print non-table values first, otherwise we risk including
* top-level values in a section by accident
*)
let table_with_table_values, table_with_non_table_values =
Types.Table.partition is_table toml_table
in
let print_key_value key value =
print_value_with_key formatter key value sections
in
(* iter() guarantees that keys are returned in ascending order *)
Types.Table.iter print_key_value table_with_non_table_values;
Types.Table.iter print_key_value table_with_table_values
and print_value formatter toml_value sections =
match toml_value with
| TBool value -> print_bool formatter value
| TInt value -> print_int formatter value
| TFloat value -> print_float formatter value
| TString value -> print_string formatter value
| TDate value -> print_date formatter value
| TArray value -> print_array formatter value sections
| TTable value -> print_table formatter value sections
and print_value_with_key formatter key toml_value sections =
let sections', add_linebreak =
match toml_value with
| TTable value ->
let sections_with_key = sections @ [ key ] in
(*
* Don't print the intermediate sections, if all values are tables,
* print [x.y.z] as appropriate instead of [x][y][z]
*)
if not (Types.Table.for_all is_table value) then
Format.fprintf formatter "[%s]\n"
( sections_with_key
|> List.map Types.Table.Key.to_string
|> String.concat "." );
(sections_with_key, false)
| TArray (NodeTable _tables) ->
let sections_with_key = sections @ [ key ] in
(sections_with_key, false)
| _ ->
Format.fprintf formatter "%s = " (Types.Table.Key.to_string key);
(sections, true)
in
print_value formatter toml_value sections';
if add_linebreak then Format.pp_print_char formatter '\n'
let value formatter toml_value =
print_value formatter toml_value [];
Format.pp_print_flush formatter ()
let array formatter toml_array =
match toml_array with
| NodeTable _t ->
(* We need the parent section for printing an array of table correctly,
otheriwise the header contains [[]] *)
invalid_arg "Cannot format array of tables, use Toml.Printer.table"
| _ ->
print_array formatter toml_array [];
Format.pp_print_flush formatter ()
let table formatter toml_table =
print_table formatter toml_table [];
Format.pp_print_flush formatter ()
let mk_printer fn x =
let b = Buffer.create 100 in
let fmt = Format.formatter_of_buffer b in
fn fmt x;
Buffer.contents b
let string_of_table = mk_printer table
let string_of_value = mk_printer value
let string_of_array = mk_printer array