diff options
| author | Lukasz Kasprzak <lukas@labunix.xyz> | 2026-08-19 11:48:30 +0200 |
|---|---|---|
| committer | Lukasz Kasprzak <lukas@labunix.xyz> | 2026-08-19 11:48:30 +0200 |
| commit | 6762ce46af3cb12bc6ae37cda762c5d95add7903 (patch) | |
| tree | bc1d8c86050d0149ff961a9a4ff838f9c474ac2a /test/test_emit.ml | |
| parent | 897c274fd28402159ca6d45eedc1257b1ce98696 (diff) | |
| parent | 390bc6ac5196a946c473d0dbe7760fa41837c428 (diff) | |
| download | colitur-6762ce46af3cb12bc6ae37cda762c5d95add7903.tar.gz colitur-6762ce46af3cb12bc6ae37cda762c5d95add7903.zip | |
feat: output, rendering and publishing
Gives colitur a publishable exit. Until now its only output was terminal
rows; it can now print an ordo booklet and a wall calendar, publish an
iCalendar feed people subscribe to, and serve a static JSON/XML API.
lib/render escaping (six flavours + RFC 5545 folding), a deliberately
logic-less template engine, the view model, and five
emitters (CSV, JSON, XML, iCalendar, S-expression)
CLI emit, table, render, publish -- all accepting --overlay
templates ordo booklet in six flavours, wall grid in three
schema day-v1.json and colitur-v1.xsd, the published contract
man colitur-templates.5, plus colitur.1 updates
The view model is why the engine can stay logic-less: a month grid needs
leading blank cells, week bucketing and an in-month test, and a
logic-less template can compute none of it. Shaping the data in OCaml
keeps the engine safe for untrusted templates and makes the grid
trivial.
Formats split by whether correctness is mechanical. Presentation goes
through templates; iCalendar and XML get dedicated emitters, because
folding, exclusive DTEND, stable UIDs and schema fidelity are rules a
template cannot enforce and each fails silently in a subscriber's
client rather than loudly at generation.
publish is deterministic and non-destructive: two runs produce a
byte-identical tree, and --prune removes only files a previous run
created, refusing any manifest entry that escapes the output directory.
No new dependencies. The kernel and rite modules are untouched, and
colitur day and colitur readings remain byte-identical.
Diffstat (limited to 'test/test_emit.ml')
| -rw-r--r-- | test/test_emit.ml | 203 |
1 files changed, 203 insertions, 0 deletions
diff --git a/test/test_emit.ml b/test/test_emit.ml new file mode 100644 index 0000000..a22eaaf --- /dev/null +++ b/test/test_emit.ml @@ -0,0 +1,203 @@ +module V = Colitur_render.View +module Csv = Colitur_render.Emit_csv +module Json = Colitur_render.Emit_json +module Xml = Colitur_render.Emit_xml + +let view_2027 () = Test_view.view_of 2027 + +(* Substring search shared by several live-data checks below (CSV, XML), in + place of a repeated inline recursive finder. *) +let contains ~needle hay = + let n = String.length needle and h = String.length hay in + let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in + go 0 + +(* A byte-accurate RFC 4180 field splitter. [String.split_on_char ','] cannot + be trusted to count fields: a correctly QUOTED field is legally allowed to + contain a comma (exactly what Joseph's own name field does below), so a + naive split over-counts by the number of internal commas whether or not + they are correctly quoted -- it cannot tell the difference, which is + precisely why the test this replaced was vacuous. *) +let parse_csv_row line = + let n = String.length line in + let fields = ref [] in + let buf = Buffer.create 32 in + let i = ref 0 in + while !i < n do + if line.[!i] = '"' then begin + incr i; + let closed = ref false in + while (not !closed) && !i < n do + if line.[!i] = '"' then + if !i + 1 < n && line.[!i + 1] = '"' then begin + Buffer.add_char buf '"'; + i := !i + 2 + end + else begin + incr i; + closed := true + end + else begin + Buffer.add_char buf line.[!i]; + incr i + end + done + end + else if line.[!i] = ',' then begin + fields := Buffer.contents buf :: !fields; + Buffer.clear buf; + incr i + end + else begin + Buffer.add_char buf line.[!i]; + incr i + end + done; + fields := Buffer.contents buf :: !fields; + List.rev !fields + +let test_csv_header_and_rows () = + let out = Csv.year (view_2027 ()) in + let lines = String.split_on_char '\n' out |> List.filter (fun l -> l <> "") in + Alcotest.(check int) "366 lines: header + 365 days" 366 (List.length lines); + Alcotest.(check string) "header" + "date,rite,season,week,slug,rank,colour,subject,name_la,name_en,first,gospel,comms" + (List.hd lines); + Alcotest.(check bool) "first row is 1 January" true + (String.length (List.nth lines 1) > 10 && String.sub (List.nth lines 1) 0 10 = "2027-01-01") + +(* RFC 4180: a field containing a comma, quote or newline is quoted, and an + embedded quote is doubled. Feast names contain commas ("St. Joseph, Spouse + of the Bl. Virgin Mary"), so this is live on real data, not hypothetical. *) +let test_csv_quotes_commas () = + Alcotest.(check string) "comma quoted" "\"a,b\"" (Csv.escape_field "a,b"); + Alcotest.(check string) "quote doubled" "\"a\"\"b\"" (Csv.escape_field "a\"b"); + Alcotest.(check string) "plain unquoted" "ab" (Csv.escape_field "ab"); + let out = Csv.year (view_2027 ()) in + let joseph = + List.find + (fun l -> String.length l > 10 && String.sub l 0 10 = "2027-03-19") + (String.split_on_char '\n' out) + in + (* The check this replaced inspected the length of the FIRST field only -- + always the 10-char ISO date, which can never contain a comma, so it + could never fail. Parse the row as RFC 4180 actually requires + (quote-aware) and check the FIELD COUNT against the header: a comma + that escapes its quoting produces 14 fields, not 13. Also assert the + quoted substring appears literally, byte for byte -- belt and braces, + and closer to what a human reviewing the CSV would actually look for. *) + Alcotest.(check int) "the row has exactly 13 fields, same as the header" + 13 (List.length (parse_csv_row joseph)); + 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) + +let test_json_parses_back () = + let out = Json.year (view_2027 ()) in + Alcotest.(check bool) "starts as an object" true (out.[0] = '{'); + let count sub = + let n = String.length sub in + let rec go i acc = + if i + n > String.length out then acc + else go (i + 1) (if String.sub out i n = sub then acc + 1 else acc) + in + go 0 0 + in + Alcotest.(check bool) "has a days array" true (count "\"days\":[" >= 1); + (* Every ISO date the view produced appears in the JSON -- that is the + property under test, not a specific occurrence count. The count is NOT + 1: the view deliberately offers both artefacts at every level (view.mli) + -- the flat top-level [days], each month's own [days], and that month's + [weeks] grid cell -- so an ordinary date's "iso" field appears 3 times. + Verified against the real 2027 engine output (all 365 dates checked); + the one exception is legitimate, not a bug: 2027-04-05 appears 6 times + because the Annunciation (25 March, impeded by Holy Week) transfers to + it under RG 96/98, and its own "to" target string is the identical + literal, tripled by the same structural redundancy. *) + Alcotest.(check int) "1 January appears (flat days + month days + week grid)" 3 + (count "\"2027-01-01\""); + Alcotest.(check int) "31 December appears (flat days + month days + week grid)" 3 + (count "\"2027-12-31\"") + +let test_json_escapes () = + Alcotest.(check string) "quote" "\"a\\\"b\"" (Json.escape_string "a\"b"); + Alcotest.(check string) "backslash" "\"a\\\\b\"" (Json.escape_string "a\\b"); + Alcotest.(check string) "newline" "\"a\\nb\"" (Json.escape_string "a\nb"); + Alcotest.(check string) "tab" "\"a\\tb\"" (Json.escape_string "a\tb"); + (* Control characters below 0x20 must be \u-escaped (RFC 8259 section 7). *) + Alcotest.(check string) "control" "\"a\\u0001b\"" (Json.escape_string "a\001b") + +let test_utf8_passes_through_json () = + Alcotest.(check string) "polish" "\"\xc5\x9awi\xc4\x99tej\"" (Json.escape_string "\xc5\x9awi\xc4\x99tej") + +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 "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 ] ) + +let test_xml_shape () = + let out = Xml.year (view_2027 ()) in + Alcotest.(check bool) "declaration" true + (String.length out > 5 && String.sub out 0 5 = "<?xml"); + Alcotest.(check bool) "root element" true + (contains ~needle:"<calendar rite=\"ef\" year=\"2027\">" out) + +(* Every '<' in the output must open a tag: an unescaped '<' inside a feast + name is the failure that makes a whole feed unparseable. *) +let test_xml_tags_balance () = + let out = Xml.year (view_2027 ()) in + let opens = ref 0 and closes = ref 0 in + String.iter (fun c -> if c = '<' then incr opens else if c = '>' then incr closes) out; + Alcotest.(check int) "every < has a >" !opens !closes + +let test_xml_escapes_data () = + Alcotest.(check string) "amp" "a & b" (Xml.escape "a & b"); + Alcotest.(check string) "angle" "<x>" (Xml.escape "<x>") + +(* [is_entity_at s i] recognises the five predefined XML entities and a + numeric character reference starting at [s.[i]] = '&'. Anything else + starting at a '&' is a bare, illegal ampersand -- exactly what + [xmllint --noout] refuses a document over. *) +let is_entity_at s i = + let n = String.length s in + let starts_with prefix = + let pn = String.length prefix in + i + pn <= n && String.sub s i pn = prefix + in + starts_with "&" || starts_with "<" || starts_with ">" + || starts_with """ || starts_with "'" + || + (* &#NNN; -- one or more digits then ';'. *) + (i + 2 < n && s.[i + 1] = '#' + && + let j = ref (i + 2) in + while !j < n && s.[!j] >= '0' && s.[!j] <= '9' do + incr j + done; + !j > i + 2 && !j < n && s.[!j] = ';') + +(* Live-data check. [test_xml_escapes_data] above proves [Escape.Xml] is + correct in isolation; it proves nothing about whether [Emit_xml.year] + actually CALLS it on every interpolated value -- bypassing that call + while leaving [Escape.Xml] itself untouched left every test in this suite + green (mutation-proven; see the branch review that found this). Real 2035 + output carries "Sts. Fabian & Sebastian" (20 January) unescaped in the + source data, which is exactly the case that must come out as "&", and + the whole document must then contain no OTHER bare '&' anywhere. *) +let test_xml_escapes_live_data () = + let out = Xml.year (Test_view.view_of 2035) in + Alcotest.(check bool) "Fabian & Sebastian's ampersand is escaped" true + (contains ~needle:"&" out); + let bare = ref 0 in + 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 + +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 ] ) |
