summaryrefslogtreecommitdiff
path: root/lib/render/emit_xml.ml
diff options
context:
space:
mode:
authorLukasz Kasprzak <lukas@labunix.xyz>2026-08-19 08:57:42 +0200
committerLukasz Kasprzak <lukas@labunix.xyz>2026-08-19 08:57:42 +0200
commit544836cf0f6373a0a753d0953ce7e60fd96337af (patch)
treea3d22c5d754c435ad2e65203d60690e6b1dea039 /lib/render/emit_xml.ml
parent9608e49a0956c8228a022454751765404d46daa5 (diff)
downloadcolitur-544836cf0f6373a0a753d0953ce7e60fd96337af.tar.gz
colitur-544836cf0f6373a0a753d0953ce7e60fd96337af.zip
feat(render): XML emitter and schema
Element-per-field; attributes carry identity only and there is no mixed content, so a consumer's XPath never has to distinguish the two. Schema validation is an opt-in make check-schema via xmllint, not an in-suite assertion: validating XSD needs an XML library and the dependency list is frozen. It prints SKIPPED loudly when xmllint is absent, because a silent skip reads as a pass. The suite asserts well-formedness properties directly instead. This corrects the design spec, which claimed in-test validation.
Diffstat (limited to 'lib/render/emit_xml.ml')
-rw-r--r--lib/render/emit_xml.ml48
1 files changed, 48 insertions, 0 deletions
diff --git a/lib/render/emit_xml.ml b/lib/render/emit_xml.ml
new file mode 100644
index 0000000..4e4b51a
--- /dev/null
+++ b/lib/render/emit_xml.ml
@@ -0,0 +1,48 @@
+(* emit_xml.ml *)
+module T = Template
+
+let escape s = Escape.apply Escape.Xml s
+
+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 el b name value =
+ Buffer.add_string b (" <" ^ name ^ ">" ^ escape value ^ "</" ^ name ^ ">\n")
+
+let day b d =
+ Buffer.add_string b (" <day date=\"" ^ escape (s d "iso") ^ "\">\n");
+ el b "season" (s d "season");
+ el b "week" (s d "week");
+ el b "slug" (s d "slug");
+ el b "rank" (s d "rank");
+ el b "colour" (s d "colour");
+ el b "subject" (s d "subject");
+ (match get d "name" with
+ | Some (T.Obj kvs) ->
+ List.iter
+ (fun (lang, v) ->
+ match v with
+ | T.Str x -> Buffer.add_string b (" <name lang=\"" ^ escape lang ^ "\">" ^ escape x ^ "</name>\n")
+ | _ -> ())
+ kvs
+ | _ -> ());
+ (match get d "comms" with
+ | Some (T.List l) ->
+ List.iter (fun c -> Buffer.add_string b (" <commemoration>" ^ escape (s c "slug") ^ "</commemoration>\n")) l
+ | _ -> ());
+ let cite name value =
+ if value <> "" then
+ Buffer.add_string b (" <citation part=\"" ^ name ^ "\">" ^ escape value ^ "</citation>\n")
+ in
+ cite "first" (s d "first");
+ cite "gospel" (s d "gospel");
+ Buffer.add_string b " </day>\n"
+
+let year v =
+ let b = Buffer.create (128 * 1024) in
+ Buffer.add_string b "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
+ Buffer.add_string b
+ ("<calendar rite=\"" ^ escape (s v "rite") ^ "\" year=\"" ^ escape (s v "year") ^ "\">\n");
+ Buffer.add_string b " <days>\n";
+ (match get v "days" with Some (T.List l) -> List.iter (day b) l | _ -> ());
+ Buffer.add_string b " </days>\n</calendar>\n";
+ Buffer.contents b