Merge branch 'robustness-and-hackability'

An audit of the shipped program, plus the fixes it found.

The citation parser accepted OCaml integer-literal syntax, so a typo like
'Luke 1_1:5' silently became a different chapter. Four pairs of different
books shared a full title -- 1 and 2 Corinthians both rendered 'Epistola
ad Corinthios' -- leaving 108 citations in 2027 alone that a reader could
not resolve to a book. Spec section 8.5 is now delivered rather than
recorded: shipped styles re-parse their own output. Overlay errors no
longer name OCaml source files at the reader.

Also: the new-overlay scaffold shows citations at the right nesting
level, config --show validates before printing, error messages no longer
echo whole file lines, and a month answers to both spellings of its own
name.

5 files changed, 198 insertions, 22 deletions

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