path: root/bin/main.ml

module D = Colitur_kernel.Date
module C = Colitur_kernel.Computus

let fmt d = Printf.sprintf "%04d-%02d-%02d" (D.year d) (D.month d) (D.day d)

let easter_report y =
  [ ("easter", C.gregorian_easter y);
    ("ash-wednesday", C.ash_wednesday y);
    ("palm-sunday", C.palm_sunday y);
    ("ascension", C.ascension y);
    ("pentecost", C.pentecost y);
    ("corpus-christi", C.corpus_christi y) ]
  |> List.iter (fun (name, d) -> Printf.printf "%s %s\n" name (fmt d))

let temporal_report 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
  (* [week] is "" for roughly 30 days a year (outside any numbered week);
     printed as-is, that collapses two of the seven space-separated fields
     into a double space, so naive field-position parsing (e.g. awk '{print
     $4}') silently reads the wrong column on those days. Emit "-" instead,
     so every line always has exactly seven single-space-separated fields. *)
  let field s = if s = "" then "-" else s in
  let d = ref jan1 in
  while D.compare !d dec31 <= 0 do
    let t = Rite_ef.Temporal_ef.temporal !d in
    let r =
      Colitur_kernel.Record.of_temporal ~rite:Rite_ef.Temporal_ef.id
        Rite_ef.Vocab_ef.vocab !d t
    in
    Printf.printf "%s %s %s %s %s %s %s\n" r.Colitur_kernel.Record.date
      r.Colitur_kernel.Record.weekday r.Colitur_kernel.Record.season
      (field r.Colitur_kernel.Record.week) r.Colitur_kernel.Record.slug
      r.Colitur_kernel.Record.rank r.Colitur_kernel.Record.colour;
    d := D.add_days !d 1
  done

(* Task 11: the fully resolved EF calendar (temporal AND sanctoral,
   occurrence and transfers applied), one line per civil-year day --
   "YYYY-MM-DD weekday season week slug rank colour [+commemoration-slug]...".
   [temporal_report] above only ever showed the temporal cycle in isolation
   ([Rite_ef.Temporal_ef.temporal] directly, no sanctoral layer, no
   [Precedence] contest); this is the first CLI path that runs every piece
   Plan 3 built -- [Colitur_kernel.Layer], [Overlay], [Precedence_ef],
   [Calendar] -- against real data. *)

(* [data/ef/sanctoral.sexp] and [data/ef/adjustments.sexp] are located
   relative to the BUILD TREE, not the process's own cwd: cwd varies with
   how the binary is invoked (a user's shell for `dune exec colitur --`, a
   dune cram test's own sandboxed temp directory for `test/cli.t`) and
   nothing in this project's build pins it to the repository root. A
   build-time constant substituted via dune's [%{workspace_root}] was tried
   first and rejected: it is resolved RELATIVE TO THE BUILD ACTION'S OWN
   directory (empirically "." here, not an absolute path -- dune keeps
   build actions relocatable), so it silently reproduces the same
   cwd-dependence this is trying to eliminate, just baked in at build time
   instead of read at run time; confirmed by the resulting `colitur day`
   failing to find its own data outside the exact directory the build
   happened to run in.

   [Sys.executable_name] does not have that problem -- on Linux it resolves
   through /proc/self/exe, which the kernel always reports as the
   executable's own canonical absolute path, even when the process was
   launched through a symlink (verified against dune's own cram sandbox,
   which places exactly such a symlink; see the task report). dune's default
   ("no [(sandbox ...)] declared") build context mirrors the ENTIRE source
   tree under _build/default/, unconditionally, so climbing from
   _build/default/bin/main.exe up two directories and back down into data/
   always finds both files, regardless of the caller's own cwd.

   Known limitation, not yet exercised by this project: a `dune install`-
   style deployment (executable copied to a prefix with no adjacent _build/
   default/data/) would need a different resolution strategy; there is no
   install story yet (README.md: `dune exec` only), so this is not a
   regression against anything this project currently supports. *)
let data_dir () = Filename.dirname (Filename.dirname Sys.executable_name) ^ "/data/ef"

(* Loads the universal sanctoral layer and applies the one hand-authored
   overlay over it (data/ef/adjustments.sexp -- see that file's own header):
   [Overlay.apply]'s diagnostics are never silently dropped (Overlay.mli),
   so any that come back -- expected to be none in the committed data; see
   the overlay file's own comment on when one WOULD fire -- are printed to
   stderr, loudly, without aborting the run. *)
let load_ef_layer () =
  let dir = data_dir () in
  let sanctoral_path = Filename.concat dir "sanctoral.sexp" in
  let adjustments_path = Filename.concat dir "adjustments.sexp" in
  match Colitur_kernel.Layer.load Rite_ef.Vocab_ef.rank_of_sexp sanctoral_path with
  | Error e -> Error (Printf.sprintf "failed to load %s: %s" sanctoral_path e)
  | Ok layer -> (
      match Colitur_kernel.Overlay.load Rite_ef.Vocab_ef.rank_of_sexp adjustments_path with
      | Error e -> Error (Printf.sprintf "failed to load %s: %s" adjustments_path e)
      | Ok overlay ->
          let layer, diagnostics = Colitur_kernel.Overlay.apply layer overlay in
          List.iter
            (fun d -> Printf.eprintf "colitur: %s\n" (Colitur_kernel.Overlay.diagnostic_to_string d))
            diagnostics;
          Ok layer)

(* Sibling to [load_ef_layer] above, same reasoning: [Rite_ef.context] now
   takes [~lectionary] rather than loading data/ef/lectionary.sexp itself
   (fix round 1, coordinator review -- a prior version had [Rite_ef]'s own
   [context] load the file as a side effect of being linked, which killed
   `colitur easter <year>` -- no lectionary data touched at all -- the
   moment that file was missing from a bare `dune build`'s own default
   target). Routed through the same [result] failure path as
   [load_ef_layer], so a missing/malformed file is reported via
   `colitur: %s` and `exit 2`, never an uncaught exception -- restoring the
   promise [Lectionary.load]'s own .mli makes ("failures come back as
   [Error], never as an exception"), which the reverted version broke by
   re-wrapping it in [failwith] at module init where no caller could catch
   it. *)
let load_ef_lectionary () =
  let path = Filename.concat (data_dir ()) "lectionary.sexp" in
  match Colitur_kernel.Lectionary.load path with
  | Error e -> Error (Printf.sprintf "failed to load %s: %s" path e)
  | Ok lectionary -> Ok lectionary

(* Sibling to [load_ef_lectionary] above, same reasoning and the same
   [result] failure path: data/ef/commons.sexp holds the Commons of the
   1962 Missal plus the per-saint assignments that route a readingless
   class-3 feast to one, and [Rite_ef.context] takes it as [~commons]
   rather than reading it itself. Its own loader validates the file
   (duplicate ids, empty formularies, assignments naming a common that does
   not exist) and reports every failure as [Error]. *)
let load_ef_commons () =
  let path = Filename.concat (data_dir ()) "commons.sexp" in
  match Rite_ef.Lectionary_ef.Commons.load path with
  | Error e -> Error (Printf.sprintf "failed to load %s: %s" path e)
  | Ok commons -> Ok commons

let day_line (d : (Rite_ef.Vocab_ef.season, Rite_ef.Vocab_ef.rank) Colitur_kernel.Liturgical_day.t)
    =
  let t = d.Colitur_kernel.Liturgical_day.temporal in
  let cel = d.Colitur_kernel.Liturgical_day.observed in
  let week =
    match t.Colitur_kernel.Temporal.week with Some n -> string_of_int n | None -> "-"
  in
  let commemoration_suffix (c, _) =
    " +" ^ Colitur_kernel.Slug.to_string c.Colitur_kernel.Celebration.slug
  in
  let commemorations =
    String.concat "" (List.map commemoration_suffix d.Colitur_kernel.Liturgical_day.commemorations)
  in
  Printf.printf "%s %s %s %s %s %s %s%s\n" (D.to_iso8601 d.Colitur_kernel.Liturgical_day.date)
    (D.weekday_to_string t.Colitur_kernel.Temporal.weekday)
    (Rite_ef.Vocab_ef.season_to_string t.Colitur_kernel.Temporal.season)
    week
    (Colitur_kernel.Slug.to_string cel.Colitur_kernel.Celebration.slug)
    (Rite_ef.Vocab_ef.rank_to_string cel.Colitur_kernel.Celebration.rank)
    (Colitur_kernel.Colour.to_string cel.Colitur_kernel.Celebration.colour)
    commemorations

(* One civil year, Jan 1 - Dec 31, matching [temporal_report]'s own scan --
   NOT one liturgical year: [Colitur_kernel.Calendar.year] resolves a single
   Advent-anchored liturgical year, which straddles two civil years, so a
   civil year's worth of output needs the tail of the liturgical year that
   opened the PREVIOUS civil year (covers roughly 1 Jan - 28 Nov) plus the
   liturgical year that opens within this one (roughly 29 Nov - 31 Dec).
   Both are computed once each -- not once per day via [Calendar.day], which
   would recompute the whole (~365-day) placement pass up to 365 times over
   for the days sharing one liturgical year (calendar.mli's own "pays it
   once" cost model assumes exactly this usage: call [year], not [day] in a
   loop). *)
(* The three data files this subcommand needs, loaded once and reported
   through ONE failure path. Flattened out of the nested [match] this used
   to be when a third loader (the Commons, Task 6) joined the first two:
   each additional caller-supplied table would otherwise add a level of
   indentation and a third verbatim copy of the same two-line error-and-exit
   block. Every loader already returns [(_, string) result] (never raises,
   never reads at module-initialisation time -- see [load_ef_lectionary]),
   so chaining them costs nothing and keeps that promise intact. *)
let load_ef_data () =
  match load_ef_layer () with
  | Error msg -> Error msg
  | Ok layer -> (
      match load_ef_lectionary () with
      | Error msg -> Error msg
      | Ok lectionary -> (
          match load_ef_commons () with
          | Error msg -> Error msg
          | Ok commons -> Ok (layer, lectionary, commons)))

let day_report y =
  match load_ef_data () with
  | Error msg ->
      Printf.eprintf "colitur: %s\n" msg;
      exit 2
  | Ok (layer, lectionary, commons) ->
      let context = Rite_ef.context ~lectionary ~commons in
      let module Cal = Colitur_kernel.Calendar in
      let by_rata : (int, (Rite_ef.Vocab_ef.season, Rite_ef.Vocab_ef.rank) Colitur_kernel.Liturgical_day.t) Hashtbl.t =
        Hashtbl.create 400
      in
      let index days =
        Array.iter
          (fun (d : (Rite_ef.Vocab_ef.season, Rite_ef.Vocab_ef.rank) Colitur_kernel.Liturgical_day.t) ->
            Hashtbl.replace by_rata (D.to_rata d.Colitur_kernel.Liturgical_day.date) d)
          days
      in
      index (Cal.year context layer (y - 1));
      index (Cal.year context layer 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
      while D.compare !d dec31 <= 0 do
        (match Hashtbl.find_opt by_rata (D.to_rata !d) with
        | Some day -> day_line day
        | None ->
            (* Unreachable for any [y] in 1583..9999: the two indexed
               liturgical years jointly cover [year_start (y-1), year_start
               (y+1)), which contains all of civil year [y]
               (calendar.mli). Not a [failwith] -- an out-of-domain [d]
               inside this loop is impossible by construction (jan1/dec31
               are themselves validated in range, and [add_days] only ever
               advances within the same civil year here) -- but a silent
               skip would violate the same "never silently dropped"
               standard the kernel holds itself to, so a gap surfaces
               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

let usage () =
  prerr_endline "colitur: usage: colitur easter <year> | colitur temporal <year> | colitur day <year>";
  exit 2

let with_year ys f =
  match int_of_string_opt ys with
  | Some y when y >= 1583 && y <= 9999 -> f y
  | Some y ->
      Printf.eprintf "colitur: year %d out of range 1583..9999\n" y;
      exit 2
  | None -> usage ()

let () =
  match Sys.argv with
  | [| _; "easter"; ys |] -> with_year ys easter_report
  | [| _; "temporal"; ys |] -> with_year ys temporal_report
  | [| _; "day"; ys |] -> with_year ys day_report
  | _ -> usage ()