aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/citation/sigla.ml22
-rw-r--r--lib/citation/sigla.mli30
-rw-r--r--test/test_citation.ml21
-rw-r--r--test/test_citation_coverage.ml94
-rw-r--r--test/test_colitur.ml1
5 files changed, 144 insertions, 24 deletions
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_<module>.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;
generated by cgit v1.3 (git 2.53.0) at 2026-09-19 09:13:04 +0000