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
|
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
(* Turn a raw sexplib exception string into something a person editing an
overlay can act on.
The derived parsers report failures as [Of_sexp_error] carrying the
OCaml source path of the converter that failed, e.g.
(Of_sexp_error "lib/rites/rite_ef/vocab_ef.ml.rank_of_sexp:
unexpected variant constructor" (invalid_sexp Class9))
which names a file the reader does not have and buries the one useful
token (Class9) at the end. A user writing a diocesan calendar is the
most likely person to hit this and the least likely to read OCaml.
An earlier version of this lived in overlay.ml and rewrote five
hardcoded module paths; anything else -- a rank, a layer entry, the
top-level record -- came through raw. This one is generic, so a
converter added later is covered without being listed. *)
let ends_with ~suffix s =
let ls = String.length s and lf = String.length suffix in
ls >= lf && String.sub s (ls - lf) lf = suffix
(* "lib/kernel/layer.ml.entry_of_sexp" -> "entry"
"lib/kernel/overlay.ml.t_of_sexp" -> "overlay" (t is the module itself) *)
let noun_of_converter tok =
match String.index_opt tok '/' with
| None when not (String.length tok > 4 && String.sub tok 0 4 = "lib/") -> None
| _ ->
let dot_ml = ".ml." in
let n = String.length tok and d = String.length dot_ml in
let rec find i =
if i > n - d then None
else if String.sub tok i d = dot_ml then Some i
else find (i + 1)
in
Option.bind (find 0) (fun i ->
let fn = String.sub tok (i + d) (n - i - d) in
if not (ends_with ~suffix:"_of_sexp" fn) then None
else
let base = String.sub fn 0 (String.length fn - 8) in
if base <> "t" then Some base
else
(* fall back to the module's own name *)
let path = String.sub tok 0 i in
let start =
match String.rindex_opt path '/' with
| Some j -> j + 1
| None -> 0
in
Some (String.sub path start (String.length path - start)))
let replace ~sub ~by s =
let n = String.length sub and len = String.length s in
if n = 0 then s
else
let b = Buffer.create len in
let i = ref 0 in
while !i <= len - n do
if String.sub s !i n = sub then begin
Buffer.add_string b by;
i := !i + n
end
else begin
Buffer.add_char b s.[!i];
incr i
end
done;
Buffer.add_string b (String.sub s !i (len - !i));
Buffer.contents b
(* Every whitespace/paren-delimited token that looks like a converter path. *)
let rec humanise msg =
let is_sep c = c = ' ' || c = '"' || c = '(' || c = ')' || c = '\n' in
let out = ref msg in
let n = String.length msg in
let i = ref 0 in
while !i < n do
if is_sep msg.[!i] then incr i
else begin
let start = !i in
while !i < n && not (is_sep msg.[!i]) do incr i done;
let tok = String.sub msg start (!i - start) in
let tok = if ends_with ~suffix:":" tok then String.sub tok 0 (String.length tok - 1) else tok in
match noun_of_converter tok with
| Some noun -> out := replace ~sub:tok ~by:noun !out
| None -> ()
end
done;
!out
(* sexplib's own phrasing, in the reader's terms. Order matters: the
longer "... for record expected" forms are rewritten before the
shorter ones so no stray "expected" is left behind. *)
|> replace ~sub:"unexpected variant constructor" ~by:"is not one of the allowed values"
|> replace ~sub:"list instead of atom for record expected"
~by:"expected a record, found a plain value"
|> replace ~sub:"atom instead of list for record expected"
~by:"expected a record, found a plain value"
|> replace ~sub:"extra fields" ~by:"unknown field(s)"
|> replace ~sub:"element of list" ~by:"item"
|> strip_wrapper
(* [(Of_sexp_error "MSG" (invalid_sexp VALUE))] -> [MSG (at VALUE)].
The wrapper is the parser's own structure, not anything the reader
wrote, and leaving it in makes an error look like more sexp to debug. A
long VALUE is truncated: the offending FIELD is what identifies the
problem, and echoing an entire record -- or, when the file is not a
calendar at all, a line of its contents -- is noise at best and leaks
file content into logs at worst. *)
and strip_wrapper msg =
(* sexplib PRETTY-PRINTS the exception, so the wrapper is followed by a
newline and indentation rather than a single space. Collapse all
whitespace first, or the prefix match silently never fires and every
message comes through raw -- which is exactly what happened on the
first attempt at this. *)
let msg =
String.concat " "
(List.filter (fun w -> w <> "")
(String.split_on_char ' '
(String.map (function '\n' | '\t' | '\r' -> ' ' | c -> c) msg)))
in
let msg = String.trim msg in
let strip_prefix p s =
let lp = String.length p in
if String.length s >= lp && String.sub s 0 lp = p then
Some (String.sub s lp (String.length s - lp))
else None
in
match strip_prefix "(Of_sexp_error " msg with
| None -> msg
| Some rest ->
let rest = String.trim rest in
let body, value =
match String.index_opt rest '"' with
| Some 0 -> (
match String.index_from_opt rest 1 '"' with
| Some close ->
let m = String.sub rest 1 (close - 1) in
let tail = String.trim (String.sub rest (close + 1)
(String.length rest - close - 1)) in
(m, tail)
| None -> (rest, ""))
| _ -> (rest, "")
in
let value =
match strip_prefix "(invalid_sexp " value with
| Some v ->
let v = String.trim v in
(* Drop the closing parens of BOTH wrappers -- invalid_sexp's and
Of_sexp_error's -- keeping any that belong to the value
itself, by removing only the excess over what the value
opens. *)
let v =
let opens = ref 0 and closes = ref 0 in
String.iter
(function '(' -> incr opens | ')' -> incr closes | _ -> ())
v;
let excess = ref (!closes - !opens) in
let b = Buffer.create (String.length v) in
let n = String.length v in
let i = ref (n - 1) in
let tail = ref [] in
while !i >= 0 do
(if v.[!i] = ')' && !excess > 0 then decr excess
else tail := v.[!i] :: !tail);
decr i
done;
List.iter (Buffer.add_char b) !tail;
Buffer.contents b
in
let v = String.concat " " (String.split_on_char '\n' v) in
let v = String.trim v in
if String.length v > 60 then String.sub v 0 57 ^ "..." else v
| None -> ""
in
if value = "" then body else body ^ " (at " ^ value ^ ")"
|
