aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLukasz Kasprzak <lukas@labunix.xyz>2026-08-19 08:41:23 +0200
committerLukasz Kasprzak <lukas@labunix.xyz>2026-08-19 08:41:23 +0200
commit063d4058346f7dc03eb0aa5ba394b9a872d3f1e3 (patch)
tree93d1ff06c91affc6586c64dc0326460b675f9e9b
parent5828571fa31a0480838d1ede210002ab50768c64 (diff)
downloadcolitur-063d4058346f7dc03eb0aa5ba394b9a872d3f1e3.tar.gz
colitur-063d4058346f7dc03eb0aa5ba394b9a872d3f1e3.zip
feat(render): CSV and JSON emitters, and the published contract
Both consume the VIEW, not the kernel, so every emitter and every template describe exactly the same fields -- there is one vocabulary, not five. CSV is RFC 4180: a field with a comma is quoted. That is live on real data, not hypothetical -- 'St. Joseph, Spouse of the Bl. Virgin Mary' would otherwise split into two columns. JSON is hand-rolled because the dependency list is frozen and escaping is the only subtlety. Control characters below 0x20 are \u-escaped per RFC 8259 section 7. There are no numbers in the view, deliberately: a consumer never has to guess whether week is 2 or "2". schema/day-v1.json pins the shape. Once a phone subscribes or a site fetches this, it is a promise to strangers -- adding a field is minor, renaming one means /v2/.
-rw-r--r--lib/render/emit_csv.ml44
-rw-r--r--lib/render/emit_csv.mli9
-rw-r--r--lib/render/emit_json.ml47
-rw-r--r--lib/render/emit_json.mli10
-rw-r--r--schema/day-v1.json73
-rw-r--r--test/test_colitur.ml3
-rw-r--r--test/test_emit.ml77
7 files changed, 262 insertions, 1 deletions
diff --git a/lib/render/emit_csv.ml b/lib/render/emit_csv.ml
new file mode 100644
index 0000000..b478265
--- /dev/null
+++ b/lib/render/emit_csv.ml
@@ -0,0 +1,44 @@
+(* emit_csv.ml *)
+module T = Template
+
+let escape_field s =
+ let needs =
+ String.exists (fun c -> c = ',' || c = '"' || c = '\n' || c = '\r') s
+ in
+ if not needs then s
+ else begin
+ let b = Buffer.create (String.length s + 8) in
+ Buffer.add_char b '"';
+ String.iter (fun c -> if c = '"' then Buffer.add_string b "\"\"" else Buffer.add_char b c) s;
+ Buffer.add_char b '"';
+ Buffer.contents b
+ end
+
+let get v k = match v with T.Obj kvs -> List.assoc_opt k kvs | _ -> None
+let s v k = match get v k with Some (T.Str x) -> x | _ -> ""
+let nested v a b = match get v a with Some inner -> s inner b | None -> ""
+
+let columns =
+ [ "date"; "rite"; "season"; "week"; "slug"; "rank"; "colour"; "subject";
+ "name_la"; "name_en"; "first"; "gospel"; "comms" ]
+
+let row ~rite d =
+ let comms =
+ match get d "comms" with
+ | Some (T.List l) -> String.concat " " (List.map (fun c -> s c "slug") l)
+ | _ -> ""
+ in
+ String.concat ","
+ (List.map escape_field
+ [ s d "iso"; rite; s d "season"; s d "week"; s d "slug"; s d "rank";
+ s d "colour"; s d "subject"; nested d "name" "la"; nested d "name" "en";
+ s d "first"; s d "gospel"; comms ])
+
+let year v =
+ let rite = s v "rite" in
+ let days = match get v "days" with Some (T.List l) -> l | _ -> [] in
+ let b = Buffer.create (64 * 400) in
+ Buffer.add_string b (String.concat "," columns);
+ Buffer.add_char b '\n';
+ List.iter (fun d -> Buffer.add_string b (row ~rite d); Buffer.add_char b '\n') days;
+ Buffer.contents b
diff --git a/lib/render/emit_csv.mli b/lib/render/emit_csv.mli
new file mode 100644
index 0000000..262f660
--- /dev/null
+++ b/lib/render/emit_csv.mli
@@ -0,0 +1,9 @@
+(* emit_csv.mli *)
+(** One row per day, RFC 4180. Consumes the VIEW, not the kernel, so every
+ emitter describes exactly the same fields as every template. *)
+
+(** RFC 4180 section 2: quote a field containing a comma, a quote or a newline;
+ double an embedded quote. Exposed for testing. *)
+val escape_field : string -> string
+
+val year : Template.value -> string
diff --git a/lib/render/emit_json.ml b/lib/render/emit_json.ml
new file mode 100644
index 0000000..272e4ca
--- /dev/null
+++ b/lib/render/emit_json.ml
@@ -0,0 +1,47 @@
+(* emit_json.ml *)
+module T = Template
+
+let escape_string s =
+ let b = Buffer.create (String.length s + 8) in
+ Buffer.add_char b '"';
+ String.iter
+ (fun c ->
+ match c with
+ | '"' -> Buffer.add_string b "\\\""
+ | '\\' -> Buffer.add_string b "\\\\"
+ | '\n' -> Buffer.add_string b "\\n"
+ | '\r' -> Buffer.add_string b "\\r"
+ | '\t' -> Buffer.add_string b "\\t"
+ | c when Char.code c < 0x20 -> Buffer.add_string b (Printf.sprintf "\\u%04x" (Char.code c))
+ | c -> Buffer.add_char b c)
+ s;
+ Buffer.add_char b '"';
+ Buffer.contents b
+
+(* Emit the view tree directly. Bools stay bools; everything else is a string,
+ an array or an object -- there are no numbers in the view, deliberately, so a
+ consumer never has to guess whether "week" is 2 or "2". *)
+let rec write b (v : T.value) =
+ match v with
+ | T.Str s -> Buffer.add_string b (escape_string s)
+ | T.Bool x -> Buffer.add_string b (if x then "true" else "false")
+ | T.List l ->
+ Buffer.add_char b '[';
+ List.iteri (fun i x -> if i > 0 then Buffer.add_char b ','; write b x) l;
+ Buffer.add_char b ']'
+ | T.Obj kvs ->
+ Buffer.add_char b '{';
+ List.iteri
+ (fun i (k, x) ->
+ if i > 0 then Buffer.add_char b ',';
+ Buffer.add_string b (escape_string k);
+ Buffer.add_char b ':';
+ write b x)
+ kvs;
+ Buffer.add_char b '}'
+
+let year v =
+ let b = Buffer.create (64 * 1024) in
+ write b v;
+ Buffer.add_char b '\n';
+ Buffer.contents b
diff --git a/lib/render/emit_json.mli b/lib/render/emit_json.mli
new file mode 100644
index 0000000..91c8f48
--- /dev/null
+++ b/lib/render/emit_json.mli
@@ -0,0 +1,10 @@
+(* emit_json.mli *)
+(** JSON writer. Hand-rolled: the dependency list is frozen (spec section 1),
+ and writing JSON is a page of code where escaping is the only subtlety.
+ Output shape is pinned by schema/day-v1.json, the published contract. *)
+
+(** RFC 8259 section 7, including \u-escaping of control characters below 0x20.
+ Returns the value WITH its surrounding quotes. Exposed for testing. *)
+val escape_string : string -> string
+
+val year : Template.value -> string
diff --git a/schema/day-v1.json b/schema/day-v1.json
new file mode 100644
index 0000000..b48133a
--- /dev/null
+++ b/schema/day-v1.json
@@ -0,0 +1,73 @@
+{
+ "$schema": "https://json-schema.org/draft/2020-12/schema",
+ "$id": "https://colitur/schema/day-v1.json",
+ "title": "colitur liturgical year, v1",
+ "type": "object",
+ "required": ["rite", "year", "months", "days"],
+ "properties": {
+ "rite": { "type": "string" },
+ "year": { "type": "string", "pattern": "^[0-9]{4}$" },
+ "months": { "type": "array", "items": { "$ref": "#/$defs/month" } },
+ "days": { "type": "array", "items": { "$ref": "#/$defs/day" } }
+ },
+ "$defs": {
+ "month": {
+ "type": "object",
+ "required": ["num", "name", "days", "weeks"],
+ "properties": {
+ "num": { "type": "string" },
+ "name": { "type": "object", "additionalProperties": { "type": "string" } },
+ "days": { "type": "array", "items": { "$ref": "#/$defs/day" } },
+ "weeks": { "type": "array", "items": { "$ref": "#/$defs/week" } }
+ }
+ },
+ "week": {
+ "type": "object",
+ "required": ["num", "days"],
+ "properties": {
+ "num": { "type": "string" },
+ "days": { "type": "array", "minItems": 7, "maxItems": 7, "items": { "$ref": "#/$defs/day" } }
+ }
+ },
+ "day": {
+ "type": "object",
+ "required": ["iso", "dom", "dow", "in_month", "season", "week", "slug",
+ "name", "rank", "colour", "is_white", "is_red", "is_green",
+ "is_violet", "is_rose", "is_black", "subject", "comms",
+ "transferred_in", "transferred_out", "first", "gospel", "last"],
+ "properties": {
+ "iso": { "type": "string", "description": "empty on a grid padding cell" },
+ "dom": { "type": "string" },
+ "dow": { "type": "string", "description": "0 = Sunday" },
+ "in_month": { "type": "boolean", "description": "false = grid padding cell" },
+ "season": { "type": "string" },
+ "week": { "type": "string", "description": "empty when the rite numbers no week here" },
+ "slug": { "type": "string" },
+ "name": { "type": "object", "additionalProperties": { "type": "string" } },
+ "rank": { "type": "string" },
+ "colour": { "type": "string", "enum": ["white","red","green","violet","rose","black",""] },
+ "is_white": { "type": "boolean" }, "is_red": { "type": "boolean" },
+ "is_green": { "type": "boolean" }, "is_violet":{ "type": "boolean" },
+ "is_rose": { "type": "boolean" }, "is_black": { "type": "boolean" },
+ "subject": { "type": "string" },
+ "comms": {
+ "type": "array",
+ "items": {
+ "type": "object",
+ "required": ["slug", "name", "privileged"],
+ "properties": {
+ "slug": { "type": "string" },
+ "name": { "type": "object", "additionalProperties": { "type": "string" } },
+ "privileged": { "type": "boolean" }
+ }
+ }
+ },
+ "transferred_in": { "type": "array", "items": { "type": "object" } },
+ "transferred_out": { "type": "array", "items": { "type": "object" } },
+ "first": { "type": "string", "description": "Epistle/Lesson citation, never scripture text" },
+ "gospel": { "type": "string", "description": "Gospel citation, never scripture text" },
+ "last": { "type": "boolean", "description": "true on the 7th cell of a grid row" }
+ }
+ }
+ }
+}
diff --git a/test/test_colitur.ml b/test/test_colitur.ml
index dadc77d..b61eed6 100644
--- a/test/test_colitur.ml
+++ b/test/test_colitur.ml
@@ -10,4 +10,5 @@ let () =
Test_escape.suite;
Test_template.suite;
Test_template.render_suite;
- Test_view.suite ]
+ Test_view.suite;
+ Test_emit.suite ]
diff --git a/test/test_emit.ml b/test/test_emit.ml
new file mode 100644
index 0000000..a8fd45c
--- /dev/null
+++ b/test/test_emit.ml
@@ -0,0 +1,77 @@
+module V = Colitur_render.View
+module Csv = Colitur_render.Emit_csv
+module Json = Colitur_render.Emit_json
+
+let view_2027 () = Test_view.view_of 2027
+
+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
+ Alcotest.(check bool) "the comma in Joseph's name is quoted, not a field break" true
+ (String.length (String.split_on_char ',' joseph |> List.hd) = 10)
+
+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 ] )