aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/citation/book.ml116
-rw-r--r--lib/citation/parse.ml54
-rw-r--r--lib/kernel/layer.ml4
-rw-r--r--lib/kernel/overlay.ml22
-rw-r--r--lib/kernel/overlay_ini.ml13
-rw-r--r--lib/kernel/sexp_error.ml177
-rw-r--r--lib/kernel/sexp_error.mli4
7 files changed, 317 insertions, 73 deletions
diff --git a/lib/citation/book.ml b/lib/citation/book.ml
index 2a2b9c0..986a898 100644
--- a/lib/citation/book.ml
+++ b/lib/citation/book.ml
@@ -12,57 +12,57 @@ let to_string t = t
the lectionary and was the source of every token missed in the first
pass. *)
let table =
- [ ("genesis", [ "Gen" ]);
- ("exodus", [ "Ex"; "Exod" ]);
- ("leviticus", [ "Lev" ]);
- ("numbers", [ "Num" ]);
- ("kings_3", [ "3 Kings"; "3 Kgs." ]);
- ("kings_4", [ "4 Kings" ]);
- ("esdras_2", [ "2 Esd." ]);
- ("tobit", [ "Tob" ]);
- ("judith", [ "Judith" ]);
- ("esther", [ "Esther" ]);
- ("proverbs", [ "Prov" ]);
- ("song_of_songs", [ "Song" ]);
- ("wisdom", [ "Wis"; "Wis." ]);
- ("ecclesiasticus", [ "Ecclus"; "Sir"; "Eccli" ]);
- ("isaiah", [ "Isa"; "Isa." ]);
- ("jeremiah", [ "Jer" ]);
- ("ezekiel", [ "Ezech"; "Ezek" ]);
- ("daniel", [ "Dan" ]);
- ("osee", [ "Osee" ]);
- ("joel", [ "Joel" ]);
- ("jonas", [ "Jonas" ]);
- ("malachi", [ "Mal" ]);
- ("matthew", [ "Matt"; "Matt." ]);
- ("mark", [ "Mark" ]);
- ("luke", [ "Luke" ]);
- ("john", [ "John" ]);
- ("acts", [ "Acts" ]);
- ("romans", [ "Rom" ]);
- ("corinthians_1", [ "1 Cor"; "1 Cor." ]);
- ("corinthians_2", [ "2 Cor"; "2 Cor." ]);
- ("galatians", [ "Gal" ]);
- ("ephesians", [ "Eph"; "Eph." ]);
- ("philippians", [ "Phil" ]);
- ("colossians", [ "Col"; "Col." ]);
- ("thessalonians_1", [ "1 Thess"; "1 Thess." ]);
- ("thessalonians_2", [ "2 Thess" ]);
- ("timothy_1", [ "1 Tim." ]);
- ("timothy_2", [ "2 Tim"; "2 Tim." ]);
- ("titus", [ "Titus" ]);
- ("hebrews", [ "Heb" ]);
- ("james", [ "Jas"; "James" ]);
- ("peter_1", [ "1 Pet"; "1 Pet." ]);
- ("peter_2", [ "2 Pet." ]);
- ("john_1", [ "1 John" ]);
+ [ ("genesis", [ "Gen"; "Liber Genesis"; "Genesis" ]);
+ ("exodus", [ "Ex"; "Exod"; "Liber Exodi"; "Exodus" ]);
+ ("leviticus", [ "Lev"; "Levit"; "Liber Levitici"; "Leviticus" ]);
+ ("numbers", [ "Num"; "Liber Numeri"; "Numbers" ]);
+ ("kings_3", [ "3 Kings"; "3 Kgs."; "3 Reg"; "Liber Regum III" ]);
+ ("kings_4", [ "4 Kings"; "4 Reg"; "Liber Regum IV"; "4 Kgs." ]);
+ ("esdras_2", [ "2 Esd."; "2 Esdr"; "Liber Esdrae"; "2 Esdras" ]);
+ ("tobit", [ "Tob"; "Liber Tobiae"; "Tobias" ]);
+ ("judith", [ "Judith"; "Iudith"; "Liber Iudith"; "Jth" ]);
+ ("esther", [ "Esther"; "Esth"; "Liber Esther" ]);
+ ("proverbs", [ "Prov"; "Proverbs" ]);
+ ("song_of_songs", [ "Song"; "Cant."; "Canticle of Canticles" ]);
+ ("wisdom", [ "Wis"; "Wis."; "Sap"; "Liber Sapientiae"; "Wisdom" ]);
+ ("ecclesiasticus", [ "Ecclus"; "Sir"; "Eccli"; "Ecclesiasticus" ]);
+ ("isaiah", [ "Isa"; "Isa."; "Isai"; "Isaias Propheta"; "Isaias" ]);
+ ("jeremiah", [ "Jer"; "Ier"; "Ieremias Propheta"; "Jeremias" ]);
+ ("ezekiel", [ "Ezech"; "Ezek"; "Ezechiel Propheta"; "Ezechiel" ]);
+ ("daniel", [ "Dan"; "Daniel Propheta"; "Daniel" ]);
+ ("osee", [ "Osee"; "Osee Propheta" ]);
+ ("joel", [ "Joel"; "Ioel"; "Ioel Propheta" ]);
+ ("jonas", [ "Jonas"; "Ionae"; "Ionas Propheta" ]);
+ ("malachi", [ "Mal"; "Malach"; "Malachias Propheta"; "Malachias" ]);
+ ("matthew", [ "Matt"; "Matt."; "Matth"; "Evangelium secundum Matthaeum"; "Matthew" ]);
+ ("mark", [ "Mark"; "Marc"; "Evangelium secundum Marcum" ]);
+ ("luke", [ "Luke"; "Luc"; "Evangelium secundum Lucam" ]);
+ ("john", [ "John"; "Ioann"; "Evangelium secundum Ioannem" ]);
+ ("acts", [ "Acts"; "Act"; "Actus Apostolorum"; "Acts of the Apostles" ]);
+ ("romans", [ "Rom"; "Epistola ad Romanos"; "Romans" ]);
+ ("corinthians_1", [ "1 Cor"; "1 Cor."; "Epistola I ad Corinthios"; "1 Corinthians" ]);
+ ("corinthians_2", [ "2 Cor"; "2 Cor."; "Epistola II ad Corinthios"; "2 Corinthians" ]);
+ ("galatians", [ "Gal"; "Epistola ad Galatas"; "Galatians" ]);
+ ("ephesians", [ "Eph"; "Eph."; "Ephes"; "Epistola ad Ephesios"; "Ephesians" ]);
+ ("philippians", [ "Phil"; "Epistola ad Philippenses"; "Philippians" ]);
+ ("colossians", [ "Col"; "Col."; "Epistola ad Colossenses"; "Colossians" ]);
+ ("thessalonians_1", [ "1 Thess"; "1 Thess."; "Epistola I ad Thessalonicenses"; "1 Thessalonians" ]);
+ ("thessalonians_2", [ "2 Thess"; "Epistola II ad Thessalonicenses"; "2 Thessalonians" ]);
+ ("timothy_1", [ "1 Tim."; "1 Tim"; "Epistola I ad Timotheum"; "1 Timothy" ]);
+ ("timothy_2", [ "2 Tim"; "2 Tim."; "Epistola II ad Timotheum"; "2 Timothy" ]);
+ ("titus", [ "Titus"; "Tit"; "Epistola ad Titum" ]);
+ ("hebrews", [ "Heb"; "Hebr"; "Epistola ad Hebraeos"; "Hebrews" ]);
+ ("james", [ "Jas"; "James"; "Iac"; "Epistola beati Iacobi Apostoli" ]);
+ ("peter_1", [ "1 Pet"; "1 Pet."; "1 Petri"; "Epistola I beati Petri Apostoli"; "1 Peter" ]);
+ ("peter_2", [ "2 Pet."; "2 Petri"; "Epistola II beati Petri Apostoli"; "2 Pet"; "2 Peter" ]);
+ ("john_1", [ "1 John"; "1 Ioann"; "Epistola beati Ioannis Apostoli" ]);
(* "Apoc" is the Vulgate spelling and "Rev" its modern equivalent, but
BOTH sit inside Vulgate-tradition data, so both resolve to the same
Vulgate id here -- see book.mli's note by [apocalypse] never being an
[of_token] result under that name. Do not add "revelation" as a
spelling: it exists only as a tradition target (below), and giving it
an [of_token] entry would let one book carry two different ids. *)
- ("apocalypse", [ "Apoc"; "Rev" ]) ]
+ ("apocalypse", [ "Apoc"; "Rev"; "Liber Apocalypsis"; "Apocalypse" ]) ]
(* Targets a tradition can map ONTO that the Vulgate data never cites
directly. Present so [tradition_of_fields] can validate both sides.
@@ -70,16 +70,34 @@ let table =
"Sir" and "Rev" already resolve to the Vulgate ids [ecclesiasticus] and
[apocalypse] above, so a modern-numbering tradition maps ONTO these
targets rather than data ever citing them directly. *)
-let tradition_targets =
- [ "kings_1"; "kings_2"; "nehemiah"; "sirach"; "hosea"; "jonah"; "revelation" ]
+
+(* The modern-numbering targets. They have table rows so that colitur's OWN
+ rendered output re-parses: with --sigla-tradition modern the book prints
+ as "1 Reg" or "1 Kings", and a user copying that back into an overlay must
+ get it read correctly. The shipped data never cites them directly, which
+ is why they are listed apart. *)
+let tradition_target_table =
+ [
+ ("kings_1", [ "1 Reg"; "Liber Regum I"; "1 Kgs"; "1 Kings" ]);
+ ("kings_2", [ "2 Reg"; "Liber Regum II"; "2 Kgs"; "2 Kings" ]);
+ ("nehemiah", [ "Neh"; "Liber Nehemiae"; "Nehemiah" ]);
+ ("sirach", [ "Liber Ecclesiastici"; "Sirach" ]);
+ ("hosea", [ "Os"; "Hos"; "Hosea" ]);
+ ("jonah", [ "Ion"; "Jon"; "Jonah" ]);
+ ("revelation", [ "Apocalypsis"; "Revelation" ]);
+ ]
+
+let tradition_targets = List.map fst tradition_target_table
let all = List.map fst table @ tradition_targets
let tokens =
- List.concat_map (fun (id, sp) -> List.map (fun s -> (s, id)) sp) table
+ List.concat_map
+ (fun (id, sp) -> List.map (fun s -> (s, id)) sp)
+ (table @ tradition_target_table)
let default_spelling id =
- match List.assoc_opt id table with
+ match List.assoc_opt id (table @ tradition_target_table) with
| Some (first :: _) -> first
| Some [] | None -> id
diff --git a/lib/citation/parse.ml b/lib/citation/parse.ml
index 45fbb72..2f2316e 100644
--- a/lib/citation/parse.ml
+++ b/lib/citation/parse.ml
@@ -9,7 +9,41 @@ let split_on c s = String.split_on_char c s |> List.map String.trim
(* The book is the longest leading run of non-digit words, allowing one
leading ordinal ("1 Cor", "3 Kings"). Everything after it is the
reference tail. *)
+(* Longest REGISTERED token that prefixes [s] and is followed by a space and
+ a digit. This is what lets a MULTI-WORD title parse: the heuristic below
+ stops at the first space, so "Evangelium secundum Lucam 5:12-14" would
+ otherwise split as the book "Evangelium" and fail.
+
+ Longest-match matters and is not decoration: "Liber Regum III" and
+ "Liber Regum IV" share a prefix with each other, and a shortest-match
+ would read both as some other book entirely. *)
+let longest_token_prefix s =
+ let n = String.length s in
+ let best = ref None in
+ List.iter
+ (fun (tok, _) ->
+ let tl = String.length tok in
+ if
+ tl < n
+ && String.sub s 0 tl = tok
+ && s.[tl] = ' '
+ (* a digit must follow, or "Job" would swallow the start of a
+ different book whose name merely begins the same way *)
+ && (let j = ref (tl + 1) in
+ while !j < n && s.[!j] = ' ' do incr j done;
+ !j < n && s.[!j] >= '0' && s.[!j] <= '9')
+ then
+ match !best with
+ | Some (b, _) when String.length b >= tl -> ()
+ | _ -> best := Some (tok, String.trim (String.sub s tl (n - tl)))
+ )
+ Book.tokens;
+ !best
+
let split_book s =
+ match longest_token_prefix s with
+ | Some (book, tail) when tail <> "" -> Some (book, tail)
+ | _ ->
let n = String.length s in
let i = ref 0 in
(* optional leading ordinal digit *)
@@ -25,7 +59,21 @@ let split_book s =
let tail = String.trim (String.sub s !i (n - !i)) in
if book = "" || tail = "" then None else Some (book, tail)
-let int_opt s = int_of_string_opt (String.trim s)
+(* A citation number is PLAIN DIGITS and positive -- nothing else.
+ [int_of_string_opt] also accepts OCaml's own integer-literal syntax, so
+ "1_1" would read as 11 and "+5" as 5: a transcription typo silently
+ becoming a DIFFERENT chapter, which nothing downstream could detect. A
+ user overlay supplies arbitrary strings, so this is reachable, not
+ theoretical. Chapter and verse numbering both start at 1, so zero is
+ rejected too. *)
+let int_opt s =
+ let s = String.trim s in
+ let ok =
+ s <> ""
+ && String.for_all (function '0' .. '9' -> true | _ -> false) s
+ in
+ if not ok then None
+ else match int_of_string_opt s with Some n when n > 0 -> Some n | _ -> None
(* "20-32" -> {first=20; last=Some 32}; "21" -> {first=21; last=None} *)
let parse_range s =
@@ -33,7 +81,9 @@ let parse_range s =
| [ a ] -> ( match int_opt a with Some f -> Some { first = f; last = None } | None -> None)
| [ a; b ] -> (
match (int_opt a, int_opt b) with
- | Some f, Some l -> Some { first = f; last = Some l }
+ (* A descending range ("1:20-10") is always a transcription error;
+ accepting it would render back out as a citation nobody can follow. *)
+ | Some f, Some l when l >= f -> Some { first = f; last = Some l }
| _ -> None)
| _ -> None
diff --git a/lib/kernel/layer.ml b/lib/kernel/layer.ml
index ec074a7..f069546 100644
--- a/lib/kernel/layer.ml
+++ b/lib/kernel/layer.ml
@@ -85,11 +85,11 @@ let load rank_of_sexp path =
unterminated list or string) rather than [Sexplib.Sexp.Parse_error], so a
catch-all here -- placed last among the exception branches -- is what
actually keeps every parse failure inside [Error] instead of escaping. *)
- | exception exn -> Error (Printf.sprintf "%s: %s" path (Printexc.to_string exn))
+ | exception exn -> Error (Printf.sprintf "%s: %s" path (Sexp_error.humanise (Printexc.to_string exn)))
| sexp -> (
match t_of_sexp rank_of_sexp sexp with
| t -> Ok { t with entries = canonical t.entries }
(* [rank_of_sexp] is caller-supplied and may raise anything, not only
[Of_sexp_error] -- mirrors [Overlay.load]'s catch-all, so "never as
an exception" (layer.mli) actually holds. *)
- | exception exn -> Error (Printf.sprintf "%s: %s" path (Printexc.to_string exn)))
+ | exception exn -> Error (Printf.sprintf "%s: %s" path (Sexp_error.humanise (Printexc.to_string exn))))
diff --git a/lib/kernel/overlay.ml b/lib/kernel/overlay.ml
index 58d8847..516379d 100644
--- a/lib/kernel/overlay.ml
+++ b/lib/kernel/overlay.ml
@@ -132,23 +132,6 @@ let fill_defaults ~id sexp =
actually reach a user into the vocabulary of the file they are looking at.
Anything unrecognised passes through verbatim rather than being reworded
into something possibly wrong. *)
-let humanise_error msg =
- let replace ~sub ~by s =
- let n = String.length sub and len = String.length s in
- let rec go i acc =
- if i > len - n then acc ^ String.sub s i (len - i)
- else if String.equal (String.sub s i n) sub then go (i + n) (acc ^ by)
- else go (i + 1) (acc ^ String.make 1 s.[i])
- in
- if n = 0 then s else go 0 ""
- in
- msg
- |> replace ~sub:"lib/kernel/celebration.ml.t_of_sexp" ~by:"celebration"
- |> replace ~sub:"lib/kernel/colour.ml.t_of_sexp" ~by:"colour"
- |> replace ~sub:"lib/kernel/subject.ml.t_of_sexp" ~by:"subject"
- |> replace ~sub:"lib/kernel/date_spec.ml.t_of_sexp" ~by:"date"
- |> replace ~sub:"lib/kernel/overlay.ml.directive_of_sexp" ~by:"directive"
-
let load rank_of_sexp path =
match Sexplib.Sexp.load_sexp path with
| exception Sys_error msg -> Error msg
@@ -157,7 +140,8 @@ let load rank_of_sexp path =
[Sexplib.Sexp.Parse_error], so a catch-all here -- placed last among the
exception branches -- is what actually keeps every parse failure inside
[Error] instead of escaping. *)
- | exception exn -> Error (Printf.sprintf "%s: %s" path (Printexc.to_string exn))
+ | exception exn ->
+ Error (Printf.sprintf "%s: %s" path (Sexp_error.humanise (Printexc.to_string exn)))
| sexp -> (
(* The overlay's own [id] is needed to default [layer], so read it off
the raw sexp first. If it is missing or malformed the derived parser
@@ -174,4 +158,4 @@ let load rank_of_sexp path =
match t_of_sexp rank_of_sexp (fill_defaults ~id sexp) with
| t -> Ok t
| exception exn ->
- Error (Printf.sprintf "%s: %s" path (humanise_error (Printexc.to_string exn))))
+ Error (Printf.sprintf "%s: %s" path (Sexp_error.humanise (Printexc.to_string exn))))
diff --git a/lib/kernel/overlay_ini.ml b/lib/kernel/overlay_ini.ml
index 6b6249f..09f6d52 100644
--- a/lib/kernel/overlay_ini.ml
+++ b/lib/kernel/overlay_ini.ml
@@ -37,7 +37,18 @@ let parse_sections text =
end
else
match String.index_opt line '=' with
- | None -> err "line %d: %S is neither a [section] nor a key = value line" n line
+ | None ->
+ (* Echo at most a little of the line. Pointing at line N is
+ what locates the problem; reproducing the whole line adds
+ nothing and, when someone has pointed a --lang or --overlay
+ flag at a file that is not a calendar at all, quietly
+ copies that file's contents into stderr and any log
+ collecting it. *)
+ let shown =
+ if String.length line > 40 then String.sub line 0 37 ^ "..."
+ else line
+ in
+ err "line %d: %S is neither a [section] nor a key = value line" n shown
| Some i ->
if !cur = None then
err "line %d: %S appears before any [section] header" n line
diff --git a/lib/kernel/sexp_error.ml b/lib/kernel/sexp_error.ml
new file mode 100644
index 0000000..88cc139
--- /dev/null
+++ b/lib/kernel/sexp_error.ml
@@ -0,0 +1,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 ^ ")"
diff --git a/lib/kernel/sexp_error.mli b/lib/kernel/sexp_error.mli
new file mode 100644
index 0000000..d3de75b
--- /dev/null
+++ b/lib/kernel/sexp_error.mli
@@ -0,0 +1,4 @@
+(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+
+(** Human-readable form of a raw sexplib exception string. *)
+val humanise : string -> string