aboutsummaryrefslogtreecommitdiff
path: root/bin/main.ml
diff options
context:
space:
mode:
Diffstat (limited to 'bin/main.ml')
-rw-r--r--bin/main.ml107
1 files changed, 67 insertions, 40 deletions
diff --git a/bin/main.ml b/bin/main.ml
index bc02654..16daa49 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -122,6 +122,19 @@ let load_ef_lectionary () =
| 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
@@ -155,50 +168,64 @@ let day_line (d : (Rite_ef.Vocab_ef.season, Rite_ef.Vocab_ef.rank) Colitur_kerne
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). *)
-let day_report y =
+(* 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 -> (
- match load_ef_lectionary () with
- | Error msg ->
- Printf.eprintf "colitur: %s\n" msg;
- exit 2
- | Ok lectionary ->
- let context = Rite_ef.context ~lectionary 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)
+ | 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>";