aboutsummaryrefslogtreecommitdiff
path: root/bin
diff options
context:
space:
mode:
authorLukasz Kasprzak <lukas@labunix.xyz>2026-08-19 10:18:24 +0200
committerLukasz Kasprzak <lukas@labunix.xyz>2026-08-19 10:18:24 +0200
commit2760d43d695ba08fc33f65357590675707b6570d (patch)
tree8c139100c5babd6fce6c7af6d55b7f4938a86efd /bin
parent24de019a3e1d5b9a6d4601bdd65489813baa7e58 (diff)
downloadcolitur-2760d43d695ba08fc33f65357590675707b6570d.tar.gz
colitur-2760d43d695ba08fc33f65357590675707b6570d.zip
feat(cli): colitur publish -- the static tree
Writes ef/<year>.{json,csv,xml,ics}, one JSON per day, the schema and a generated index. That tree is the API: any web server or git repo serves it, and nothing runs at request time. Deterministic: publishing twice is byte-identical, asserted in cli.t. That is what makes publishing into a git repo safe -- the diff shows only real change, and you review it before pushing. Non-destructive: a manifest records exactly the files this tool wrote, so --prune can only remove files a previous run created. A file you put in the output directory yourself is never touched, with or without --prune. Asserted in both directions. Pruning a stale file also removes any directory it leaves empty behind it (e.g. an old year's own ef/<year>/ tree), stopping at --out itself -- without this, a pruned year's own directory would survive empty and test -d would still see it. schema/day-v1.json is resolved the same prefix-relative way data/ef's own sexp files are (installed vs build-tree, probed rather than assumed), never from cwd, and a missing schema fails with one line on stderr before anything is written rather than emitting an empty file. Needed schema/day-v1.json wired into the root dune file's default alias and into test/dune's cram deps -- unlike data/ and templates/, nothing made dune mirror schema/ into the build tree before this. unix is added to bin/dune's libraries for mkdir_p; it ships with the compiler, so colitur.opam and dune-project are unchanged.
Diffstat (limited to 'bin')
-rw-r--r--bin/dune6
-rw-r--r--bin/main.ml269
2 files changed, 272 insertions, 3 deletions
diff --git a/bin/dune b/bin/dune
index 376fe70..856dafe 100644
--- a/bin/dune
+++ b/bin/dune
@@ -2,4 +2,8 @@
(name main)
(public_name colitur)
(package colitur)
- (libraries colitur_kernel rite_ef colitur_render))
+ ; [unix] ships with the OCaml compiler -- it is not a new entry in
+ ; colitur.opam's frozen depends, only a new library this executable links
+ ; against. Used by Task 12's [mkdir_p] (colitur publish, recursive
+ ; directory creation) and nowhere else.
+ (libraries colitur_kernel rite_ef colitur_render unix))
diff --git a/bin/main.ml b/bin/main.ml
index e916cbe..1669a47 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -516,6 +516,183 @@ let table_report ~template ~flavour_opt ~overlays y =
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 <> "")
+
+(* [--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. *)
+let rec prune_empty_dirs ~out dir =
+ if dir <> out && String.length dir > String.length out && Sys.file_exists 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 =
+ 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
+ if prune then
+ List.iter
+ (fun old ->
+ if not (List.mem old now) then begin
+ let p = Filename.concat out old in
+ if Sys.file_exists p then begin
+ Sys.remove p;
+ prune_empty_dirs ~out (Filename.dirname p)
+ end
+ 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
@@ -550,6 +727,11 @@ usage:
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
@@ -661,6 +843,32 @@ rendering:
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
@@ -712,6 +920,10 @@ let with_year ys f =
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;
@@ -721,6 +933,8 @@ type parsed_args = {
year : string option;
template : string option;
flavour : string option;
+ out : string option;
+ prune : bool;
positional : string list;
}
@@ -743,6 +957,9 @@ let parse_args argv =
| [ "--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. *)
@@ -755,7 +972,7 @@ let parse_args argv =
in
go
{ overlays = []; format = None; from_y = None; to_y = None; dtstamp = None; year = None;
- template = None; flavour = None; positional = [] }
+ template = None; flavour = None; out = None; prune = false; positional = [] }
argv
(* Sibling to [reject_overlays_for]: `emit`'s own four flags have no meaning
@@ -792,6 +1009,27 @@ let reject_table_flags_for cmd ~year ~template ~flavour =
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.
@@ -956,57 +1194,68 @@ let () =
| Error msg ->
Printf.eprintf "colitur: %s\n" msg;
usage ()
- | Ok { overlays; format; from_y; to_y; dtstamp; year; template; flavour; 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 ] ->
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";
@@ -1021,6 +1270,7 @@ let () =
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;
@@ -1032,4 +1282,19 @@ let () =
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 ~from_y ~to_y ~out ~overlays ~dtstamp ~prune))))
| _ -> usage ())