diff options
| author | Lukasz Kasprzak <lukas@labunix.xyz> | 2026-08-19 09:19:14 +0200 |
|---|---|---|
| committer | Lukasz Kasprzak <lukas@labunix.xyz> | 2026-08-19 09:19:14 +0200 |
| commit | decb13fb17697f6d6d952c407f2173a714164804 (patch) | |
| tree | 7c77e73aac02372df4e26b549029379f0b2a0756 /bin/main.ml | |
| parent | 6abc243e5d40bd60174a3fb1affc9517b0ac5617 (diff) | |
| download | colitur-decb13fb17697f6d6d952c407f2173a714164804.tar.gz colitur-decb13fb17697f6d6d952c407f2173a714164804.zip | |
feat(cli): colitur emit -- csv, json, sexp, xml, ics
Reuses resolved_year_report's existing two-liturgical-year indexing
rather than copying it: that walk owns the civil-vs-liturgical span
reasoning, and a second copy would drift. It is refactored to return the
days, with the printer layered on top, so day and readings behave
identically -- which cli.t proves byte-for-byte.
CSV emits one header for a whole multi-year run, not one per year.
A reversed range is a usage error rather than silently empty output.
Asserted in cli.t: two ics runs are byte-identical, because nothing in
the path reads a clock.
Diffstat (limited to 'bin/main.ml')
| -rw-r--r-- | bin/main.ml | 166 |
1 files changed, 149 insertions, 17 deletions
diff --git a/bin/main.ml b/bin/main.ml index 231d003..ec7fd71 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,71 @@ 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). *) +let emit_report ~format ~overlays ~dtstamp ~from_y ~to_y = + 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 + (* 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 +452,9 @@ 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 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,6 +474,13 @@ 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 @@ -485,12 +559,33 @@ 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. *) +type parsed_args = { + overlays : string list; + format : string option; + from_y : string option; + to_y : string option; + dtstamp : string option; + 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" (* 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 +594,21 @@ 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; 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 @@ -677,31 +784,56 @@ let () = | Error msg -> Printf.eprintf "colitur: %s\n" msg; usage () - | Ok (overlays, positional) -> ( + | Ok { overlays; format; from_y; to_y; dtstamp; positional } -> ( + let reject_emit = reject_emit_flags_for ~format ~from_y ~to_y ~dtstamp in match positional with | [ ("-h" | "--help" | "help") ] -> reject_overlays_for "--help" overlays; + reject_emit "--help"; print_help () | [ ("-V" | "--version" | "version") ] -> reject_overlays_for "--version" overlays; + reject_emit "--version"; print_endline version; exit 0 | [ "easter"; ys ] -> reject_overlays_for "easter" overlays; + reject_emit "easter"; with_year ys easter_report | [ "temporal"; ys ] -> reject_overlays_for "temporal" overlays; + reject_emit "temporal"; with_year ys temporal_report | "check" :: (_ :: _ as files) -> reject_overlays_for "check" overlays; + reject_emit "check"; check_report files | [ "convert"; path ] -> reject_overlays_for "convert" overlays; + reject_emit "convert"; convert_report path | [ "new-overlay" ] -> reject_overlays_for "new-overlay" overlays; + reject_emit "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"; + with_year ys (day_report ~overlays) + | [ "readings"; ys ] -> + reject_emit "readings"; + with_year ys (readings_report ~overlays) + | [ "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)))) | _ -> usage ()) |
