diff options
| -rw-r--r-- | lib/render/emit_csv.ml | 20 | ||||
| -rw-r--r-- | lib/render/emit_ics.ml | 6 | ||||
| -rw-r--r-- | lib/render/emit_xml.ml | 9 | ||||
| -rw-r--r-- | lib/render/view.ml | 88 | ||||
| -rw-r--r-- | test/test_emit.ml | 46 | ||||
| -rw-r--r-- | test/test_ics.ml | 16 | ||||
| -rw-r--r-- | test/test_view.ml | 52 |
7 files changed, 228 insertions, 9 deletions
diff --git a/lib/render/emit_csv.ml b/lib/render/emit_csv.ml index 415a684..e04211f 100644 --- a/lib/render/emit_csv.ml +++ b/lib/render/emit_csv.ml @@ -21,7 +21,25 @@ let s v k = match get v k with Some (T.Str x) -> x | _ -> "" lang-keyed object -- the [name_la]/[name_en] pair this replaces carried the kernel's own [Celebration.names], a different, unlocalised source. Machine formats still carry [slug] alongside it, so a script keeps the - stable key and a human reads the name. *) + stable key and a human reads the name. + + W5: deliberately NOT widened with a "second" column, unlike + [Emit_xml]/[Emit_ics] (each a repeated-element/free-text format that + grows for free). A CSV's header row is a CONTRACT with every row under + it (RFC 4180 sec. 2: "each field in the header... should contain the + same number of fields as the records"), so there is no way to add a + column only on the days that carry a [Second] reading -- a real + three-citation day would either need an ALWAYS-present, mostly-empty + "second" column (widening every EF row forever for a case EF can never + hit) or genuinely variable-width rows (not CSV). Neither is a change to + make speculatively: [bin/main.ml]'s [reject_rite_for] refuses [--rite] + on `emit` entirely for any rite but EF, so no [Second] reading can reach + this module today, and EF's own [citations] is always exactly + [[First; Gospel]] ({!Rite_ef}'s own [citation_shapes]) -- there is + nothing to widen FOR yet. When OF is admitted here, this is the one + emitter that needs a deliberate, disclosed breaking change (a new + column, a version bump, or a documented "third reading silently + dropped" trade-off), not a silent one. *) let columns = [ "date"; "rite"; "season"; "season_name"; "week"; "slug"; "name"; "weekday"; "rank"; "rank_name"; "colour"; "colour_name"; "subject"; "first"; "gospel"; "comms" ] diff --git a/lib/render/emit_ics.ml b/lib/render/emit_ics.ml index b212930..c47031f 100644 --- a/lib/render/emit_ics.ml +++ b/lib/render/emit_ics.ml @@ -69,10 +69,16 @@ let event b ~rite ~dtstamp d = already has to choose the localised one deliberately. *) let name = s d "name" in let summary = Printf.sprintf "%s (%s, %s)" name (s d "rank_name") (s d "colour_name") in + (* W5: [second] is inserted BETWEEN [first] and [gospel], not appended + after -- reading order (OLM 1981 Praenotanda n. 69.1's own "prima + lectio... secunda lectio... Evangelium"), not declaration order. + Absent for every EF day, the same "" no-op [cite] in [Emit_xml.day] + relies on, so EF's DESCRIPTION line is unchanged BY CONSTRUCTION. *) let desc = String.concat "\n" (List.filter (fun x -> x <> "") [ (if s d "first" <> "" then "Epistle " ^ s d "first" else ""); + (if s d "second" <> "" then "Second " ^ s d "second" else ""); (if s d "gospel" <> "" then "Gospel " ^ s d "gospel" else "") ]) in line b "BEGIN:VEVENT"; diff --git a/lib/render/emit_xml.ml b/lib/render/emit_xml.ml index 3f1ca32..f0849cd 100644 --- a/lib/render/emit_xml.ml +++ b/lib/render/emit_xml.ml @@ -32,7 +32,16 @@ let day b d = if value <> "" then Buffer.add_string b (" <citation part=\"" ^ name ^ "\">" ^ escape value ^ "</citation>\n") in + (* W5: a THIRD element, not a hardcoded pair -- [<citation>] is a repeated + element, not a fixed column, so there is no structural reason to leave + [second] out the way [Emit_csv]'s own fixed header row genuinely must + (see that module's own comment). [cite]'s own [value <> ""] guard + already makes this a no-op for every EF day (view.ml's [day_value] + never sets a "second" key for EF at all, so [s d "second"] resolves to + "" through [get]'s own [None -> ""] fallback) -- EF's XML is therefore + unchanged BY CONSTRUCTION, not by a rite check here. *) cite "first" (s d "first"); + cite "second" (s d "second"); cite "gospel" (s d "gospel"); Buffer.add_string b " </day>\n" diff --git a/lib/render/view.ml b/lib/render/view.ml index 67dfa70..0b122a7 100644 --- a/lib/render/view.ml +++ b/lib/render/view.ml @@ -54,6 +54,43 @@ let citation_ref ~sigla cits part = | Some c -> Sigla.format sigla c.K.Citation.reference | None -> "" +(* W5: the day's own reading citations, keyed by [Citation.part_to_string] + and restricted to the parts THIS DAY ACTUALLY CARRIES -- generalises what + used to be exactly two hardcoded fields ([first]/[gospel]). A day with + [[First; Second; Gospel]] (OF, a Sunday or solemnity, OLM 1981 + Praenotanda n. 69.1/n. 84(b)(c)) now exposes all three keys; a day with + [[First; Gospel]] (OF ferias/feasts/memorials, n. 66.1; every EF day, + unconditionally, RG-cited lectionary) exposes exactly the two it always + did. [K.Citation.all_parts] order (not [cits]' own order) makes the + result deterministic regardless of how the rite built the list. + + An ABSENT part contributes NO KEY at all, not a present key holding the + empty string -- deliberately, for two independent reasons, not one: + (1) [Template.render]'s own documented contract already makes the two + indistinguishable at every place a template can observe them ([Var], + [Section], [Inverted] -- [Template.truthy] treats [Str ""] and a lookup + miss identically), so nothing is lost expressively; (2) {!Emit_json.year} + dumps this whole [Obj] verbatim, with no field list of its own to filter + through (unlike [Emit_csv]/[Emit_xml]/[Emit_ics], each of which names its + fields explicitly). [Citation.all_parts] also lists [Psalm]/[Tract]/ + [Alleluia]/[Sequence] -- deliberately unbuilt by every rite that exists + today (no source, no oracle, CLAUDE.md) -- and NO rite will ever populate + them, so a present-but-always-empty key for each would sit in every EF + day's JSON forever. Filtering to only the PRESENT parts is what makes EF's + output identical byte for byte across every emitter, [Emit_json] included, + BY CONSTRUCTION rather than by a rite check here: EF's [citations] is + always exactly [[First; Gospel]] ({!Rite_ef}'s own [citation_shapes], + {!Colitur_kernel.Validate}'s "citations" check), so the derived key set + below is always {"first"; "gospel"}, in that order -- letter-for-letter + what the two fields this replaces used to produce. *) +let citation_fields ~sigla cits = + List.filter_map + (fun part -> + match citation_ref ~sigla cits part with + | "" -> None + | s -> Some (K.Citation.part_to_string part, str s)) + K.Citation.all_parts + (* A commemoration's own name resolves through the SAME [lang.celebration] table as the observed day's -- a commemoration's slug is drawn from the identical sanctoral/temporal pool, not a second vocabulary. Templates @@ -74,6 +111,18 @@ let comm_value ~lang (c, priv) = so a template can render it blank. Every field a real day has is present and empty, so a template never hits a missing key on a padding cell -- the same key SET as [day_value], not merely the same shape by coincidence. *) +(* [first]/[gospel] stay a fixed pair here, deliberately NOT derived through + [citation_fields] (there is no day, hence no [citations] list, to derive + from): they mirror the closed set every rite CURRENTLY REACHABLE through + this whole grid/booklet path (EF alone -- [bin/main.ml]'s + [reject_rite_for] refuses [--rite] on every command that calls + [of_days]) always carries. A day with a [Second] reading can only enter a + grid once a rite whose [citation_shapes] includes it is admitted to + these commands -- not built yet, tracked as debt rather than + pre-built, CLAUDE.md's own "one field short of the remedy" discipline -- + at which point this list needs the matching key added, or + [test_padding_and_real_share_key_set] (test_view.ml) will catch the + mismatch immediately. *) let padding_cell dow = T.Obj [ ("iso", str ""); ("dom", str ""); ("dow", str (string_of_int dow)); @@ -100,7 +149,7 @@ let day_value ~lang ~sigla ~vocab (d : ('s, 'r) K.Liturgical_day.t) = let colour_s = K.Colour.to_string colour in let season_s = vocab.K.Vocab.season_to_string tmp.K.Temporal.season in T.Obj - [ ("iso", str (K.Date.to_iso8601 date)); + ([ ("iso", str (K.Date.to_iso8601 date)); ("dom", str (string_of_int (K.Date.day date))); ("dow", str (string_of_int (dow_int (K.Date.weekday date)))); ("in_month", bool true); @@ -138,11 +187,10 @@ let day_value ~lang ~sigla ~vocab (d : ('s, 'r) K.Liturgical_day.t) = T.Obj [ ("slug", str (K.Slug.to_string c.K.Celebration.slug)); ("to", str (K.Date.to_iso8601 dest)) ]) - d.K.Liturgical_day.transferred_out) ); - ("first", str (citation_ref ~sigla d.K.Liturgical_day.citations K.Citation.First)); - ("gospel", str (citation_ref ~sigla d.K.Liturgical_day.citations K.Citation.Gospel)); - (* overwritten per grid row by [set_last]; false in the flat [days] list *) - ("last", bool false) ] + d.K.Liturgical_day.transferred_out) ) ] + @ citation_fields ~sigla d.K.Liturgical_day.citations + @ [ (* overwritten per grid row by [set_last]; false in the flat [days] list *) + ("last", bool false) ]) (* Bucket a month's day values into Sunday-started weeks of exactly seven cells, padding both ends. This is the computation the template cannot do. *) @@ -235,7 +283,33 @@ let weeks_of_month ~first_dow ~month_num ~month_name ~month_abbr day_values = template edit. The key list is the vocabulary's own fixed, closed set (lang/*.ini's own [term] section, Task 1/3) -- not open like [celebration], so it is named here rather than invented a second time from a wildcard - enumeration. *) + enumeration. + + W5 judgment call: ["epistle"] (and, less obviously, ["lesson"] -- the + 1962 Missal's own word for a non-apostolic reading, e.g. an Ember day's + Old Testament reading, as opposed to "Epistola" proper; see + [tools/bootstrap_lectionary.ml]'s "last lesson before the Gospel" + comments) ARE genuinely EF/Roman vocabulary sitting in this otherwise + rite-agnostic list, the same category CLAUDE.md's "carried into Plan 4" + section already tracks for [validate.ml]/[Liturgical_day.transferred_in]/ + [Precedence.privilege]/[Repose]. Left UNCHANGED here rather than made + rite-supplied or renamed, for a reason specific to this key rather than a + blanket "not worth it": nothing FORCES the fix yet. + [bin/main.ml]'s [reject_rite_for] refuses [--rite] on every command that + reaches [term_value] (`table`/`emit`/`render`/`publish`), so OF cannot + reach a template that reads [term.epistle] today, and no OF template + exists under [templates/] to need a different word (only [templates/ef/] + does, and every one of them already reads [term.epistle]). Renaming it + would be a breaking change to those 11 shipped templates AND to any + user's own template, for zero present behavioural difference -- exactly + the trade [Rite.t.citation_shapes]'s own doc comment warns a template-key + rename always is. ["lesson"] already sits unused by any shipped template, + is already translated in both [lang/en.ini] ("Lesson") and [lang/la.ini] + ("Lectio"), and is the natural neutral term a future OF ordo template + would reach for -- so the infrastructure an eventual fix needs already + exists; only the forcing function (OF actually reaching this command) is + missing. Recorded here as the next instance of the pattern rather than + fixed speculatively, matching CLAUDE.md item 8's own discipline. *) let term_keys = [ "ordo"; "contents"; "epistle"; "lesson"; "gospel"; "commemoration"; "week" ] let term_value lang = T.Obj (List.map (fun k -> (k, str (Lang.term lang k))) term_keys) diff --git a/test/test_emit.ml b/test/test_emit.ml index 0a40054..bd9cadc 100644 --- a/test/test_emit.ml +++ b/test/test_emit.ml @@ -91,6 +91,20 @@ let test_csv_quotes_commas () = Alcotest.(check bool) "Joseph's comma-bearing name is quoted whole, not split" true (contains ~needle:"\"St. Joseph, Spouse of the Bl. Virgin Mary\"" joseph) +(* W5: a day with [[First; Second; Gospel]] MUST NOT widen the CSV's own + fixed 16-column header -- see [Emit_csv]'s own comment for why a variable + column count is not RFC 4180-legal. Guards the deliberate-drop claim made + there with an actual assertion, not only a comment: still exactly 16 + fields (the [Second] reading genuinely absent from the row, not merely + untested), and the header is unchanged. *) +let test_csv_does_not_widen_for_a_third_citation () = + let out = Csv.year (Test_view.three_citation_view ()) in + let lines = String.split_on_char '\n' out |> List.filter (fun l -> l <> "") in + Alcotest.(check string) "header unchanged" + "date,rite,season,season_name,week,slug,name,weekday,rank,rank_name,colour,colour_name,subject,first,gospel,comms" + (List.hd lines); + Alcotest.(check int) "row still 16 fields" 16 (List.length (parse_csv_row (List.nth lines 1))) + let test_json_parses_back () = let out = Json.year (view_2027 ()) in Alcotest.(check bool) "starts as an object" true (out.[0] = '{'); @@ -133,6 +147,8 @@ let suite = ( "Emit/csv+json", [ Alcotest.test_case "csv header and rows" `Quick test_csv_header_and_rows; Alcotest.test_case "csv quotes commas" `Quick test_csv_quotes_commas; + Alcotest.test_case "csv does not widen for a third citation" `Quick + test_csv_does_not_widen_for_a_third_citation; Alcotest.test_case "json parses back" `Quick test_json_parses_back; Alcotest.test_case "json escapes" `Quick test_json_escapes; Alcotest.test_case "json passes utf8 through" `Quick test_utf8_passes_through_json ] ) @@ -194,10 +210,38 @@ let test_xml_escapes_live_data () = String.iteri (fun i c -> if c = '&' && not (is_entity_at out i) then incr bare) out; Alcotest.(check int) "no bare, unescaped '&' anywhere in the document" 0 !bare +(* First index [needle] starts at in [hay], or fails the test -- a small, + dependency-free substring search (no [Str], per the project's frozen + deps), sufficient for the fixed literal tags searched for below. *) +let index_of ~needle hay = + let n = String.length needle and h = String.length hay in + let rec go i = + if i + n > h then Alcotest.failf "%S not found" needle + else if String.sub hay i n = needle then i + else go (i + 1) + in + go 0 + +(* W5: unlike CSV, XML has no fixed column count -- [<citation>] is a + repeated element, so a [Second] reading is a third element, not a + breaking schema change. Checks BOTH the presence and the ORDER + (first, second, gospel -- reading order, not declaration order in + [Emit_xml.day]'s own three [cite] calls). *) +let test_xml_three_citations () = + let out = Xml.year (Test_view.three_citation_view ()) in + Alcotest.(check bool) "second citation present" true + (contains ~needle:"<citation part=\"second\">1 Cor 1:3-9</citation>" out); + let first_at = index_of ~needle:"<citation part=\"first\">" out in + let second_at = index_of ~needle:"<citation part=\"second\">" out in + let gospel_at = index_of ~needle:"<citation part=\"gospel\">" out in + Alcotest.(check bool) "reading order: first < second < gospel" true + (first_at < second_at && second_at < gospel_at) + let xml_suite = ( "Emit/xml", [ Alcotest.test_case "shape" `Quick test_xml_shape; Alcotest.test_case "tags balance" `Quick test_xml_tags_balance; Alcotest.test_case "escapes data" `Quick test_xml_escapes_data; Alcotest.test_case "escapes live data (2035, Fabian & Sebastian)" `Quick - test_xml_escapes_live_data ] ) + test_xml_escapes_live_data; + Alcotest.test_case "three citations, in reading order" `Quick test_xml_three_citations ] ) diff --git a/test/test_ics.ml b/test/test_ics.ml index 7d1ca37..fef20c7 100644 --- a/test/test_ics.ml +++ b/test/test_ics.ml @@ -78,6 +78,20 @@ let test_text_escaped () = let rec f i = i + n <= String.length joseph && (String.sub joseph i n = re || f (i + 1)) in f 0) +(* W5: like [Emit_xml] and unlike [Emit_csv], DESCRIPTION is free text, not + a fixed column -- a [Second] reading is a third joined line, not a + breaking schema change. [second] is spliced BETWEEN [first]/[gospel] + (reading order, OLM 1981 Praenotanda n. 69.1), matching + [Emit_xml.day]'s own ordering. Asserts the exact line rather than a + substring: short enough (69 octets incl. the "DESCRIPTION:" property + name) to stay under RFC 5545's 75-octet fold threshold, so it is one + physical line, not merely one logical property split across several. *) +let test_description_carries_second_reading_in_order () = + let ls = lines (Ics.year (Test_view.three_citation_view ())) in + let desc = List.find (fun l -> count_prefix "DESCRIPTION:" [ l ] = 1) ls in + Alcotest.(check string) "Epistle, Second, Gospel, in that order" + "DESCRIPTION:Epistle Rom 1:1-7\\nSecond 1 Cor 1:3-9\\nGospel John 1:1-14" desc + let test_dtstamp_is_a_parameter () = let a = Ics.year ~dtstamp:"20200101T000000Z" (Test_view.view_of 2027) in let b = Ics.year ~dtstamp:"20210101T000000Z" (Test_view.view_of 2027) in @@ -138,6 +152,8 @@ let suite = Alcotest.test_case "folded and CRLF" `Quick test_every_line_folded_and_crlf; Alcotest.test_case "no RRULE" `Quick test_no_rrule; Alcotest.test_case "text escaped" `Quick test_text_escaped; + Alcotest.test_case "description carries second reading in order" `Quick + test_description_carries_second_reading_in_order; Alcotest.test_case "DTSTAMP is a parameter" `Quick test_dtstamp_is_a_parameter; Alcotest.test_case "DTEND omitted at domain end" `Quick test_dtend_omitted_at_domain_end; Alcotest.test_case "all 9999 DTENDs are eight digits" `Quick test_all_9999_dtends_are_eight_digits ] ) diff --git a/test/test_view.ml b/test/test_view.ml index a542419..bbed8ee 100644 --- a/test/test_view.ml +++ b/test/test_view.ml @@ -140,6 +140,41 @@ let test_day_fields () = Alcotest.(check bool) "first citation present" true (as_str (get [ "first" ] d) <> ""); Alcotest.(check bool) "gospel citation present" true (as_str (get [ "gospel" ] d) <> "") +(* W5's own reason for existing: OF cannot reach [View.of_days] through the + CLI today ([bin/main.ml]'s [reject_rite_for] refuses [--rite] on every + command that would build one), so the only honest way to exercise a + THREE-citation day through this path is to drive [View.of_days] directly + with a hand-built [Liturgical_day.t] -- which rite actually produced the + citations is irrelevant to the render layer; only [citations] itself is. + Reuses a real EF day's [temporal]/[observed]/etc. (record update syntax) + purely as scaffolding, with its own two real citations discarded and + replaced -- nothing here asserts anything EF-specific. Exposed (not + [let () = ...] inline) so [test_emit.ml]/[test_ics.ml] can drive the same + synthetic day through [Emit_xml]/[Emit_ics] without duplicating it. *) +let three_citation_view () = + let module K = Colitur_kernel in + let real = List.hd (days_of_year 2027) in + let synthetic = + { real with + K.Liturgical_day.citations = + [ { K.Citation.part = K.Citation.First; reference = "Rom 1:1-7" }; + { K.Citation.part = K.Citation.Second; reference = "1 Cor 1:3-9" }; + { K.Citation.part = K.Citation.Gospel; reference = "Ioann 1:1-14" } ] } + in + let lang = Lazy.force default_lang in + V.of_days ~lang ~sigla:(Test_support.default_sigla lang) ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:2027 + [ synthetic ] + +let test_three_citation_day_exposes_all_three () = + let v = three_citation_view () in + let d = List.hd (as_list (get [ "days" ] v)) in + Alcotest.(check string) "first" "Rom 1:1-7" (as_str (get [ "first" ] d)); + Alcotest.(check string) "second" "1 Cor 1:3-9" (as_str (get [ "second" ] d)); + (* "Ioann" -> "John": the stored (Latin) book abbreviation renders through + [sigla] the same as [first]/[gospel] always have -- proving [second] + shares the identical [Sigla.format] path, not a second, divergent one. *) + Alcotest.(check string) "gospel" "John 1:1-14" (as_str (get [ "gospel" ] d)) + (* Exactly one of the six colour booleans is true on every day of a whole year: a template that keys a cell colour off them can never get no colour or two. *) let test_exactly_one_colour_flag () = @@ -164,6 +199,21 @@ let keys_of = function | T.Obj kvs -> List.sort compare (List.map fst kvs) | _ -> Alcotest.fail "expected an object" +(* W5: EF's own citations are always exactly [First; Gospel] + ({!Rite_ef}'s own [citation_shapes]) -- so no EF day's key set should + EVER include "second" (or any of the other still-unbuilt parts: + "psalm"/"tract"/"alleluia"/"sequence"). Confirms the "absent key, not a + present key holding the empty string" half of [View.citation_fields]'s + own design, over a whole year rather than one sampled day. *) +let test_ef_days_never_carry_a_second_key () = + let v = view_of 2027 in + List.iter + (fun d -> + List.iter + (fun k -> if List.mem k (keys_of d) then Alcotest.failf "%s carries an unexpected key %s" (as_str (get [ "iso" ] d)) k) + [ "second"; "psalm"; "tract"; "alleluia"; "sequence" ]) + (as_list (get [ "days" ] v)) + let test_padding_and_real_share_key_set () = let v = view_of 2027 in let jan = List.hd (as_list (get [ "months" ] v)) in @@ -318,6 +368,8 @@ let suite = Alcotest.test_case "padding cells flagged" `Quick test_padding_cells_are_flagged; Alcotest.test_case "first week flagged" `Quick test_first_week_flag; Alcotest.test_case "padding and real days share key set" `Quick test_padding_and_real_share_key_set; + Alcotest.test_case "EF days never carry a second key" `Quick test_ef_days_never_carry_a_second_key; + Alcotest.test_case "three-citation day exposes all three" `Quick test_three_citation_day_exposes_all_three; Alcotest.test_case "week num_roman and month fields" `Quick test_week_num_roman_and_month_fields; Alcotest.test_case "week date span" `Quick test_week_date_span; Alcotest.test_case "single_day agrees with span and cells" `Quick test_single_day_agrees_with_span_and_cells; |
