aboutsummaryrefslogtreecommitdiff
path: root/bin/main.ml
diff options
context:
space:
mode:
authorLukasz Kasprzak <lukas@labunix.xyz>2026-08-19 11:48:30 +0200
committerLukasz Kasprzak <lukas@labunix.xyz>2026-08-19 11:48:30 +0200
commit6762ce46af3cb12bc6ae37cda762c5d95add7903 (patch)
treebc1d8c86050d0149ff961a9a4ff838f9c474ac2a /bin/main.ml
parent897c274fd28402159ca6d45eedc1257b1ce98696 (diff)
parent390bc6ac5196a946c473d0dbe7760fa41837c428 (diff)
downloadcolitur-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 'bin/main.ml')
-rw-r--r--bin/main.ml780
1 files changed, 758 insertions, 22 deletions
diff --git a/bin/main.ml b/bin/main.ml
index 231d003..6f64582 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -314,12 +314,15 @@ let load_ef_data ?(user_overlays = []) () =
| Error msg -> Error msg
| Ok commons -> Ok (layer, lectionary, commons)))
-(* The resolved-year walk, shared by [day_report] and [readings_report]: they
- differ only in how each day is printed, and the two-liturgical-year
- indexing below (with its own reasoning about civil-vs-liturgical spans) is
- exactly the part that must not be duplicated and drift. [line] is the only
- difference between the two commands. *)
-let resolved_year_report ~line ~overlays y =
+(* The resolved-year walk, shared by [day_report], [readings_report] and
+ [emit_report] (Task 8): they differ only in what happens to each day, and
+ the two-liturgical-year indexing below (with its own reasoning about
+ civil-vs-liturgical spans) is exactly the part that must not be duplicated
+ and drift. [resolved_year_days] owns that walk and returns the resolved
+ days, in date order, for one civil year; every caller layers its own
+ handling (a line-printer, an accumulator for a whole-year [Template.value])
+ on top rather than repeating the indexing. *)
+let resolved_year_days ~overlays y =
match load_ef_data ~user_overlays:overlays () with
| Error msg ->
Printf.eprintf "colitur: %s\n" msg;
@@ -341,9 +344,10 @@ let resolved_year_report ~line ~overlays y =
let jan1 = match D.make ~year:y ~month:1 ~day:1 with Ok t -> t | Error e -> failwith e in
let dec31 = match D.make ~year:y ~month:12 ~day:31 with Ok t -> t | Error e -> failwith e in
let d = ref jan1 in
+ let acc = ref [] in
while D.compare !d dec31 <= 0 do
(match Hashtbl.find_opt by_rata (D.to_rata !d) with
- | Some day -> line day
+ | Some day -> acc := day :: !acc
| None ->
(* Unreachable for any [y] in 1583..9999: the two indexed
liturgical years jointly cover [year_start (y-1), year_start
@@ -357,11 +361,451 @@ let resolved_year_report ~line ~overlays y =
loudly on stderr rather than as a quietly short year. *)
Printf.eprintf "colitur: internal error: no resolved day for %s\n" (D.to_iso8601 !d));
d := D.add_days !d 1
- done
+ done;
+ List.rev !acc
+
+let resolved_year_report ~line ~overlays y =
+ List.iter line (resolved_year_days ~overlays y)
let day_report ~overlays y = resolved_year_report ~line:day_line ~overlays y
let readings_report ~overlays y = resolved_year_report ~line:readings_line ~overlays y
+(* Task 8: `colitur emit` -- the five template-family emitters built in
+ Tasks 5-7, wired to a year RANGE rather than a single year, because a
+ published feed (ics) or a data export (csv/json/xml) is usually wanted
+ for more than one civil year at a time. Reuses [resolved_year_days]
+ rather than re-walking the two-liturgical-year index: see that
+ function's own comment.
+
+ CSV is the one format that spans years in a single stream deliberately
+ printed as ONE header followed by every year's rows: emitting a fresh
+ header per year would make `wc -l` and `awk 'NR>1'` both wrong on a
+ multi-year run, and nothing about RFC 4180 requires a header per file
+ rather than per stream. json/xml/sexp/ics are printed once per year
+ instead -- concatenating whole JSON objects or VCALENDARs into one
+ stream is what each of those formats itself expects a multi-document
+ feed to look like (SEXP: printed one form per line, matching the
+ sexp-per-day shape [Liturgical_day.t] already uses elsewhere in this
+ file; XML: one document per year, the schema's own root is a single
+ year; ICS: one VCALENDAR per year, valid to concatenate for a
+ subscriber that reads multiple files). *)
+(* [--dtstamp] is the only user string that reaches [emit]/[publish] output
+ unescaped and unvalidated (it becomes an ICS DTSTAMP: property value
+ directly, Colitur_render.Emit_ics.year's own [dtstamp] parameter) --
+ every OTHER interpolated value in this project's output is either
+ escaped (Escape.apply) or engine-computed, never raw user input placed
+ straight into a line-oriented format. RFC 5545 section 3.3.5 defines
+ DATE-TIME's UTC form as exactly 8 digits, "T", 6 digits, "Z"
+ (e.g. "20270101T000000Z"); rejecting anything else is what stops
+ "--dtstamp hello" from silently emitting a malformed "DTSTAMP:hello" AND
+ what stops a value carrying its own CRLF (e.g. "X\r\nBEGIN:VEVENT\r\n...")
+ from being injected verbatim into every VEVENT -- a value shaped exactly
+ like the real form cannot contain either character. *)
+let dtstamp_well_formed s =
+ let is_digit c = c >= '0' && c <= '9' in
+ String.length s = 16
+ && String.for_all is_digit (String.sub s 0 8)
+ && s.[8] = 'T'
+ && String.for_all is_digit (String.sub s 9 6)
+ && s.[15] = 'Z'
+
+let check_dtstamp = function
+ | None -> ()
+ | Some s when dtstamp_well_formed s -> ()
+ | Some s ->
+ Printf.eprintf
+ "colitur: --dtstamp %S is not RFC 5545 UTC form (want 8 digits, 'T', 6 digits, 'Z', e.g. \
+ 20270101T000000Z)\n"
+ s;
+ exit 2
+
+let emit_report ~format ~overlays ~dtstamp ~from_y ~to_y =
+ check_dtstamp dtstamp;
+ if from_y > to_y then begin
+ Printf.eprintf "colitur: --from %d is after --to %d\n" from_y to_y;
+ exit 2
+ end;
+ for y = from_y to to_y do
+ let days = resolved_year_days ~overlays y in
+ let v =
+ Colitur_render.View.of_days ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y days
+ in
+ match format with
+ | "csv" ->
+ (* One header for the whole run, not one per year. *)
+ let body = Colitur_render.Emit_csv.year v in
+ if y = from_y then print_string body
+ else
+ print_string
+ (match String.index_opt body '\n' with
+ | Some i -> String.sub body (i + 1) (String.length body - i - 1)
+ | None -> body)
+ | "json" -> print_string (Colitur_render.Emit_json.year v)
+ | "xml" -> print_string (Colitur_render.Emit_xml.year v)
+ | "ics" -> print_string (Colitur_render.Emit_ics.year ?dtstamp v)
+ | "sexp" ->
+ List.iter
+ (fun d ->
+ print_string
+ (Sexplib.Sexp.to_string_hum
+ (Colitur_kernel.Liturgical_day.sexp_of_t
+ Rite_ef.Vocab_ef.sexp_of_season Rite_ef.Vocab_ef.sexp_of_rank d));
+ print_newline ())
+ days
+ | other ->
+ Printf.eprintf "colitur: unknown format %S (want csv, json, sexp, xml or ics)\n" other;
+ exit 2
+ done
+
+(* Task 9: `colitur table` and `colitur render` -- compute a year and render it
+ through a user-supplied template, in ONE process.
+
+ The design's own sketch was `compute | render` as a Unix pipe, with `render`
+ reading a serialised view back from stdin. That is deliberately NOT built:
+ honouring the pipe would need a JSON *parser*, purely to re-read the view
+ this same process just serialised -- a second hand-rolled component, and a
+ second place for the published contract to drift, for no benefit over
+ calling [View.of_days] directly. So `table --year Y --template F` computes
+ and renders in one process (the command that actually gets used), and
+ `render --template F --year Y` is the identical operation under the name
+ the design used, kept so that documented vocabulary still works. There is
+ no stdin-fed `render`; `colitur emit --format json | jq` still composes for
+ real pipe use, because JSON there is the OUTPUT, never something colitur
+ itself has to parse back in. *)
+
+(* The open is guarded separately from the read: a missing file fails at
+ [open_in_bin] with a plain, path-only message (matching the wording this
+ project already uses for every other "no such file" case), while a file
+ that opens but cannot be READ -- a directory, a device node, anything
+ whose length or content changes between [open] and [read] -- fails inside
+ the [Fun.protect]'d body instead, carrying the raised exception's own text
+ (mirrors {!Colitur_kernel.Layer.load}/{!Colitur_kernel.Overlay.load}'s own
+ catch-all shape, lib/kernel/layer.ml and lib/kernel/overlay.ml). Either
+ way the channel is closed on EVERY path -- success, exception, or an
+ early return -- because [close_in_noerr] runs in [~finally], which
+ [Fun.protect] guarantees runs even when the protected function raises; a
+ bare [close_in] after [really_input_string] only ever ran on the success
+ path, leaking the descriptor on every failure. The whole read is inside
+ the [try], not only [open_in_bin], because [in_channel_length] and
+ [really_input_string] can themselves raise [Sys_error] (a directory opens
+ fine but is not readable as bytes) -- a template is user input, and this
+ project's own rule is that user input must never crash the program. *)
+let read_file path =
+ match open_in_bin path with
+ | exception Sys_error _ -> Error ("cannot read template " ^ path)
+ | ic -> (
+ try
+ Fun.protect
+ ~finally:(fun () -> close_in_noerr ic)
+ (fun () ->
+ let n = in_channel_length ic in
+ let s = really_input_string ic n in
+ Ok s)
+ with exn -> Error (Printf.sprintf "cannot read template %s: %s" path (Printexc.to_string exn)))
+
+let extension path =
+ match String.rindex_opt path '.' with
+ | Some i -> String.sub path i (String.length path - i)
+ | None -> ""
+
+(* An unknown extension with no [--flavour] is an ERROR, never a silent
+ fallback to [Escape.None_]: guessing the flavour wrong produces malformed
+ output (unescaped LaTeX/HTML metacharacters) that looks fine until it does
+ not -- the same "never silently substitute" discipline [data_dir]'s own
+ [COLITUR_DATA_DIR] handling documents above. *)
+let table_report ~template ~flavour_opt ~overlays y =
+ let flavour =
+ match flavour_opt with
+ | Some name -> (
+ match Colitur_render.Escape.of_string name with
+ | Some f -> f
+ | None ->
+ Printf.eprintf "colitur: unknown flavour %S (want latex, groff, html, xml, ics or none)\n"
+ name;
+ exit 2)
+ | None -> (
+ match Colitur_render.Escape.of_extension (extension template) with
+ | Some f -> f
+ | None ->
+ Printf.eprintf
+ "colitur: cannot infer a flavour from %S; pass --flavour latex|groff|html|xml|ics|none\n"
+ (extension template);
+ exit 2)
+ in
+ match read_file template with
+ | Error msg ->
+ Printf.eprintf "colitur: %s\n" msg;
+ exit 2
+ | Ok src -> (
+ let days = resolved_year_days ~overlays y in
+ let v = Colitur_render.View.of_days ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y days in
+ match Colitur_render.Template.render_string ~flavour src v with
+ | Error e ->
+ (* The template is user input; a parse failure is reported with the
+ parser's OWN reason and exits 2, never an uncaught exception. *)
+ Printf.eprintf "colitur: template %s: %s\n" template e;
+ exit 2
+ | Ok out -> print_string out)
+
+(* Task 12: `colitur publish` -- writes the static tree that IS this
+ project's API: a set of files any web server or git repo can serve as-is,
+ computed once, with nothing running at request time.
+
+ Two properties matter more than anything else here:
+
+ DETERMINISTIC -- publishing the same year range twice must produce a
+ byte-identical tree. That is what makes publishing into a git repo safe:
+ `git status` shows only genuine change, and a human reviews a real diff
+ before pushing. Nothing below reads a wall clock; [dtstamp] is threaded
+ through as a plain parameter all the way to
+ {!Colitur_render.Emit_ics.year}, exactly as `emit --format ics` already
+ requires (see that command's own comment above).
+
+ NON-DESTRUCTIVE -- publish writes only files it owns, names every one of
+ them in a manifest ([.colitur-manifest], one relative path per line,
+ itself never subject to pruning), and [--prune] removes only entries
+ THAT MANIFEST lists which this run did not rewrite. A file the caller put
+ in the output directory themselves is never in the manifest, so it is
+ never touched, with or without [--prune] -- asserted in both directions
+ in test/cli.t. *)
+
+let rec mkdir_p path =
+ if path <> "" && path <> "/" && not (Sys.file_exists path) then begin
+ mkdir_p (Filename.dirname path);
+ try Unix.mkdir path 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ()
+ end
+
+let write_file path contents =
+ mkdir_p (Filename.dirname path);
+ let oc = open_out_bin path in
+ output_string oc contents;
+ close_out oc
+
+let manifest_name = ".colitur-manifest"
+
+(* [read_file] rather than a second hand-rolled reader -- see its own
+ comment above for why the whole read, not only the open, is guarded. A
+ missing manifest (the very first publish into a fresh directory) is not
+ an error here: it just means there is nothing yet to prune against. *)
+let read_manifest out =
+ match read_file (Filename.concat out manifest_name) with
+ | Error _ -> []
+ | Ok contents -> String.split_on_char '\n' contents |> List.filter (fun l -> l <> "")
+
+(* Fix round 1 (coordinator review), CRITICAL: a manifest entry is
+ UNTRUSTED input the moment [--prune] reads it back. The manifest is a
+ plain-text file that lives INSIDE the very tree this feature exists to
+ have committed into a git repo -- an ordinary bad merge or a hand-edit is
+ enough to put an arbitrary path in it, no attacker required. Without a
+ check, an entry like "../outside/CANARY.txt" resolves, via
+ [Filename.concat out entry], to a path OUTSIDE [out], and the prune loop
+ below would [Sys.remove] it -- deleting a file [publish] never wrote,
+ breaking the "never deletes a file it does not own" contract outright.
+
+ Two independent checks, deliberately, because either alone is easy to
+ regress later without anyone noticing in review:
+
+ 1. STRUCTURAL ([manifest_entry_is_safe]) -- reject an entry that is
+ absolute, or that has a ".." path component anywhere. Split on '/'
+ and compare COMPONENTS, never a bare substring test: substring-
+ matching ".." would wrongly reject a legitimate name like
+ "foo..bar", which contains the two characters but has no ".."
+ component of its own.
+ 2. CONTAINMENT ([resolves_under]) -- even an entry that passes check 1
+ is not trusted until the path it actually resolves to, symlinks
+ included, is verified to sit under [out]. [Unix.realpath] resolves
+ symlinks as well as "..", so this also catches an entry that a
+ symlink planted inside [out] could use to defeat check 1 alone. A
+ plain string-prefix compare is not enough by itself either:
+ "/tmp/pub1" is a byte-prefix of "/tmp/pub1-evil", a directory that is
+ not nested inside it at all, so [is_under] insists the character
+ right after the prefix is the path separator (or that the paths are
+ identical). *)
+let manifest_entry_is_safe entry =
+ entry <> ""
+ && entry.[0] <> '/'
+ && not (List.mem ".." (String.split_on_char '/' entry))
+
+let is_under ~root path =
+ let root =
+ if String.length root > 1 && root.[String.length root - 1] = '/' then
+ String.sub root 0 (String.length root - 1)
+ else root
+ in
+ String.equal path root
+ || (String.length path > String.length root
+ && String.sub path 0 (String.length root) = root
+ && path.[String.length root] = '/')
+
+(* [Unix.realpath] requires the path to exist, which is fine here: every
+ caller below checks [Sys.file_exists]/[Sys.readdir] first. Any failure
+ (missing path, dangling symlink, permission error) is treated as "not
+ contained" -- refuse to act rather than guess. *)
+let resolves_under out p =
+ match Unix.realpath out with
+ | exception (Unix.Unix_error _ | Sys_error _) -> false
+ | out_real -> (
+ match Unix.realpath p with
+ | exception (Unix.Unix_error _ | Sys_error _) -> false
+ | p_real -> is_under ~root:out_real p_real)
+
+(* [--prune] deletes the FILES a stale manifest entry names, but that alone
+ can leave their parent directories (ef/<year>/<mm>/, then ef/<year>/)
+ empty behind them -- and an empty directory still makes `test -d
+ out/ef/<year>` true, which is exactly the check a caller uses to confirm
+ an old year is gone. Walk upward from each deleted file's own directory,
+ removing it while it is empty, stopping at (never including) [out]
+ itself: [out] is the caller's own directory, never ours to remove, even
+ when it is empty. The same containment discipline as the file deletions
+ above applies here too ([resolves_under]), not only structurally (this
+ function is only ever reached via a [p] the file-deletion path already
+ validated, but re-checking each directory step is the belt to that
+ entry's braces -- see the two-layer reasoning above). *)
+let rec prune_empty_dirs ~out dir =
+ if
+ dir <> out
+ && String.length dir > String.length out
+ && Sys.file_exists dir
+ && resolves_under out dir
+ then
+ match Sys.readdir dir with
+ | [||] ->
+ (try Unix.rmdir dir with Unix.Unix_error _ -> ());
+ prune_empty_dirs ~out (Filename.dirname dir)
+ | _ -> ()
+ | exception Sys_error _ -> ()
+
+(* schema/day-v1.json is resolved the same prefix-relative way [data_dir]
+ above resolves data/ef/*.sexp -- NOT from the process's own cwd, which
+ would break an installed binary invoked from an arbitrary directory. Two
+ candidates, installed then build-tree, the same shape as [data_dir]; a
+ candidate counts only if the file is actually there. No COLITUR_DATA_DIR
+ override here: that variable's whole contract is about the directory
+ holding sanctoral.sexp, and schema/ is not nested inside it.
+
+ The installed candidate assumes schema/ lands at
+ <prefix>/share/colitur/schema/day-v1.json, mirroring data/dune's own ef/
+ layout. Adding that install rule is explicitly Task 13's job, not this
+ one -- this function only has to be ready to find the file once the rule
+ exists, which is why it is PROBED rather than assumed, exactly like
+ [data_dir]'s own installed candidate. *)
+let schema_path () =
+ let prefix = Filename.dirname (Filename.dirname Sys.executable_name) in
+ let installed =
+ List.fold_left Filename.concat prefix [ "share"; "colitur"; "schema"; "day-v1.json" ]
+ in
+ let build_tree = List.fold_left Filename.concat prefix [ "schema"; "day-v1.json" ] in
+ if Sys.file_exists installed then Some installed else if Sys.file_exists build_tree then Some build_tree else None
+
+(* An ordinary OCaml string, NOT a template: it describes the TREE, not the
+ calendar, so it has no business in the template vocabulary. *)
+let index_html ~from_y ~to_y =
+ let b = Buffer.create 4096 in
+ Buffer.add_string b
+ "<!doctype html>\n<html lang=\"en\"><head><meta charset=\"utf-8\">\n\
+ <title>colitur</title>\n\
+ <style>body{font-family:sans-serif;max-width:40em;margin:2em auto;line-height:1.5}\n\
+ code{background:#f4f4f4;padding:.1em .3em}</style></head><body>\n\
+ <h1>colitur</h1>\n\
+ <p>Liturgical calendar of the 1962 Missale Romanum. Citations only \xe2\x80\x94 never scripture text.</p>\n";
+ Buffer.add_string b "<h2>Subscribe</h2>\n<ul>\n";
+ for y = from_y to to_y do
+ Buffer.add_string b (Printf.sprintf "<li><a href=\"ef/%d.ics\">ef/%d.ics</a></li>\n" y y)
+ done;
+ Buffer.add_string b "</ul>\n<h2>Data</h2>\n<ul>\n";
+ for y = from_y to to_y do
+ Buffer.add_string b
+ (Printf.sprintf
+ "<li>%d: <a href=\"ef/%d.json\">json</a> <a href=\"ef/%d.csv\">csv</a> \
+ <a href=\"ef/%d.xml\">xml</a> \xe2\x80\x94 per-day at <code>ef/%d/MM/DD.json</code></li>\n"
+ y y y y y)
+ done;
+ Buffer.add_string b
+ "</ul>\n<p>Contract: <a href=\"schema/day-v1.json\">schema/day-v1.json</a></p>\n\
+ </body></html>\n";
+ Buffer.contents b
+
+let publish_report ~from_y ~to_y ~out ~overlays ~dtstamp ~prune =
+ check_dtstamp dtstamp;
+ if from_y > to_y then begin
+ Printf.eprintf "colitur: --from %d is after --to %d\n" from_y to_y;
+ exit 2
+ end;
+ (* Resolved and read BEFORE any file is written, so a missing/unreadable
+ schema fails fast, before the output directory has anything half-
+ written in it. [read_file]'s own error text says "cannot read
+ template ..." (it was built for Task 9's template reads) -- accurate
+ about the mechanism, wrong about the noun, so the message here is
+ rebuilt rather than printed verbatim. *)
+ let schema =
+ match schema_path () with
+ | None ->
+ Printf.eprintf
+ "colitur: cannot find schema/day-v1.json (looked in the installed and build-tree locations)\n";
+ exit 2
+ | Some p -> (
+ match read_file p with
+ | Error _ ->
+ Printf.eprintf "colitur: cannot read schema %s\n" p;
+ exit 2
+ | Ok s -> s)
+ in
+ let written = ref [] in
+ let emit rel contents =
+ write_file (Filename.concat out rel) contents;
+ written := rel :: !written
+ in
+ for y = from_y to to_y do
+ let days = resolved_year_days ~overlays y in
+ let v = Colitur_render.View.of_days ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y days in
+ let ys = string_of_int y in
+ emit ("ef/" ^ ys ^ ".json") (Colitur_render.Emit_json.year v);
+ emit ("ef/" ^ ys ^ ".csv") (Colitur_render.Emit_csv.year v);
+ emit ("ef/" ^ ys ^ ".xml") (Colitur_render.Emit_xml.year v);
+ emit ("ef/" ^ ys ^ ".ics") (Colitur_render.Emit_ics.year ?dtstamp v);
+ (* One file per day: the static equivalent of a per-day endpoint.
+ [View.of_days] with a one-day list yields 12 months, 11 empty, one
+ populated -- exactly the shape a single day's own page needs. *)
+ List.iter
+ (fun d ->
+ let iso = D.to_iso8601 d.Colitur_kernel.Liturgical_day.date in
+ let mm = String.sub iso 5 2 and dd = String.sub iso 8 2 in
+ let one = Colitur_render.View.of_days ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y [ d ] in
+ emit (Printf.sprintf "ef/%s/%s/%s.json" ys mm dd) (Colitur_render.Emit_json.year one))
+ days
+ done;
+ emit "schema/day-v1.json" schema;
+ emit "index.html" (index_html ~from_y ~to_y);
+ let now = List.sort compare !written in
+ (* Every stale entry is validated TWICE before anything is removed --
+ see [manifest_entry_is_safe]/[resolves_under]'s own comment above for
+ why both layers exist. A rejected entry is skipped and warned about on
+ stderr, never fatal: a corrupt or hand-mangled manifest must not make
+ `publish` itself unusable -- it completes, having refused to act on
+ the bad line. *)
+ if prune then
+ List.iter
+ (fun old ->
+ if not (List.mem old now) then
+ if not (manifest_entry_is_safe old) then
+ Printf.eprintf
+ "colitur: refusing to prune manifest entry %S (absolute path or .. component)
+" old
+ else begin
+ let p = Filename.concat out old in
+ if Sys.file_exists p then
+ if resolves_under out p then begin
+ Sys.remove p;
+ prune_empty_dirs ~out (Filename.dirname p)
+ end
+ else
+ Printf.eprintf "colitur: refusing to prune %s (resolves outside %s)
+" p out
+ end)
+ (read_manifest out);
+ write_file (Filename.concat out manifest_name) (String.concat "\n" now ^ "\n");
+ Printf.printf "colitur: wrote %d files to %s\n" (List.length now) out
+
(* Help and usage are deliberately DIFFERENT things, and the difference is the
Unix convention rather than a preference: asking for help is a request that
SUCCEEDED, so [--help] prints to stdout and exits 0 (it can be piped into a
@@ -388,6 +832,19 @@ usage:
colitur day <year> the resolved day identity, one line per day
colitur readings <year> the Mass reading citations, one line per day
colitur day|readings <year> --overlay FILE [--overlay FILE ...]
+ colitur emit --format csv|json|sexp|xml|ics --from Y --to Y
+ [--overlay FILE ...] [--dtstamp S]
+ render a resolved year range through one of five emitters
+ colitur table --year Y --template FILE [--flavour X] [--overlay FILE ...]
+ colitur render --template FILE --year Y [--flavour X] [--overlay FILE ...]
+ compute year Y and render it through FILE, a logic-less
+ Mustache-family template; table and render are the same
+ operation, two names (see "rendering" below)
+ colitur publish --from Y --to Y --out DIR [--overlay FILE ...] [--prune]
+ [--dtstamp S]
+ write the static tree: per-year csv/json/xml/ics, one JSON
+ file per day, the schema and a generated index (see
+ "publish" below)
colitur new-overlay print a starter overlay file to stdout
colitur convert FILE.ini flat INI overlay -> S-expression, on stdout
colitur check FILE ... load an overlay, say what it does, exit 2 if not
@@ -407,14 +864,21 @@ output formats:
day stays space-separated; that is why they are separate commands rather
than extra columns.
+ emit one schema (season, week, slug, rank, colour, subject, names,
+ citations, commemorations), rendered five ways: csv (RFC 4180,
+ one header for the whole run), json, sexp, xml (schema/colitur-
+ v1.xsd) and ics (RFC 5545). --from/--to give a civil-year range,
+ inclusive. --dtstamp fixes the ics DTSTAMP so two runs over the
+ same data are byte-identical -- the engine reads no clock.
+
overlays:
--overlay FILE (repeatable, ordered; -o) applies a user calendar ON TOP of
the shipped universal one, never instead of it, so local feasts
add to it rather than replacing it. Later files win over earlier
ones, and over the universal calendar, when they name the same
- slug. Accepted on `day` and `readings` only -- the other commands
- read no sanctoral data, so the flag is refused there rather than
- silently ignored.
+ slug. Accepted on `day`, `readings`, `emit`, `table`, `render` and
+ `publish` -- `easter` and `temporal` read no sanctoral data, so
+ the flag is refused there rather than silently ignored.
An overlay is applied, NOT validated: colitur's test layers assert
things about the shipped calendar and cannot vouch for a file you
@@ -443,6 +907,84 @@ overlays:
(Nth_weekday (month M) (nth N) (weekday W)) with N negative to
count from the end of the month.
+rendering:
+ --template FILE (required on `table`/`render`) is a logic-less Mustache-
+ family template: {{placeholder}}, {{#section}}...{{/section}},
+ {{^inverted}}...{{/inverted}}, {{!comment}} -- nothing else. It is
+ DATA, never a program: no partials, no lambdas, no expression
+ evaluation, no filesystem or process access, and no "raw" or
+ triple-brace form that could opt out of escaping. The value it
+ renders against is the same schema `emit` uses (season, week,
+ slug, rank, colour, subject, names, citations, commemorations),
+ reshaped into a booklet (`days`) and a month grid (`weeks`, with
+ padding cells for the leading/trailing blanks); see
+ colitur-templates(5) for the full field list, the syntax and the
+ scope-shadowing hazard (an inner key silently loses to an outer
+ key of the same name -- a bare {{name.la}} inside a day resolves
+ to the enclosing MONTH's name, not the day's own).
+
+ --flavour X selects how interpolated VALUES are escaped (never the
+ template's own literal markup, which is the author's). One of:
+
+ latex groff html xml ics none
+
+ Inferred from --template's extension when --flavour is omitted:
+
+ .tex -> latex
+ .ms .mom .me -> groff
+ .html .htm -> html
+ .xml -> xml
+ .ics -> ics
+ .md .adoc .txt -> none (no metacharacters are escaped;
+ Markdown/AsciiDoc/plain text have no fixed
+ metacharacter set, so escaping them here
+ would produce worse output than leaving
+ them alone)
+
+ An extension colitur does not recognise is a hard ERROR naming
+ the six flavours above, never a silent fallback to `none`:
+ guessing wrong produces output that looks fine until the
+ metacharacters it silently failed to escape show up.
+
+ `table` and `render` are the SAME operation under two names. The design
+ this project followed originally sketched `compute | render` as a
+ Unix pipe, with `render` reading a serialised view back from
+ stdin. That is deliberately not built: honouring the pipe would
+ need a JSON *parser*, purely so this program could re-read a view
+ it had just serialised itself -- a second hand-rolled component,
+ and a second place for the published contract to drift, for no
+ benefit over calling the view builder directly in the same
+ process. There is therefore no stdin-fed `render`; `colitur emit
+ --format json | jq` still composes for real pipe use, because
+ that JSON is the OUTPUT, never something colitur itself parses
+ back in.
+
+publish:
+ --out DIR (required) writes the static tree that IS this program's API:
+ any web server or git repo can serve it as-is, and nothing runs
+ at request time.
+
+ ef/<year>.{json,csv,xml,ics} one civil year, all days
+ ef/<year>/<mm>/<dd>.json one file per day
+ schema/day-v1.json the published JSON contract
+ index.html a generated index page
+ .colitur-manifest every path this run wrote
+
+ Deterministic: publishing the same --from/--to range twice
+ produces a byte-identical tree (--dtstamp behaves exactly as on
+ `emit`). That is what makes publishing into a git repo safe --
+ `git status` shows only real change, and you review an actual
+ diff before pushing.
+
+ Non-destructive: publish writes only files it owns, and records
+ every one in .colitur-manifest. A file you put in the output
+ directory yourself is never in that manifest, so it is never
+ touched, whether or not --prune is given. --prune additionally
+ removes manifest entries from a PREVIOUS run that this run did
+ not rewrite (e.g. an earlier year's per-day files, when you
+ publish a different range into the same directory) -- never
+ anything the manifest does not name.
+
environment:
COLITUR_DATA_DIR
Read the calendar data from this directory instead of the
@@ -456,7 +998,10 @@ exit status:
Reading references only (e.g. "Jn 3:16"); never scripture text.
See colitur(1) for the full description and the sources it computes against,
-and colitur-overlay(5) for the overlay file format in full.|}
+colitur-overlay(5) for the overlay file format in full, and
+colitur-templates(5) for the template format in full -- the syntax, the
+scope-shadowing hazard, the six flavours' escaping, and the full view-model
+field reference.|}
let print_help () =
print_endline help_text;
@@ -465,7 +1010,9 @@ let print_help () =
let usage () =
prerr_endline
"colitur: usage: colitur easter <year> | colitur temporal <year> | colitur day <year> | colitur \
- readings <year> | colitur check FILE | colitur new-overlay (try: colitur --help)";
+ readings <year> | colitur emit --format FMT --from Y --to Y | colitur table --year Y --template \
+ FILE | colitur render --template FILE --year Y | colitur publish --from Y --to Y --out DIR | \
+ colitur check FILE | colitur new-overlay (try: colitur --help)";
exit 2
let with_year ys f =
@@ -485,12 +1032,55 @@ let with_year ys f =
[--overlay] accumulates in the order given, and that order is load-bearing
({!Overlay.merge} is last-writer-wins), so the list is reversed exactly
- once at the end rather than callers guessing. *)
+ once at the end rather than callers guessing.
+
+ [--format]/[--from]/[--to]/[--dtstamp] (Task 8, `emit`) are each single-
+ valued, unlike [--overlay], so they are plain [string option] fields
+ rather than accumulating lists. *)
+(* [year]/[template]/[flavour] (Task 9, `table`/`render`) are each single-
+ valued, the same shape as [format]/[from_y]/[to_y]/[dtstamp] above --
+ `table`/`render` take one year and one template file, never a range or a
+ repeatable list. *)
+(* [out] (Task 12, `publish`) is single-valued like [format]/[year]/etc.
+ [prune] is the one plain boolean flag in this whole record -- every other
+ field here takes a value, but [--prune] does not, so it cannot reuse the
+ `"--flag" :: v :: rest` shape the value-taking flags share below. *)
+type parsed_args = {
+ overlays : string list;
+ format : string option;
+ from_y : string option;
+ to_y : string option;
+ dtstamp : string option;
+ year : string option;
+ template : string option;
+ flavour : string option;
+ out : string option;
+ prune : bool;
+ positional : string list;
+}
+
let parse_args argv =
- let rec go overlays positional = function
- | [] -> Ok (List.rev overlays, List.rev positional)
- | ("--overlay" | "-o") :: path :: rest -> go (path :: overlays) positional rest
+ let rec go acc = function
+ | [] -> Ok { acc with overlays = List.rev acc.overlays; positional = List.rev acc.positional }
+ | ("--overlay" | "-o") :: path :: rest -> go { acc with overlays = path :: acc.overlays } rest
| [ ("--overlay" | "-o") ] -> Error "--overlay needs a file path"
+ | "--format" :: v :: rest -> go { acc with format = Some v } rest
+ | [ "--format" ] -> Error "--format needs a value"
+ | "--from" :: v :: rest -> go { acc with from_y = Some v } rest
+ | [ "--from" ] -> Error "--from needs a value"
+ | "--to" :: v :: rest -> go { acc with to_y = Some v } rest
+ | [ "--to" ] -> Error "--to needs a value"
+ | "--dtstamp" :: v :: rest -> go { acc with dtstamp = Some v } rest
+ | [ "--dtstamp" ] -> Error "--dtstamp needs a value"
+ | "--year" :: v :: rest -> go { acc with year = Some v } rest
+ | [ "--year" ] -> Error "--year needs a value"
+ | "--template" :: v :: rest -> go { acc with template = Some v } rest
+ | [ "--template" ] -> Error "--template needs a value"
+ | "--flavour" :: v :: rest -> go { acc with flavour = Some v } rest
+ | [ "--flavour" ] -> Error "--flavour needs a value"
+ | "--out" :: v :: rest -> go { acc with out = Some v } rest
+ | [ "--out" ] -> Error "--out needs a directory path"
+ | "--prune" :: rest -> go { acc with prune = true } rest
(* The recognised bare flags pass through as positional words for the
dispatch below to match; anything else beginning with '-' is rejected
rather than silently treated as a command or a year. *)
@@ -499,9 +1089,24 @@ let parse_args argv =
&& arg.[0] = '-'
&& not (List.mem arg [ "-h"; "--help"; "-V"; "--version" ]) ->
Error (Printf.sprintf "unknown option %s" arg)
- | arg :: rest -> go overlays (arg :: positional) rest
+ | arg :: rest -> go { acc with positional = arg :: acc.positional } rest
in
- go [] [] argv
+ go
+ { overlays = []; format = None; from_y = None; to_y = None; dtstamp = None; year = None;
+ template = None; flavour = None; out = None; prune = false; positional = [] }
+ argv
+
+(* Sibling to [reject_overlays_for]: `emit`'s own four flags have no meaning
+ on any other command (they take a single [<year>] positional, not a
+ [--from]/[--to] range), so accepting and silently dropping them would be
+ the same failure mode `--overlay` already refuses on `easter`/`temporal`. *)
+let reject_emit_flags_for cmd ~format ~from_y ~to_y ~dtstamp =
+ if format <> None || from_y <> None || to_y <> None || dtstamp <> None then begin
+ Printf.eprintf
+ "colitur: --format/--from/--to/--dtstamp have no effect on `%s`; refusing rather than ignoring them\n"
+ cmd;
+ exit 2
+ end
(* [easter] reads no calendar data at all, and [temporal] deliberately runs the
temporal cycle BEFORE any sanctoral layer exists, so an overlay could not
@@ -513,6 +1118,39 @@ let reject_overlays_for cmd overlays =
exit 2
end
+(* Sibling to [reject_emit_flags_for]/[reject_overlays_for]: `table`/`render`'s
+ own three flags (Task 9) have no meaning on any other command, so accepting
+ and silently dropping them would be the same failure mode this project
+ already refuses everywhere else. *)
+let reject_table_flags_for cmd ~year ~template ~flavour =
+ if year <> None || template <> None || flavour <> None then begin
+ Printf.eprintf
+ "colitur: --year/--template/--flavour have no effect on `%s`; refusing rather than ignoring them\n"
+ cmd;
+ exit 2
+ end
+
+(* Sibling to [reject_emit_flags_for]/[reject_table_flags_for]: `--format`
+ has no meaning on `publish` (it always writes all four whole-year
+ formats plus the per-day JSON tree, never a single chosen one), so
+ accepting and silently dropping it would be the same failure mode this
+ project already refuses everywhere else. Narrower than
+ [reject_emit_flags_for] on purpose -- `publish` legitimately takes
+ --from/--to/--dtstamp, so that blanket check cannot be reused here. *)
+let reject_format_for cmd format =
+ if format <> None then begin
+ Printf.eprintf "colitur: --format has no effect on `%s`; refusing rather than ignoring it\n" cmd;
+ exit 2
+ end
+
+(* Sibling to the three rejectors above: `--out`/`--prune` (Task 12) have no
+ meaning on any command except `publish`. *)
+let reject_publish_flags_for cmd ~out ~prune =
+ if out <> None || prune then begin
+ Printf.eprintf "colitur: --out/--prune have no effect on `%s`; refusing rather than ignoring them\n" cmd;
+ exit 2
+ end
+
(* `colitur check FILE...` -- load a user overlay, apply it to the real
shipped calendar, and say what it did, without printing a year of output.
@@ -677,31 +1315,129 @@ let () =
| Error msg ->
Printf.eprintf "colitur: %s\n" msg;
usage ()
- | Ok (overlays, positional) -> (
+ | Ok { overlays; format; from_y; to_y; dtstamp; year; template; flavour; out; prune; positional } -> (
+ let reject_emit = reject_emit_flags_for ~format ~from_y ~to_y ~dtstamp in
+ let reject_table = reject_table_flags_for ~year ~template ~flavour in
+ let reject_publish = reject_publish_flags_for ~out ~prune in
match positional with
| [ ("-h" | "--help" | "help") ] ->
reject_overlays_for "--help" overlays;
+ reject_emit "--help";
+ reject_table "--help";
+ reject_publish "--help";
print_help ()
| [ ("-V" | "--version" | "version") ] ->
reject_overlays_for "--version" overlays;
+ reject_emit "--version";
+ reject_table "--version";
+ reject_publish "--version";
print_endline version;
exit 0
| [ "easter"; ys ] ->
reject_overlays_for "easter" overlays;
+ reject_emit "easter";
+ reject_table "easter";
+ reject_publish "easter";
with_year ys easter_report
| [ "temporal"; ys ] ->
reject_overlays_for "temporal" overlays;
+ reject_emit "temporal";
+ reject_table "temporal";
+ reject_publish "temporal";
with_year ys temporal_report
| "check" :: (_ :: _ as files) ->
reject_overlays_for "check" overlays;
+ reject_emit "check";
+ reject_table "check";
+ reject_publish "check";
check_report files
| [ "convert"; path ] ->
reject_overlays_for "convert" overlays;
+ reject_emit "convert";
+ reject_table "convert";
+ reject_publish "convert";
convert_report path
| [ "new-overlay" ] ->
reject_overlays_for "new-overlay" overlays;
+ reject_emit "new-overlay";
+ reject_table "new-overlay";
+ reject_publish "new-overlay";
print_string new_overlay_template;
exit 0
- | [ "day"; ys ] -> with_year ys (day_report ~overlays)
- | [ "readings"; ys ] -> with_year ys (readings_report ~overlays)
+ | [ "day"; ys ] ->
+ reject_emit "day";
+ reject_table "day";
+ reject_publish "day";
+ with_year ys (day_report ~overlays)
+ | [ "readings"; ys ] ->
+ reject_emit "readings";
+ reject_table "readings";
+ reject_publish "readings";
+ with_year ys (readings_report ~overlays)
+ | [ "emit" ] -> (
+ reject_table "emit";
+ reject_publish "emit";
+ match format with
+ | None ->
+ Printf.eprintf "colitur: emit requires --format csv|json|sexp|xml|ics\n";
+ exit 2
+ | Some format -> (
+ match (from_y, to_y) with
+ | None, _ | _, None ->
+ Printf.eprintf "colitur: emit requires --from YEAR and --to YEAR\n";
+ exit 2
+ | Some from_ys, Some to_ys ->
+ with_year from_ys (fun from_y ->
+ with_year to_ys (fun to_y -> emit_report ~format ~overlays ~dtstamp ~from_y ~to_y))))
+ | [ ("table" | "render") as cmd ] -> (
+ reject_emit cmd;
+ reject_publish cmd;
+ match template with
+ | None ->
+ Printf.eprintf "colitur: %s requires --year YEAR and --template FILE\n" cmd;
+ exit 2
+ | Some template -> (
+ match year with
+ | None ->
+ Printf.eprintf "colitur: %s requires --year YEAR and --template FILE\n" cmd;
+ exit 2
+ | Some ys -> with_year ys (fun y -> table_report ~template ~flavour_opt:flavour ~overlays y)
+ ))
+ | [ "publish" ] -> (
+ reject_table "publish";
+ reject_format_for "publish" format;
+ match out with
+ | None ->
+ Printf.eprintf "colitur: publish requires --out DIR\n";
+ exit 2
+ | Some out -> (
+ match (from_y, to_y) with
+ | None, _ | _, None ->
+ Printf.eprintf "colitur: publish requires --from YEAR and --to YEAR\n";
+ exit 2
+ | Some from_ys, Some to_ys ->
+ with_year from_ys (fun from_y ->
+ with_year to_ys (fun to_y ->
+ (* [publish_report] writes many files across a whole
+ year range ([mkdir_p]/[write_file], both above) --
+ an unwritable [--out] parent (EACCES) or an [--out]
+ that names an existing plain file (ENOTDIR) raises
+ from deep inside that loop, same defect class as
+ the template read this project already guards
+ (commit 6bd741b): "--out" is user input too, and
+ the WHOLE call is guarded here rather than each
+ [write_file] site individually, for the same
+ reason that fix guarded the whole read and not
+ only the open. [Unix.mkdir] raises
+ [Unix.Unix_error] directly; [open_out_bin]
+ (stdlib, not the Unix module) wraps the same
+ underlying errno in [Sys_error] instead -- both
+ are real on this path, so both are caught. *)
+ try publish_report ~from_y ~to_y ~out ~overlays ~dtstamp ~prune with
+ | Unix.Unix_error (e, fn, arg) ->
+ Printf.eprintf "colitur: %s: %s: %s\n" fn arg (Unix.error_message e);
+ exit 2
+ | Sys_error e ->
+ Printf.eprintf "colitur: %s\n" e;
+ exit 2))))
| _ -> usage ())