From 405910d2fd245e7a11e09eecb8c6fffb68d2169c Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Thu, 20 Aug 2026 14:40:12 +0200 Subject: feat(citation): canonical book ids and tradition mapping Seven books arrive in two spellings, inherited from lectio's ini and ultimately from Divinum Officium. Collapse them onto one id here rather than editing generated data. Naming and renumbering are kept apart: a tradition decides which book an id denotes, a language file decides what it is called. --- lib/citation/book.ml | 74 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 74 insertions(+) create mode 100644 lib/citation/book.ml (limited to 'lib/citation/book.ml') diff --git a/lib/citation/book.ml b/lib/citation/book.ml new file mode 100644 index 0000000..a2f9678 --- /dev/null +++ b/lib/citation/book.ml @@ -0,0 +1,74 @@ +(* SPDX-License-Identifier: AGPL-3.0-or-later *) + +type id = string + +let to_string t = t + +(* Every book the shipped EF lectionary cites, with every spelling it uses. + The dotted/undotted pairs are inherited from lectio -- see book.mli. *) +let table = + [ ("genesis", [ "Gen" ]); + ("exodus", [ "Ex" ]); + ("leviticus", [ "Lev" ]); + ("numbers", [ "Num" ]); + ("kings_3", [ "3 Kings"; "3 Kgs." ]); + ("kings_4", [ "4 Kings" ]); + ("esdras_2", [ "2 Esd." ]); + ("esther", [ "Esther" ]); + ("ecclesiasticus", [ "Ecclus" ]); + ("isaiah", [ "Isa"; "Isa." ]); + ("jeremiah", [ "Jer" ]); + ("ezekiel", [ "Ezech" ]); + ("daniel", [ "Dan" ]); + ("osee", [ "Osee" ]); + ("joel", [ "Joel" ]); + ("jonas", [ "Jonas" ]); + ("matthew", [ "Matt"; "Matt." ]); + ("mark", [ "Mark" ]); + ("luke", [ "Luke" ]); + ("john", [ "John" ]); + ("acts", [ "Acts" ]); + ("romans", [ "Rom" ]); + ("corinthians_1", [ "1 Cor"; "1 Cor." ]); + ("corinthians_2", [ "2 Cor." ]); + ("galatians", [ "Gal" ]); + ("ephesians", [ "Eph"; "Eph." ]); + ("philippians", [ "Phil" ]); + ("colossians", [ "Col" ]); + ("thessalonians_1", [ "1 Thess"; "1 Thess." ]); + ("thessalonians_2", [ "2 Thess" ]); + ("titus", [ "Titus" ]); + ("hebrews", [ "Heb" ]); + ("james", [ "Jas" ]); + ("peter_1", [ "1 Pet"; "1 Pet." ]); + ("john_1", [ "1 John" ]) ] + +(* Targets a tradition can map ONTO that the Vulgate data never cites + directly. Present so [tradition_of_fields] can validate both sides. *) +let tradition_targets = + [ "kings_1"; "kings_2"; "nehemiah"; "sirach"; "hosea"; "jonah" ] + +let all = List.map fst table @ tradition_targets + +let tokens = + List.concat_map (fun (id, sp) -> List.map (fun s -> (s, id)) sp) table + +let of_token s = + let s = String.trim s in + List.assoc_opt s tokens + +type tradition = (string * string) list + +let vulgate = [] + +let known id = List.mem id all + +let tradition_of_fields fields = + List.filter (fun (a, b) -> known a && known b) fields + +let unknown_fields fields = + List.filter_map + (fun (a, b) -> if known a && known b then None else Some a) + fields + +let map tr id = match List.assoc_opt id tr with Some x -> x | None -> id -- cgit v1.3 From a4eb9ed3cd93cbac493a873991dd5817906aad56 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Thu, 20 Aug 2026 14:54:01 +0200 Subject: fix(citation): survey all three citation-bearing files, not just the lectionary The book table was built against data/ef/lectionary.sexp alone. That undercounts: sanctoral.sexp carries more citations than the lectionary and, together with commons.sexp, cites 21 book tokens the table was missing entirely (62 distinct tokens across all three files, not 42), several of them common (2 Tim appears 8+ times). Add the missing spellings to existing ids (2 Cor, Col., Exod, Ezek, James, Sir, Eccli) and ten new ids for books not cited before (1-2 Timothy, 2 Peter, Apocalypse, Judith, Malachi, Proverbs, Song of Songs, Tobit, Wisdom). Sir and Rev are modern spellings sitting inside Vulgate data, so both resolve to their Vulgate ids (ecclesiasticus, apocalypse) rather than to the sirach/revelation tradition targets -- mapping them to a second id would double-map the same book. Add a duplicate-spelling invariant test (List.assoc_opt would silently prefer the first match on a collision) and a test that re-derives the token set from all three data files at test time and asserts every token resolves, rather than trusting a survey performed once by hand. --- lib/citation/book.ml | 47 ++++++++++++++++----- lib/citation/book.mli | 21 +++++++--- test/test_citation.ml | 113 ++++++++++++++++++++++++++++++++++++++++++++++++-- 3 files changed, 161 insertions(+), 20 deletions(-) (limited to 'lib/citation/book.ml') diff --git a/lib/citation/book.ml b/lib/citation/book.ml index a2f9678..545e324 100644 --- a/lib/citation/book.ml +++ b/lib/citation/book.ml @@ -4,25 +4,36 @@ type id = string let to_string t = t -(* Every book the shipped EF lectionary cites, with every spelling it uses. - The dotted/undotted pairs are inherited from lectio -- see book.mli. *) +(* Every book cited across the shipped EF data (lectionary, sanctoral + propers, and commons), with every spelling any of the three files uses. + The dotted/undotted and modern/Vulgate pairs are inherited from lectio -- + see book.mli. Surveyed directly against the data, all three files, not + the lectionary alone -- sanctoral.sexp alone carries more citations than + the lectionary and was the source of every token missed in the first + pass. *) let table = [ ("genesis", [ "Gen" ]); - ("exodus", [ "Ex" ]); + ("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" ]); - ("ecclesiasticus", [ "Ecclus" ]); + ("proverbs", [ "Prov" ]); + ("song_of_songs", [ "Song" ]); + ("wisdom", [ "Wis"; "Wis." ]); + ("ecclesiasticus", [ "Ecclus"; "Sir"; "Eccli" ]); ("isaiah", [ "Isa"; "Isa." ]); ("jeremiah", [ "Jer" ]); - ("ezekiel", [ "Ezech" ]); + ("ezekiel", [ "Ezech"; "Ezek" ]); ("daniel", [ "Dan" ]); ("osee", [ "Osee" ]); ("joel", [ "Joel" ]); ("jonas", [ "Jonas" ]); + ("malachi", [ "Mal" ]); ("matthew", [ "Matt"; "Matt." ]); ("mark", [ "Mark" ]); ("luke", [ "Luke" ]); @@ -30,23 +41,37 @@ let table = ("acts", [ "Acts" ]); ("romans", [ "Rom" ]); ("corinthians_1", [ "1 Cor"; "1 Cor." ]); - ("corinthians_2", [ "2 Cor." ]); + ("corinthians_2", [ "2 Cor"; "2 Cor." ]); ("galatians", [ "Gal" ]); ("ephesians", [ "Eph"; "Eph." ]); ("philippians", [ "Phil" ]); - ("colossians", [ "Col" ]); + ("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", [ "Jas"; "James" ]); ("peter_1", [ "1 Pet"; "1 Pet." ]); - ("john_1", [ "1 John" ]) ] + ("peter_2", [ "2 Pet." ]); + ("john_1", [ "1 John" ]); + (* "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" ]) ] (* Targets a tradition can map ONTO that the Vulgate data never cites - directly. Present so [tradition_of_fields] can validate both sides. *) + directly. Present so [tradition_of_fields] can validate both sides. + [sirach] and [revelation] exist ONLY here, never as an [of_token] result: + "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" ] + [ "kings_1"; "kings_2"; "nehemiah"; "sirach"; "hosea"; "jonah"; "revelation" ] let all = List.map fst table @ tradition_targets diff --git a/lib/citation/book.mli b/lib/citation/book.mli index dd04e0d..8918bc3 100644 --- a/lib/citation/book.mli +++ b/lib/citation/book.mli @@ -15,11 +15,19 @@ val to_string : id -> string (** Resolve one spelling as it appears in the data. Returns [None] for anything not in {!tokens}. - SEVEN books arrive in two spellings ([Isa]/[Isa.], [3 Kgs.]/[3 Kings], - and five more). That inconsistency is INHERITED from lectio's own ini, - which is itself generated from missalemeum/Divinum Officium -- it is not - a colitur transcription error, and the data is deliberately left - untouched. Both spellings resolve here instead. *) + SIXTEEN books arrive in more than one spelling, surveyed across all + three citation-bearing files ([lectionary.sexp], [sanctoral.sexp], + [commons.sexp] -- not the lectionary alone, which undercounts: the + sanctoral propers alone carry more citations than the lectionary does). + Most are a dotted/undotted pair ([Isa]/[Isa.], [3 Kgs.]/[3 Kings], and + others); two also carry a MODERN spelling sitting inside otherwise- + Vulgate data ([Sir] alongside [Ecclus]/[Eccli], [Rev] alongside [Apoc]). + All of this is INHERITED from lectio's own ini, which is itself + generated from missalemeum/Divinum Officium -- it is not a colitur + transcription error, and the data is deliberately left untouched. Every + accepted spelling resolves here to the same, single Vulgate id: [Sir] + resolves to [ecclesiasticus] and [Rev] to [apocalypse], never to the + tradition-only targets [sirach]/[revelation] -- see those below. *) val of_token : string -> id option (** Every id this build knows, for coverage checks. *) @@ -44,6 +52,9 @@ val vulgate : tradition {!unknown_fields} to report them. *) val tradition_of_fields : (string * string) list -> tradition +(** The fields {!tradition_of_fields} silently dropped -- either side naming + an id outside {!all}. Never raises; a caller that cares can report these, + a caller that does not can ignore the return value entirely. *) val unknown_fields : (string * string) list -> string list val map : tradition -> id -> id diff --git a/test/test_citation.ml b/test/test_citation.ml index 0694d8b..7bc8ac7 100644 --- a/test/test_citation.ml +++ b/test/test_citation.ml @@ -3,8 +3,11 @@ module B = Colitur_citation.Book let s = Alcotest.string let test_both_spellings_are_one_book () = - (* The seven inherited duplicate spellings must collapse. This is the - whole reason the parser exists rather than a regex. *) + (* The books listed here arrive in more than one spelling and must + collapse onto one id. This is the whole reason the parser exists rather + than a regex. Most pairs are dotted/undotted; "Sir"/"Ecclus" and + "Apoc"/"Rev" are a modern spelling sitting inside otherwise-Vulgate + data -- see book.mli. *) let same a b = match B.of_token a, B.of_token b with | Some x, Some y -> @@ -17,7 +20,16 @@ let test_both_spellings_are_one_book () = same "1 Pet" "1 Pet."; same "1 Thess" "1 Thess."; same "Eph" "Eph."; - same "3 Kgs." "3 Kings" + same "3 Kgs." "3 Kings"; + same "Sir" "Ecclus"; + same "Apoc" "Rev"; + same "2 Cor" "2 Cor."; + same "Col" "Col."; + same "Wis" "Wis."; + same "2 Tim" "2 Tim."; + same "Ex" "Exod"; + same "Ezech" "Ezek"; + same "Jas" "James" let test_unknown_token_is_none () = Alcotest.(check bool) "not a book" true (B.of_token "Nonesuch" = None) @@ -35,9 +47,102 @@ let test_modern_renumbers () = | Some k -> Alcotest.(check s) "renumbered" "kings_1" (B.to_string (B.map modern k)) +let test_tokens_has_no_duplicate_spelling () = + (* [of_token] resolves via [List.assoc_opt], which silently prefers the + first match on a duplicate key. A copy-paste collision in the table + would therefore mis-map a book in total silence, never an exception -- + assert the invariant directly rather than trust it by inspection. *) + let spellings = List.map fst B.tokens in + let sorted = List.sort compare spellings in + let rec find_dup = function + | a :: (b :: _ as rest) -> if a = b then Some a else find_dup rest + | _ -> None + in + match find_dup sorted with + | None -> () + | Some dup -> Alcotest.failf "duplicate spelling in Book.tokens: %S" dup + +(* Read a whole file into a string. Test-only I/O; the library itself never + touches the filesystem. *) +let read_file path = + let ic = open_in_bin path in + let n = in_channel_length ic in + let content = really_input_string ic n in + close_in ic; + content + +let starts_with_at content pos prefix = + let plen = String.length prefix in + pos + plen <= String.length content && String.sub content pos plen = prefix + +(* Every [(reference ...)] payload in a data file, in file order. No + [Str]/regex -- a plain forward scan for the marker, then read to the + closing quote. Mirrors the coordinator's own survey command (grep -oh + over the reference marker, quote-delimited). *) +let references content = + let marker = "(reference \"" in + let mlen = String.length marker in + let len = String.length content in + let rec loop pos acc = + if pos >= len then List.rev acc + else if starts_with_at content pos marker then + let start = pos + mlen in + match String.index_from_opt content start '"' with + | None -> List.rev acc + | Some close -> + let payload = String.sub content start (close - start) in + loop (close + 1) (payload :: acc) + else loop (pos + 1) acc + in + loop 0 [] + +let is_alpha c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') +let is_one_to_four c = c >= '1' && c <= '4' + +(* The leading book token of one reference payload, e.g. ["2 Tim 4:1-8"] -> + ["2 Tim"], ["Wis. 5:1-5"] -> ["Wis."]. Mirrors the coordinator's own + survey command's second stage: + `sed -E 's/^(([1-4] )?[A-Za-z]+\.?).*/\1/'`. *) +let book_token r = + let len = String.length r in + let start = if len >= 2 && is_one_to_four r.[0] && r.[1] = ' ' then 2 else 0 in + let i = ref start in + while !i < len && is_alpha r.[!i] do + incr i + done; + let stop = if !i < len && r.[!i] = '.' then !i + 1 else !i in + String.sub r 0 stop + +let test_every_data_file_token_resolves () = + (* The check whose absence caused fix round 1: the brief surveyed only + the lectionary and missed 21 tokens, several common, living in + sanctoral.sexp and commons.sexp. Read all three files at test time and + re-derive the token set from them, rather than hardcoding a list, so + this keeps working when the data changes. *) + let files = + [ "../data/ef/lectionary.sexp"; "../data/ef/sanctoral.sexp"; "../data/ef/commons.sexp" ] + in + let tokens = + files + |> List.concat_map (fun f -> references (read_file f)) + |> List.map book_token + |> List.sort_uniq compare + in + Alcotest.(check bool) "at least one token found" true (List.length tokens > 0); + let unresolved = List.filter (fun t -> B.of_token t = None) tokens in + match unresolved with + | [] -> () + | _ -> + Alcotest.failf "unresolved book tokens in shipped data: %s" + (String.concat ", " unresolved) + let suite = ( "book", [ Alcotest.test_case "both spellings one book" `Quick test_both_spellings_are_one_book; Alcotest.test_case "unknown token" `Quick test_unknown_token_is_none; Alcotest.test_case "vulgate identity" `Quick test_vulgate_is_identity; - Alcotest.test_case "modern renumbers" `Quick test_modern_renumbers ] ) + Alcotest.test_case "modern renumbers" `Quick test_modern_renumbers; + Alcotest.test_case "tokens has no duplicate spelling" `Quick + test_tokens_has_no_duplicate_spelling; + Alcotest.test_case "every data file token resolves" `Quick + test_every_data_file_token_resolves ] ) -- cgit v1.3 From ec70286daa72fd2a2a78a1cbab0fe2c268e5c743 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Thu, 20 Aug 2026 15:13:37 +0200 Subject: feat(citation): default_spelling, and close two test gaps Book.default_spelling returns the first registered spelling for an id. It is the fallback display name, and it exists because the alternative is worse: a language file's [bible] lookup is total and returns THE KEY on a miss, so a book with no entry would render as "luke.abbr 5:12-14". Falling back to the data's own spelling makes it render as "Luke 5:12-14" instead -- what colitur printed before this feature existed. The degraded case is the old behaviour, the same principle Lang states for its own key-returning misses. Two test gaps closed, both found by mutation rather than by reading: Parse's split_book scans a leading ordinal digit over '1'..'4', and no case in the suite used an ordinal above 1. Narrowing the range to '1'..'3' passed every test while seven real citations depend on it ("3 Kings 17:8-16", "4 Kings 5:1-15"). Parse-layer cases added; the first attempt at this test asserted through Book.of_token, which is a table lookup and never reaches split_book at all. default_spelling is asserted to round-trip: every cited id's fallback spelling must itself resolve back to that id, or Render and Parse disagree the moment a book goes unnamed. --- lib/citation/book.ml | 5 +++++ lib/citation/book.mli | 19 +++++++++++++++++++ test/test_citation.ml | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 72 insertions(+) (limited to 'lib/citation/book.ml') diff --git a/lib/citation/book.ml b/lib/citation/book.ml index 545e324..2a2b9c0 100644 --- a/lib/citation/book.ml +++ b/lib/citation/book.ml @@ -78,6 +78,11 @@ let all = List.map fst table @ tradition_targets let tokens = List.concat_map (fun (id, sp) -> List.map (fun s -> (s, id)) sp) table +let default_spelling id = + match List.assoc_opt id table with + | Some (first :: _) -> first + | Some [] | None -> id + let of_token s = let s = String.trim s in List.assoc_opt s tokens diff --git a/lib/citation/book.mli b/lib/citation/book.mli index 8918bc3..0ca229c 100644 --- a/lib/citation/book.mli +++ b/lib/citation/book.mli @@ -36,6 +36,25 @@ val all : id list (** Every accepted spelling paired with its id. *) val tokens : (string * id) list +(** The first spelling registered for an id -- the form the shipped data + itself uses ([luke] -> ["Luke"], [kings_3] -> ["3 Kings"]). + + This is the FALLBACK display name, and it exists because the obvious + alternative is actively worse. A language file's [\[bible\]] lookup is + total and returns THE KEY on a miss, so a book with no entry would + otherwise render as ["luke.abbr 5:12-14"]. Falling back here instead makes + an unnamed book render as ["Luke 5:12-14"] -- exactly what colitur printed + before this feature existed. The degraded case is the OLD behaviour, not a + broken page, the same principle {!Colitur_naming.Lang} states for its own + key-returning misses. + + An id with no registered spelling -- only a {!tradition} target such as + [kings_1] or [sirach], which the Vulgate data never cites -- returns the id + itself. Reachable only from a user language file that selects a tradition + without naming its target books; every SHIPPED language file is asserted + complete over {!all}. *) +val default_spelling : id -> string + (** A numbering tradition: which book an id denotes. Separate from NAMING (what a book is called), which lives in a language file's [\[bible\]] section, because naming varies by language and this does not -- "modern diff --git a/test/test_citation.ml b/test/test_citation.ml index e234942..9405d39 100644 --- a/test/test_citation.ml +++ b/test/test_citation.ml @@ -31,6 +31,44 @@ let test_both_spellings_are_one_book () = same "Ezech" "Ezek"; same "Jas" "James" +(* The ordinal spellings resolve in the token table. NOTE: this does NOT + exercise [Parse.split_book]'s leading-digit scan -- of_token is a plain + table lookup. The parse-layer cases in [parse_suite] cover that; both are + needed, and confusing the two is how the gap survived review once already. *) +let test_ordinal_books_beyond_one () = + let id t = + match B.of_token t with + | Some x -> B.to_string x + | None -> Alcotest.failf "%s did not resolve" t + in + Alcotest.(check s) "3 Kings" "kings_3" (id "3 Kings"); + Alcotest.(check s) "3 Kgs." "kings_3" (id "3 Kgs."); + Alcotest.(check s) "4 Kings" "kings_4" (id "4 Kings") + +(* The fallback display name: what a book renders as when a language file has + no [bible] entry for it. Must be the data's own spelling, never the id -- + and must itself re-parse, or Render/Parse round-tripping breaks. *) +let test_default_spelling () = + let sp t = + match B.of_token t with + | Some x -> B.default_spelling x + | None -> Alcotest.failf "%s did not resolve" t + in + Alcotest.(check s) "luke" "Luke" (sp "Luke"); + Alcotest.(check s) "kings_3 uses first spelling" "3 Kings" (sp "3 Kgs."); + let cited = List.map snd B.tokens in + List.iter + (fun id -> + if List.mem id cited then begin + let d = B.default_spelling id in + match B.of_token d with + | Some back when B.to_string back = B.to_string id -> () + | _ -> + Alcotest.failf "default_spelling %s = %S does not resolve back" + (B.to_string id) d + end) + B.all + let test_unknown_token_is_none () = Alcotest.(check bool) "not a book" true (B.of_token "Nonesuch" = None) @@ -139,6 +177,8 @@ let test_every_data_file_token_resolves () = let suite = ( "book", [ Alcotest.test_case "both spellings one book" `Quick test_both_spellings_are_one_book; + Alcotest.test_case "ordinal books 3 and 4" `Quick test_ordinal_books_beyond_one; + Alcotest.test_case "default spelling round-trips" `Quick test_default_spelling; Alcotest.test_case "unknown token" `Quick test_unknown_token_is_none; Alcotest.test_case "vulgate identity" `Quick test_vulgate_is_identity; Alcotest.test_case "modern renumbers" `Quick test_modern_renumbers; @@ -198,6 +238,14 @@ let parse_suite = ("four parts", `Quick, parses "Eccli 24:5; 14:7; 14:9-11; 24:30-31" "ecclesiasticus|24:5|14:7|14:9-11|24:30-31"); ("modern name, vulgate id", `Quick, parses "Rev 12:1" "apocalypse|12:1"); + (* Ordinals 3 and 4 must survive [split_book]'s leading-digit scan. + Narrowing its '1'..'4' range to '1'..'3' passes every OTHER case in + this suite silently, while seven real citations depend on it. A + Book.of_token test does NOT cover this -- that is a table lookup and + never reaches split_book. *) + ("ordinal 3 parses", `Quick, parses "3 Kings 17:8-16" "kings_3|17:8-16"); + ("ordinal 3 dotted", `Quick, parses "3 Kgs. 19:3-8" "kings_3|19:3-8"); + ("ordinal 4 parses", `Quick, parses "4 Kings 5:1-15" "kings_4|5:1-15"); ("unknown book", `Quick, test_rejects_unknown_book); ("garbage", `Quick, test_rejects_garbage) ] -- cgit v1.3