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
open TomlTypes
module Parser = struct
open Lexing
type location = {
source: string;
line: int;
column: int;
position: int;
}
type result = [`Ok of TomlTypes.table | `Error of (string * location)]
let parse lexbuf source =
try
let result = TomlParser.toml TomlLexer.tomlex lexbuf in
`Ok result
with (TomlParser.Error | Failure _) as error ->
let formatted_error_msg = match error with
| Failure failure_msg -> Printf.sprintf ": %s" failure_msg
| _ -> ""
in
let location = {
source = source;
line = lexbuf.lex_curr_p.pos_lnum;
column = (lexbuf.lex_curr_p.pos_cnum - lexbuf.lex_curr_p.pos_bol);
position = lexbuf.lex_curr_p.pos_cnum;
} in
let msg =
Printf.sprintf "Error in %s at line %d at column %d (position %d)%s"
source location.line location.column location.position formatted_error_msg
in
`Error (msg, location)
let from_string s = parse (Lexing.from_string s) "<string>"
let from_channel c = parse (Lexing.from_channel c) "<channel>"
let from_filename f = parse (open_in f |> Lexing.from_channel) f
exception Error of (string * location)
(** A combinator to force the result. Raise [Error] if the result was [`Ok] *)
let unsafe result =
match result with
| `Ok toml_table -> toml_table
| `Error (msg, location) -> raise (Error (msg, location))
end
module Compare = struct
let rec list_compare ~f l1 l2 = match l1, l2 with
| head1::tail1, head2::tail2 ->
let comp_result = f head1 head2 in
if comp_result != 0 then
comp_result
else
list_compare ~f tail1 tail2
| [], head2::tail2 -> -1
| head1::tail1, [] -> 1
| [], [] -> 0
let rec value (x : TomlTypes.value) (y : TomlTypes.value) = match x, y with
| TArray x, TArray y -> array x y
| TTable x, TTable y -> table x y
| _, _ -> compare x y
and array (x : TomlTypes.array) (y : TomlTypes.array) = match x, y with
| NodeTable nt1, NodeTable nt2 -> list_compare ~f:table nt1 nt2
| _ -> compare x y
and table (x : TomlTypes.table) (y : TomlTypes.table) =
TomlTypes.Table.compare value x y
end
module Printer = struct
let value formatter toml_value = TomlPrinter.value formatter toml_value
let table formatter toml_table = TomlPrinter.table formatter toml_table
let array formatter toml_array = TomlPrinter.array formatter toml_array
let string_of_value = TomlPrinter.string_of_value
let string_of_table = TomlPrinter.string_of_table
let string_of_array = TomlPrinter.string_of_array
end
let key = TomlTypes.Table.Key.bare_key_of_string
let of_key_values = TomlTypes.Table.of_key_values