aboutsummaryrefslogtreecommitdiff
path: root/lib/render
diff options
context:
space:
mode:
Diffstat (limited to 'lib/render')
-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
4 files changed, 110 insertions, 0 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