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. --- test/test_colitur.ml | 1 + 1 file changed, 1 insertion(+) (limited to 'test/test_colitur.ml') diff --git a/test/test_colitur.ml b/test/test_colitur.ml index 1bdd220..46a31aa 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -4,6 +4,7 @@ let () = [ Test_date.suite; Test_computus.suite; Test_colour.suite; Test_slug.suite; Test_names.suite; Test_lang.suite; Test_lang_coverage.suite; + Test_citation.suite; Test_config.suite; Test_overlay.suite; Test_overlay_ini.suite; Test_temporal_ef.suite; Test_validate.suite; Test_precedence.suite; Test_calendar.suite; Test_precedence_ef.suite; Test_sanctoral_ef.suite; Test_rite_ef.suite; -- cgit v1.3 From 56e36188c6afc208b96b15b9a1d3d62bbbe2f705 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Thu, 20 Aug 2026 14:59:03 +0200 Subject: feat(citation): parse citations into structure The parsed form is a book and a LIST of chapter-parts: the data cites across chapters and lists disjoint verse ranges within one. Two rules the shipped data forces and that are not obvious: a semicolon-separated part may inherit the previous chapter rather than restate it, and a chapter may be separated from its verses by a comma. --- lib/citation/parse.ml | 110 +++++++++++++++++++++++++++++++++++++++++++++++++ lib/citation/parse.mli | 15 +++++++ test/test_citation.ml | 54 ++++++++++++++++++++++++ test/test_colitur.ml | 1 + 4 files changed, 180 insertions(+) create mode 100644 lib/citation/parse.ml create mode 100644 lib/citation/parse.mli (limited to 'test/test_colitur.ml') diff --git a/lib/citation/parse.ml b/lib/citation/parse.ml new file mode 100644 index 0000000..45fbb72 --- /dev/null +++ b/lib/citation/parse.ml @@ -0,0 +1,110 @@ +(* SPDX-License-Identifier: AGPL-3.0-or-later *) + +type verse_range = { first : int; last : int option } +type part = { chapter : int; verses : verse_range list } +type t = { book : Book.id; parts : part list } + +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. *) +let split_book s = + let n = String.length s in + let i = ref 0 in + (* optional leading ordinal digit *) + if !i < n && s.[!i] >= '1' && s.[!i] <= '4' then begin + incr i; + while !i < n && s.[!i] = ' ' do incr i done + end; + (* letters and dots *) + while !i < n && (s.[!i] = '.' || (s.[!i] >= 'A' && s.[!i] <= 'z')) do incr i done; + if !i = 0 then None + else + let book = String.trim (String.sub s 0 !i) in + 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) + +(* "20-32" -> {first=20; last=Some 32}; "21" -> {first=21; last=None} *) +let parse_range s = + match split_on '-' s with + | [ 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 } + | _ -> None) + | _ -> None + +let parse_ranges s = + let pieces = split_on ',' s in + List.fold_right + (fun p acc -> + match (parse_range p, acc) with + | Some r, Some rest -> Some (r :: rest) + | _ -> None) + pieces (Some []) + +(* One ";"-separated part. [inherited] is the chapter of the previous part, + used when this one names none (rule 1 in the grammar table). *) +let parse_part ~inherited s = + match split_on ':' s with + | [ c; v ] -> ( + (* explicit "chapter:verses" *) + match (int_opt c, parse_ranges v) with + | Some ch, Some vs -> Some { chapter = ch; verses = vs } + | _ -> None) + | [ only ] -> ( + (* Either "chapter, verses" (rule 3) or bare verses inheriting a + chapter. Distinguish on whether the FIRST comma-piece is a lone + number followed by more pieces -- a leading number followed by + at least one further piece is a chapter introduction ("15, 1-46"); + a lone piece on its own, or a part with no more pieces to follow, + can only be verses inheriting the previous chapter. *) + let pieces = split_on ',' only in + match (pieces, inherited) with + | first :: (_ :: _ as rest), _ when int_opt first <> None && String.contains only ',' -> ( + (* "15, 1-46" -> chapter 15. This never fires for a part that + already named its chapter via ":" -- those match the [c; v] + branch above and never reach here. *) + match (int_opt first, parse_ranges (String.concat "," rest)) with + | Some ch, Some vs -> Some { chapter = ch; verses = vs } + | _ -> None) + | _, Some ch -> ( + match parse_ranges only with + | Some vs -> Some { chapter = ch; verses = vs } + | None -> None) + | _, None -> None) + | _ -> None + +let parse s = + let s = String.trim s in + (* A trailing period is decoration, not data: 22 citations carry one. *) + let s = + let n = String.length s in + if n > 0 && s.[n - 1] = '.' then String.sub s 0 (n - 1) else s + in + match split_book s with + | None -> Error "no book" + | Some (btok, tail) -> ( + match Book.of_token btok with + | None -> Error ("unknown book: " ^ btok) + | Some book -> + (* A trailing ";" leaves an empty piece: drop it rather than + failing. Only if nothing remains is it an error. *) + let pieces = List.filter (fun p -> p <> "") (split_on ';' tail) in + let rec go inherited = function + | [] -> Ok [] + | p :: rest -> ( + match parse_part ~inherited p with + | None -> Error ("cannot read reference: " ^ p) + | Some part -> ( + match go (Some part.chapter) rest with + | Error e -> Error e + | Ok more -> Ok (part :: more))) + in + (match go None pieces with + | Error e -> Error e + | Ok [] -> Error "empty reference" + | Ok parts -> Ok { book; parts })) diff --git a/lib/citation/parse.mli b/lib/citation/parse.mli new file mode 100644 index 0000000..3d1053c --- /dev/null +++ b/lib/citation/parse.mli @@ -0,0 +1,15 @@ +(* SPDX-License-Identifier: AGPL-3.0-or-later *) + +(** A citation, parsed. Never raises; an unrecognised string is an [Error] + naming what could not be read, never a silent pass-through. + + The shape is a book and a LIST of chapter-parts, not one chapter and one + verse range, because the shipped data really does cite across chapters + ([John 18:1-40; 19:1-42]) and really does list disjoint verse ranges + within a chapter ([Dan 13:1-9, 15-17, 19-30, 33-62]). *) + +type verse_range = { first : int; last : int option } +type part = { chapter : int; verses : verse_range list } +type t = { book : Book.id; parts : part list } + +val parse : string -> (t, string) result diff --git a/test/test_citation.ml b/test/test_citation.ml index 7bc8ac7..75fffe8 100644 --- a/test/test_citation.ml +++ b/test/test_citation.ml @@ -146,3 +146,57 @@ let suite = test_tokens_has_no_duplicate_spelling; Alcotest.test_case "every data file token resolves" `Quick test_every_data_file_token_resolves ] ) + +module P = Colitur_citation.Parse + +(* Render a parse back to a debug string so a test can assert shape + compactly: "book|chapter:v-v,v-v|chapter:v". *) +let show (t : P.t) = + let range (r : P.verse_range) = + match r.P.last with + | None -> string_of_int r.P.first + | Some l -> Printf.sprintf "%d-%d" r.P.first l + in + let part (p : P.part) = + Printf.sprintf "%d:%s" p.P.chapter + (String.concat "," (List.map range p.P.verses)) + in + B.to_string t.P.book ^ "|" ^ String.concat "|" (List.map part t.P.parts) + +let parses input expected () = + match P.parse input with + | Error e -> Alcotest.failf "%s did not parse: %s" input e + | Ok t -> Alcotest.(check s) input expected (show t) + +let test_rejects_unknown_book () = + Alcotest.(check bool) "error" true (Result.is_error (P.parse "Nonesuch 1:1")) + +let test_rejects_garbage () = + List.iter + (fun bad -> + Alcotest.(check bool) bad true (Result.is_error (P.parse bad))) + [ ""; "Luke"; "Luke :"; "Luke 1:"; "Luke abc:1" ] + +let parse_suite = + [ ("simple", `Quick, parses "1 Cor 11:20-32" "corinthians_1|11:20-32"); + ("trailing period", `Quick, parses "1 John 3:13-18." "john_1|3:13-18"); + ("single verse", `Quick, parses "Luke 2:21" "luke|2:21"); + ("dotted spelling", `Quick, parses "Isa. 1:16-19" "isaiah|1:16-19"); + ("verse list", `Quick, parses "Acts 10:34, 42-48" "acts|10:34,42-48"); + ("new chapter", `Quick, parses "1 Cor. 9:24-27; 10:1-5" + "corinthians_1|9:24-27|10:1-5"); + (* Rule 1: the second part names no chapter, so it inherits chapter 2. *) + ("inherited chapter", `Quick, parses "Joel 2:23-24; 26-27" "joel|2:23-24|2:26-27"); + (* Rule 2: comma separates chapter from verses in the second part. *) + ("comma chapter", `Quick, parses "Mark 14:32-72; 15, 1-46" + "mark|14:32-72|15:1-46"); + ("four ranges", `Quick, parses "Dan 13:1-9, 15-17, 19-30, 33-62." + "daniel|13:1-9,15-17,19-30,33-62"); + ("mixed", `Quick, parses "Num 20:1, 3; 6-13." "numbers|20:1,3|20:6-13"); + ("trailing semicolon", `Quick, parses "1 Cor 1:18-25; 1:30;" + "corinthians_1|1:18-25|1:30"); + ("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"); + ("unknown book", `Quick, test_rejects_unknown_book); + ("garbage", `Quick, test_rejects_garbage) ] diff --git a/test/test_colitur.ml b/test/test_colitur.ml index 46a31aa..6fe212d 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -5,6 +5,7 @@ let () = Test_lang.suite; Test_lang_coverage.suite; Test_citation.suite; + ("parse", Test_citation.parse_suite); Test_config.suite; Test_overlay.suite; Test_overlay_ini.suite; Test_temporal_ef.suite; Test_validate.suite; Test_precedence.suite; Test_calendar.suite; Test_precedence_ef.suite; Test_sanctoral_ef.suite; Test_rite_ef.suite; -- cgit v1.3 From f8c746736fe269ef6e0c4377f58bbb6b1f2fc07a Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Thu, 20 Aug 2026 15:03:02 +0200 Subject: test(citation): assert every emitted citation parses Walks 1970-2070 and parses every citation the engine emits. Nothing validated citation spellings before this, which is why seven books carried two spellings unnoticed. Mutation-proved: removing the 'Isa.' spelling from the book table reddens this test naming that citation. --- test/test_citation_coverage.ml | 43 ++++++++++++++++++++++++++++++++++++++++++ test/test_colitur.ml | 1 + 2 files changed, 44 insertions(+) create mode 100644 test/test_citation_coverage.ml (limited to 'test/test_colitur.ml') diff --git a/test/test_citation_coverage.ml b/test/test_citation_coverage.ml new file mode 100644 index 0000000..31d49eb --- /dev/null +++ b/test/test_citation_coverage.ml @@ -0,0 +1,43 @@ +(* SPDX-License-Identifier: AGPL-3.0-or-later *) + +(* Every citation the engine can emit must parse. This is the check that + would have caught the seven duplicate book spellings -- nothing validated + them before. + + Same shape as test_lang_coverage.ml, which this file deliberately mirrors: + a miss there is a slug with no name, a miss here is a citation the parser + cannot read. *) + +module P = Colitur_citation.Parse + +let test_every_citation_parses () = + let layer = + match Test_support.load_ef_layer () with + | Ok l -> l + | Error e -> Alcotest.failf "%s" e + in + let ctx = Test_support.ef_context () in + let bad = Hashtbl.create 64 in + for y = 1970 to 2070 do + Array.iter + (fun (d : (Rite_ef.Vocab_ef.season, Rite_ef.Vocab_ef.rank) Colitur_kernel.Liturgical_day.t) -> + List.iter + (fun (c : Colitur_kernel.Citation.t) -> + let r = c.Colitur_kernel.Citation.reference in + match P.parse r with + | Ok _ -> () + | Error e -> if not (Hashtbl.mem bad r) then Hashtbl.add bad r e) + d.Colitur_kernel.Liturgical_day.citations) + (Colitur_kernel.Calendar.year ctx layer y) + done; + if Hashtbl.length bad > 0 then begin + Hashtbl.iter (fun r e -> Printf.eprintf "UNPARSED %S: %s\n" r e) bad; + Alcotest.failf "%d citation(s) did not parse" (Hashtbl.length bad) + end + +(* This project has ONE test executable. Every test_.ml exposes a + [suite] value and test_colitur.ml aggregates them -- do NOT call + Alcotest.run here. Marked `Slow like test_lang_coverage's own year walk. *) +let suite = + ( "citation-coverage", + [ Alcotest.test_case "every citation parses" `Slow test_every_citation_parses ] ) diff --git a/test/test_colitur.ml b/test/test_colitur.ml index 6fe212d..fb2c20c 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -4,6 +4,7 @@ let () = [ Test_date.suite; Test_computus.suite; Test_colour.suite; Test_slug.suite; Test_names.suite; Test_lang.suite; Test_lang_coverage.suite; + Test_citation_coverage.suite; Test_citation.suite; ("parse", Test_citation.parse_suite); Test_config.suite; -- cgit v1.3 From a2cbb6b85e79fbc59b0879362c0f853757d51c07 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Thu, 20 Aug 2026 15:09:49 +0200 Subject: feat(citation): render a parsed citation in a configurable style A style is a set of format strings, so punctuation convention is data. Values are unquoted here rather than in Overlay_ini: that parser trims every value and is shared with overlays and [defaults], so teaching it about quotes would change behaviour this feature has no business changing. --- lib/citation/render.ml | 107 ++++++++++++++++++++++++++++++++++++++++++++++ lib/citation/render.mli | 48 +++++++++++++++++++++ test/test_citation.ml | 111 ++++++++++++++++++++++++++++++++++++++++++++++++ test/test_colitur.ml | 1 + 4 files changed, 267 insertions(+) create mode 100644 lib/citation/render.ml create mode 100644 lib/citation/render.mli (limited to 'test/test_colitur.ml') diff --git a/lib/citation/render.ml b/lib/citation/render.ml new file mode 100644 index 0000000..c66a0ca --- /dev/null +++ b/lib/citation/render.ml @@ -0,0 +1,107 @@ +(* SPDX-License-Identifier: AGPL-3.0-or-later *) + +type style = { + book : [ `Full | `Abbr ]; + book_sep : string; + chapter_verse : string; + range : string; + part_sep : string; + verse_sep : string; +} + +let default_style = + { book = `Abbr; + book_sep = " "; + chapter_verse = "{chapter}:{verses}"; + range = "{first}-{last}"; + part_sep = "; "; + verse_sep = ", " } + +let part_sep st = st.part_sep +let range st = st.range +let book_sep st = st.book_sep + +(* Arabic -> Roman, for the {chapter_roman} placeholder. Lifted from + [Colitur_render.View.roman_numeral], which prints "Hebdomada I" week + headings -- roman numerals are idiomatic throughout this project's + output ("Feria IV"), so a citation style may want them too. *) +let roman_numeral n = + if n <= 0 then string_of_int n + else + let table = + [ (1000, "M"); (900, "CM"); (500, "D"); (400, "CD"); (100, "C"); + (90, "XC"); (50, "L"); (40, "XL"); (10, "X"); (9, "IX"); + (5, "V"); (4, "IV"); (1, "I") ] + in + let b = Buffer.create 8 in + let n = ref n in + List.iter + (fun (v, sym) -> + while !n >= v do + Buffer.add_string b sym; + n := !n - v + done) + table; + Buffer.contents b + +let with_book b st = { st with book = b } + +(* One matching pair of surrounding double quotes, and only that -- see the + .mli for why this is not in Overlay_ini. *) +let unquote s = + let n = String.length s in + if n >= 2 && s.[0] = '"' && s.[n - 1] = '"' then String.sub s 1 (n - 2) else s + +(* Replace {name} with its value. An UNKNOWN placeholder survives + literally: a typo in a hand-written style file must be visible in the + output, not silently swallowed. *) +let subst tmpl pairs = + let n = String.length tmpl in + let b = Buffer.create (n + 16) in + let i = ref 0 in + while !i < n do + if tmpl.[!i] = '{' then + match String.index_from_opt tmpl !i '}' with + | None -> + Buffer.add_char b tmpl.[!i]; + incr i + | Some j -> + let name = String.sub tmpl (!i + 1) (j - !i - 1) in + (match List.assoc_opt name pairs with + | Some v -> Buffer.add_string b v + | None -> Buffer.add_string b (String.sub tmpl !i (j - !i + 1))); + i := j + 1 + else begin + Buffer.add_char b tmpl.[!i]; + incr i + end + done; + Buffer.contents b + +let render st ~names (t : Parse.t) = + let one_range (r : Parse.verse_range) = + match r.Parse.last with + | None -> string_of_int r.Parse.first + | Some l -> + subst st.range + [ ("first", string_of_int r.Parse.first); + ("last", string_of_int l) ] + in + let one_part (p : Parse.part) = + let verses = String.concat st.verse_sep (List.map one_range p.Parse.verses) in + subst st.chapter_verse + [ ("chapter", string_of_int p.Parse.chapter); + ("chapter_roman", roman_numeral p.Parse.chapter); + ("verses", verses) ] + in + let body = String.concat st.part_sep (List.map one_part t.Parse.parts) in + names t.Parse.book st.book ^ st.book_sep ^ body + +let style_of_fields fields = + let get k d = match List.assoc_opt k fields with Some v -> unquote v | None -> d in + { book = (if get "book" "abbr" = "full" then `Full else `Abbr); + book_sep = get "book_sep" default_style.book_sep; + chapter_verse = get "chapter_verse" default_style.chapter_verse; + range = get "range" default_style.range; + part_sep = get "part_sep" default_style.part_sep; + verse_sep = get "verse_sep" default_style.verse_sep } diff --git a/lib/citation/render.mli b/lib/citation/render.mli new file mode 100644 index 0000000..d741931 --- /dev/null +++ b/lib/citation/render.mli @@ -0,0 +1,48 @@ +(* SPDX-License-Identifier: AGPL-3.0-or-later *) + +(** Turn a parsed citation back into text, in a configurable style. + + A style is data, not code, so a tradition of punctuation is a file + someone can write: [Luke 5:12-14], [Lk 5:12-14], [Luke 5.12-14], + [{L}k 5, 12-14] are all the same citation in different conventions. + + Placeholders: [{chapter}], [{chapter_roman}] and [{verses}] in + [chapter_verse]; [{first}] and [{last}] in [range]. An UNKNOWN + placeholder survives literally, so a typo is visible in the output + rather than silently swallowed. *) + +type style + +(** The Vulgate/Latin convention: abbreviated book, [chapter:verses], + [first-last], ["; "] between parts, [", "] between verse ranges. *) +val default_style : style + +(** Read a style from a language file's [\[sigla\]] section. + + Values are UNQUOTED here: one matching pair of surrounding double quotes + is stripped, so a separator's significant trailing space survives. + {!Colitur_kernel.Overlay_ini} trims every value and has no quote + handling, and it is shared with overlays and [\[defaults\]] -- so the + unquoting belongs here, not there. An unrecognised key is ignored; + a missing key keeps {!default_style}'s value. *) +val style_of_fields : (string * string) list -> style + +(** Override the book form, for the [sigla_book] config key. *) +val with_book : [ `Full | `Abbr ] -> style -> style + +val part_sep : style -> string +val range : style -> string + +(** What separates the book name from the reference. Default [" "]. + + Settable because a typeset booklet wants a NON-BREAKING space here -- a + line break between "Luc." and "3, 1" is exactly the ugliness this + prevents. Set it to a literal U+00A0: the escapers match ASCII bytes + only, so a UTF-8 multibyte sequence passes through every flavour + untouched (verified for latex, typst, groff, html, xml, ics). A LaTeX + tie [~] does NOT work -- {!Colitur_render.Escape} turns it into + [\textasciitilde{}]. *) +val book_sep : style -> string + +val render : + style -> names:(Book.id -> [ `Full | `Abbr ] -> string) -> Parse.t -> string diff --git a/test/test_citation.ml b/test/test_citation.ml index 75fffe8..e234942 100644 --- a/test/test_citation.ml +++ b/test/test_citation.ml @@ -200,3 +200,114 @@ let parse_suite = ("modern name, vulgate id", `Quick, parses "Rev 12:1" "apocalypse|12:1"); ("unknown book", `Quick, test_rejects_unknown_book); ("garbage", `Quick, test_rejects_garbage) ] + +module R = Colitur_citation.Render + +let names id form = + let n = B.to_string id in + match form with `Abbr -> (if n = "luke" then "Luc." else n) + | `Full -> (if n = "luke" then "Evangelium secundum Lucam" else n) + +let render_with fields input expected () = + let style = R.style_of_fields fields in + match P.parse input with + | Error e -> Alcotest.failf "%s did not parse: %s" input e + | Ok t -> Alcotest.(check s) input expected (R.render style ~names t) + +let test_unquotes_trailing_space () = + let st = R.style_of_fields [ ("part_sep", "\"; \"") ] in + Alcotest.(check s) "quotes stripped, space kept" "; " (R.part_sep st) + +let test_bare_value_untouched () = + let st = R.style_of_fields [ ("range", "{first}-{last}") ] in + Alcotest.(check s) "no quotes" "{first}-{last}" (R.range st) + +(* [subst] has no test pressure of its own anywhere else in the suite, so + these three isolate its contract directly through the only surface that + calls it: a [range]/[chapter_verse] template chosen so nothing else in + the pipeline (verse-list joining, book naming) can mask the result. *) +let test_subst_no_placeholder () = + (* A template with no "{" at all passes through completely unchanged. *) + render_with [ ("book", "abbr"); ("chapter_verse", "fixed-text") ] "Luke 2:21" + "Luc. fixed-text" () + +let test_subst_two_placeholders () = + (* Two DIFFERENT known placeholders, reordered relative to the record's + own field order ([last] before [first]) -- proves substitution is by + name, not by position. *) + render_with + [ ("book", "abbr"); ("range", "{last}~{first}") ] + "Luke 5:12-14" "Luc. 5:14~12" () + +let test_subst_unknown_placeholder_alone () = + (* A template that is NOTHING but an unrecognised placeholder: it must + survive byte-for-byte, proving [subst] never touches an unmatched + "{...}" run even when there is no surrounding literal text to anchor + on. *) + render_with [ ("book", "abbr"); ("range", "{nope}") ] "Luke 5:12-14" + "Luc. 5:{nope}" () + +(* [roman_numeral] is private to Render (not in the .mli, matching + [View.roman_numeral]'s own precedent -- tested indirectly, never + exposed). Reached through [render] with a [chapter_verse] template of + bare [{chapter_roman}], [book_sep] emptied and [names] returning "", so + the assertion isolates exactly the numeral and nothing else. *) +let roman_of n = + let luke = match B.of_token "Luke" with Some id -> id | None -> assert false in + let t : P.t = { P.book = luke; parts = [ { P.chapter = n; verses = [ { P.first = 1; last = None } ] } ] } in + let style = R.style_of_fields [ ("book_sep", ""); ("chapter_verse", "{chapter_roman}") ] in + R.render style ~names:(fun _ _ -> "") t + +let test_roman_numeral_values () = + List.iter + (fun (n, expected) -> Alcotest.(check s) (string_of_int n) expected (roman_of n)) + [ (1, "I"); (4, "IV"); (9, "IX"); (14, "XIV"); (40, "XL"); (150, "CL") ] + +let test_roman_numeral_non_positive () = + (* The one input that could loop forever in a naive implementation: a + non-positive chapter returns the arabic form instead. Completing at + all is part of what this test proves. *) + Alcotest.(check s) "zero" "0" (roman_of 0); + Alcotest.(check s) "negative" "-3" (roman_of (-3)) + +let render_suite = + ( "Citation/render", + [ Alcotest.test_case "latin default" `Quick + (render_with [ ("book", "abbr") ] "Luke 5:12-14" "Luc. 5:12-14"); + Alcotest.test_case "full name" `Quick + (render_with [ ("book", "full") ] "Luke 5:12-14" + "Evangelium secundum Lucam 5:12-14"); + Alcotest.test_case "comma style" `Quick + (render_with + [ ("book", "abbr"); ("chapter_verse", "{chapter}, {verses}") ] + "Luke 5:12-14" "Luc. 5, 12-14"); + Alcotest.test_case "multi part" `Quick + (render_with [ ("book", "abbr"); ("part_sep", "\"; \"") ] + "Joel 2:23-24; 26-27" "joel 2:23-24; 2:26-27"); + Alcotest.test_case "unquote" `Quick test_unquotes_trailing_space; + Alcotest.test_case "bare value" `Quick test_bare_value_untouched; + (* The Missal's own convention, scan-verified: "Matth. 11, 2" / + "Ioann. 1, 1" -- dotted abbreviation, comma, ARABIC chapter. *) + Alcotest.test_case "missal convention" `Quick + (render_with + [ ("book", "abbr"); ("chapter_verse", "{chapter}, {verses}") ] + "Luke 5:12-14" "Luc. 5, 12-14"); + Alcotest.test_case "roman chapter" `Quick + (render_with + [ ("book", "abbr"); ("chapter_verse", "{chapter_roman}, {verses}") ] + "Luke 5:12-14" "Luc. V, 12-14"); + (* U+00A0 between book and reference, for typeset output. *) + Alcotest.test_case "nbsp book sep" `Quick + (render_with [ ("book", "abbr"); ("book_sep", "\"\xc2\xa0\"") ] + "Luke 5:12-14" "Luc.\xc2\xa05:12-14"); + Alcotest.test_case "unknown placeholder survives" `Quick + (render_with + [ ("book", "abbr"); ("chapter_verse", "{chapter}:{nope}") ] + "Luke 5:12-14" "Luc. 5:{nope}"); + Alcotest.test_case "subst: no placeholder" `Quick test_subst_no_placeholder; + Alcotest.test_case "subst: two placeholders" `Quick test_subst_two_placeholders; + Alcotest.test_case "subst: unknown placeholder alone" `Quick + test_subst_unknown_placeholder_alone; + Alcotest.test_case "roman_numeral: table values" `Quick test_roman_numeral_values; + Alcotest.test_case "roman_numeral: non-positive" `Quick + test_roman_numeral_non_positive ] ) diff --git a/test/test_colitur.ml b/test/test_colitur.ml index fb2c20c..6084adb 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -7,6 +7,7 @@ let () = Test_citation_coverage.suite; Test_citation.suite; ("parse", Test_citation.parse_suite); + Test_citation.render_suite; Test_config.suite; Test_overlay.suite; Test_overlay_ini.suite; Test_temporal_ef.suite; Test_validate.suite; Test_precedence.suite; Test_calendar.suite; Test_precedence_ef.suite; Test_sanctoral_ef.suite; Test_rite_ef.suite; -- cgit v1.3 From 987175105ead0ea78b960c0e638a81c6fd2384cf Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Thu, 20 Aug 2026 15:44:29 +0200 Subject: feat(citation): the Sigla facade, total by construction format never raises and returns an unparseable citation unchanged, so a gap degrades to today's behaviour rather than to a crash. The coverage test asserts separately that no shipped citation takes that path. verbatim is what --raw uses: an identity name table would still reformat punctuation and renumber, which would break byte-exact diffing against lectio. The existing citation-coverage walk (1970-2070) now also drives a round-trip check in the same pass: parse -> render -> parse must reach the same structure, using Book.default_spelling for names (Book.to_string returns the internal id, which is not a registered token and cannot be read back). Proved with a mutation: changing the default style's part_sep to a separator the parser does not accept reddened the round-trip case on 31 multi-part citations and nothing else; reverted. --- lib/citation/sigla.ml | 22 ++++++++++ lib/citation/sigla.mli | 30 ++++++++++++++ test/test_citation.ml | 21 ++++++++++ test/test_citation_coverage.ml | 94 +++++++++++++++++++++++++++++++----------- test/test_colitur.ml | 1 + 5 files changed, 144 insertions(+), 24 deletions(-) create mode 100644 lib/citation/sigla.ml create mode 100644 lib/citation/sigla.mli (limited to 'test/test_colitur.ml') diff --git a/lib/citation/sigla.ml b/lib/citation/sigla.ml new file mode 100644 index 0000000..a4f4555 --- /dev/null +++ b/lib/citation/sigla.ml @@ -0,0 +1,22 @@ +(* SPDX-License-Identifier: AGPL-3.0-or-later *) + +type t = + | Verbatim + | Styled of { + style : Render.style; + tradition : Book.tradition; + names : Book.id -> [ `Full | `Abbr ] -> string; + } + +let verbatim = Verbatim +let make ~style ~tradition ~names = Styled { style; tradition; names } + +let format t s = + match t with + | Verbatim -> s + | Styled { style; tradition; names } -> ( + match Parse.parse s with + | Error _ -> s + | Ok c -> + let c = { c with Parse.book = Book.map tradition c.Parse.book } in + Render.render style ~names c) diff --git a/lib/citation/sigla.mli b/lib/citation/sigla.mli new file mode 100644 index 0000000..d21877a --- /dev/null +++ b/lib/citation/sigla.mli @@ -0,0 +1,30 @@ +(* SPDX-License-Identifier: AGPL-3.0-or-later *) + +(** The whole citation pipeline as one TOTAL function, so a call site needs + one value and one call rather than a parse/map/render dance. + + {!format} never raises and never drops text: a citation that does not + parse is returned UNCHANGED. That combination is deliberate -- graceful + in production, while [test_citation_coverage.ml] asserts strictly that + no shipped citation actually takes that path. *) + +type t + +val make : + style:Render.style -> + tradition:Book.tradition -> + names:(Book.id -> [ `Full | `Abbr ] -> string) -> + t + +(** Returns every citation exactly as given. This is what [--raw] uses, the + same shape as {!Colitur_naming.Lang.raw}: raw output is one value passed + around, not a special case threaded through every call site. + + [--raw] must NOT merely use an identity name table -- that would still + reformat punctuation and apply a tradition. Byte-exact output is what + makes [--raw] usable for diffing against lectio, and it also keeps the + raw view independent of the parser, so a parser bug cannot corrupt the + output used to diagnose it. *) +val verbatim : t + +val format : t -> string -> string diff --git a/test/test_citation.ml b/test/test_citation.ml index 9405d39..25fc260 100644 --- a/test/test_citation.ml +++ b/test/test_citation.ml @@ -359,3 +359,24 @@ let render_suite = Alcotest.test_case "roman_numeral: table values" `Quick test_roman_numeral_values; Alcotest.test_case "roman_numeral: non-positive" `Quick test_roman_numeral_non_positive ] ) + +module S = Colitur_citation.Sigla + +let test_verbatim_is_identity () = + List.iter + (fun c -> Alcotest.(check s) c c (S.format S.verbatim c)) + [ "3 Kgs. 19:3-8"; "Isa. 1:16-19"; "not a citation at all" ] + +let test_unparseable_survives_unchanged () = + let sg = S.make ~style:R.default_style ~tradition:B.vulgate ~names in + Alcotest.(check s) "passed through" "Nonesuch 1:1" (S.format sg "Nonesuch 1:1") + +let test_tradition_applies () = + let modern = B.tradition_of_fields [ ("kings_3", "kings_1") ] in + let sg = S.make ~style:R.default_style ~tradition:modern ~names in + Alcotest.(check s) "renumbered" "kings_1 19:3-8" (S.format sg "3 Kings 19:3-8") + +let sigla_suite = + [ ("verbatim identity", `Quick, test_verbatim_is_identity); + ("unparseable survives", `Quick, test_unparseable_survives_unchanged); + ("tradition applies", `Quick, test_tradition_applies) ] diff --git a/test/test_citation_coverage.ml b/test/test_citation_coverage.ml index 31d49eb..a131d50 100644 --- a/test/test_citation_coverage.ml +++ b/test/test_citation_coverage.ml @@ -6,33 +6,78 @@ Same shape as test_lang_coverage.ml, which this file deliberately mirrors: a miss there is a slug with no name, a miss here is a citation the parser - cannot read. *) + cannot read. + + The walk below also drives the round-trip check (Sigla facade, Task 5): + ONE pass over 1970-2070 collects into TWO tables, [bad_parse] and + [bad_round_trip], rather than walking the whole range twice for two + independent Alcotest cases -- measured, a second walk would cost ~1.5s of + a 5.65s fast suite for zero extra coverage. *) module P = Colitur_citation.Parse +let bad_parse : (string, string) Hashtbl.t = Hashtbl.create 64 +let bad_round_trip : (string, string) Hashtbl.t = Hashtbl.create 16 +let walked = ref false + +(* Parse -> render -> parse must reach the same structure. + + NOTE the [names] function: [Book.default_spelling], NOT [Book.to_string]. + [to_string] returns the internal id ("corinthians_1"), which is not a + registered token, so rendering with it produces something Parse cannot + read back -- 0 of 738 round-trip. Measured during Task 4; do not + "simplify" this back to to_string. A renderer that emits an unparseable + string, or a style whose own output it cannot read, fails here. Compares + STRUCTURE, not text: the rendered form legitimately differs from the + input (a normalised book spelling, a dropped trailing period), and + asserting text equality would just pin those differences. *) +let sg = + Colitur_citation.Sigla.make ~style:Colitur_citation.Render.default_style + ~tradition:Colitur_citation.Book.vulgate + ~names:(fun id _form -> Colitur_citation.Book.default_spelling id) + +let walk () = + if not !walked then begin + walked := true; + let layer = + match Test_support.load_ef_layer () with + | Ok l -> l + | Error e -> Alcotest.failf "%s" e + in + let ctx = Test_support.ef_context () in + for y = 1970 to 2070 do + Array.iter + (fun (d : (Rite_ef.Vocab_ef.season, Rite_ef.Vocab_ef.rank) Colitur_kernel.Liturgical_day.t) -> + List.iter + (fun (c : Colitur_kernel.Citation.t) -> + let r = c.Colitur_kernel.Citation.reference in + match P.parse r with + | Error e -> if not (Hashtbl.mem bad_parse r) then Hashtbl.add bad_parse r e + | Ok first -> + let rendered = Colitur_citation.Sigla.format sg r in + (match P.parse rendered with + | Error e -> + Hashtbl.replace bad_round_trip r ("re-parse failed: " ^ e) + | Ok again -> + if again <> first then + Hashtbl.replace bad_round_trip r ("structure changed: " ^ rendered))) + d.Colitur_kernel.Liturgical_day.citations) + (Colitur_kernel.Calendar.year ctx layer y) + done + end + let test_every_citation_parses () = - let layer = - match Test_support.load_ef_layer () with - | Ok l -> l - | Error e -> Alcotest.failf "%s" e - in - let ctx = Test_support.ef_context () in - let bad = Hashtbl.create 64 in - for y = 1970 to 2070 do - Array.iter - (fun (d : (Rite_ef.Vocab_ef.season, Rite_ef.Vocab_ef.rank) Colitur_kernel.Liturgical_day.t) -> - List.iter - (fun (c : Colitur_kernel.Citation.t) -> - let r = c.Colitur_kernel.Citation.reference in - match P.parse r with - | Ok _ -> () - | Error e -> if not (Hashtbl.mem bad r) then Hashtbl.add bad r e) - d.Colitur_kernel.Liturgical_day.citations) - (Colitur_kernel.Calendar.year ctx layer y) - done; - if Hashtbl.length bad > 0 then begin - Hashtbl.iter (fun r e -> Printf.eprintf "UNPARSED %S: %s\n" r e) bad; - Alcotest.failf "%d citation(s) did not parse" (Hashtbl.length bad) + walk (); + if Hashtbl.length bad_parse > 0 then begin + Hashtbl.iter (fun r e -> Printf.eprintf "UNPARSED %S: %s\n" r e) bad_parse; + Alcotest.failf "%d citation(s) did not parse" (Hashtbl.length bad_parse) + end + +let test_round_trip () = + walk (); + if Hashtbl.length bad_round_trip > 0 then begin + Hashtbl.iter (fun r e -> Printf.eprintf "ROUND-TRIP %S: %s\n" r e) bad_round_trip; + Alcotest.failf "%d citation(s) failed round-trip" (Hashtbl.length bad_round_trip) end (* This project has ONE test executable. Every test_.ml exposes a @@ -40,4 +85,5 @@ let test_every_citation_parses () = Alcotest.run here. Marked `Slow like test_lang_coverage's own year walk. *) let suite = ( "citation-coverage", - [ Alcotest.test_case "every citation parses" `Slow test_every_citation_parses ] ) + [ Alcotest.test_case "every citation parses" `Slow test_every_citation_parses; + Alcotest.test_case "sigla round-trip" `Slow test_round_trip ] ) diff --git a/test/test_colitur.ml b/test/test_colitur.ml index 6084adb..c873945 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -8,6 +8,7 @@ let () = Test_citation.suite; ("parse", Test_citation.parse_suite); Test_citation.render_suite; + ("sigla", Test_citation.sigla_suite); Test_config.suite; Test_overlay.suite; Test_overlay_ini.suite; Test_temporal_ef.suite; Test_validate.suite; Test_precedence.suite; Test_calendar.suite; Test_precedence_ef.suite; Test_sanctoral_ef.suite; Test_rite_ef.suite; -- cgit v1.3