diff options
| -rw-r--r-- | lib/citation/book.ml | 47 | ||||
| -rw-r--r-- | lib/citation/book.mli | 21 | ||||
| -rw-r--r-- | test/test_citation.ml | 113 |
3 files changed, 161 insertions, 20 deletions
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 ] ) |