path: root/test/test_litcal_of.ml

(* of-litcal-layer task (2026-08-25): external validation of the OF rite
   module's Phase 1 temporal cycle (lib/rites/rite_of/temporal_of.ml) --
   specifically the two-block Ordinary Time week arithmetic Normae n. 44
   requires, named in .superpowers/sdd/of-phase1-report.md's own
   "Concerns" section as "the single highest-risk function in this phase",
   with NO external witness anywhere in Phase 1's own test suite.

   Witness: litcal (github.com/Liturgical-Calendar/LiturgicalCalendarAPI),
   Apache-2.0, already archived and SHA-256-pinned by the sibling project
   lectio. See test/fixtures/litcal-temporal-2024-2035.sexp's own header
   for the full provenance, the row-selection rules, and the
   SECOND-IMPLEMENTATION-NOT-SECOND-PUBLICATION caveat this layer is
   built under -- NOT repeated here.

   `rite_of` is deliberately not wired into `Colitur_kernel.Rite.t` or the
   CLI yet (Phase 2's own work) -- this file calls
   {!Rite_of.Temporal_of.temporal} directly, exactly as test_temporal_of.ml
   already does, over the SAME civil-date window the fixture covers
   (2023-12-03..2035-12-01), no {!Colitur_kernel.Calendar}/{!Colitur_kernel
   .Layer} involved.

   SCOPE: season and Ordinary Time week only -- the two fields the fixture
   carries. Rank/colour/named-day identity are out of scope for this
   layer (Phase 1 has no sanctoral data to compare them against, and
   litcal's own [grade_lcl]/[name] are read here only to CLASSIFY why a
   week is unwitnessed, never compared against a colitur rank). *)

module V = Rite_of.Vocab_of
module T = Rite_of.Temporal_of
module D = Colitur_kernel.Date

let fixture_path = "fixtures/litcal-temporal-2024-2035.sexp"
let allow_list_path = "../data/of/expected-divergences-litcal.sexp"

(* Duplicated, not shared -- every other Ordo/oracle test file in this
   project carries its own identical copy for the same reason
   (test_fiuv_ordo.ml's own comment): no .mli any of them could share it
   through. *)
let sha256_of_file path =
  let tmp = Filename.temp_file "colitur_litcal_of_sha256" ".txt" in
  Fun.protect
    ~finally:(fun () -> try Sys.remove tmp with Sys_error _ -> ())
    (fun () ->
      let cmd = Printf.sprintf "sha256sum %s > %s" (Filename.quote path) (Filename.quote tmp) in
      let rc = Sys.command cmd in
      if rc <> 0 then Alcotest.failf "sha256sum exited %d for %s (is it on PATH?)" rc path;
      let ic = open_in tmp in
      let line =
        try input_line ic
        with End_of_file ->
          close_in ic;
          Alcotest.failf "sha256sum produced no output for %s" path
      in
      close_in ic;
      match String.index_opt line ' ' with
      | Some i -> String.sub line 0 i
      | None -> Alcotest.failf "unexpected sha256sum output for %s: %S" path line)

let fixture_sha256 = "f5d65b33ac1afd2a6d1d8e053d9c8897a24ffcc67136e73f0978189f02dae816"

(* ---------------------------------------------------------------------- *)
(* The litcal side: the sexp row, mirroring tools/extract_litcal_ordo.py's *)
(* own [build_rows] output row-for-row.                                    *)
(* ---------------------------------------------------------------------- *)

open Sexplib0.Sexp_conv

type litcal_row = { date : string; season : string; ot_week : int option; event_key : string; grade_lcl : string }
[@@deriving sexp]

let litcal_rows () =
  let sexp =
    try Sexplib.Sexp.load_sexp fixture_path
    with e -> Alcotest.failf "%s: failed to load: %s" fixture_path (Printexc.to_string e)
  in
  list_of_sexp litcal_row_of_sexp sexp

let window_first = "2023-12-03"
let window_last = "2035-12-01"

(* ---------------------------------------------------------------------- *)
(* The colitur side, over the identical window -- straight [Temporal_of.  *)
(* temporal] calls, no Rite.t/Calendar involved (Phase 1 has neither).     *)
(* ---------------------------------------------------------------------- *)

type colitur_row = { c_date : string; c_season : V.season; c_ot_week : int option }

let colitur_rows () =
  let mk s = match D.of_iso8601 s with Ok d -> d | Error e -> Alcotest.failf "%s: %s" s e in
  let rows = ref [] in
  let d = ref (mk window_first) in
  let stop = mk window_last in
  while D.compare !d stop <= 0 do
    let temporal = T.temporal !d in
    rows :=
      { c_date = D.to_iso8601 !d; c_season = temporal.Colitur_kernel.Temporal.season;
        c_ot_week = temporal.Colitur_kernel.Temporal.week }
      :: !rows;
    d := D.add_days !d 1
  done;
  List.rev !rows

(* litcal's own [liturgical_season] atom (lowercased by the generator) ->
   the [Vocab_of.season] it should equal, or [None] for
   ["easter_triduum"] -- a season colitur's own vocabulary has NO value
   for at all (temporal_of.ml's own top-of-module comment; see this task's
   own fixture header). [None] is not "unmapped/unknown": it is the
   signal that this row belongs to the Triduum allow-list class below,
   never silently skipped. *)
let expected_season = function
  | "advent" -> Some V.Advent
  | "christmas" -> Some V.Christmas
  | "lent" -> Some V.Lent
  | "easter" -> Some V.Easter
  | "ordinary_time" -> Some V.Ordinary_time
  | "easter_triduum" -> None
  | s -> Alcotest.failf "unrecognised litcal season atom in fixture: %S" s

(* ---------------------------------------------------------------------- *)
(* data/of/expected-divergences-litcal.sexp -- same shape as every other   *)
(* allow-list in this project (test_fiuv_ordo.ml's own [allow_entry]).     *)
(* ---------------------------------------------------------------------- *)

type allow_entry = { id : string; citation : string; verdict : string; note : string; expected_rows : int }
[@@deriving sexp]

let load_allow_list () =
  let sexps =
    try Sexplib.Sexp.load_sexps allow_list_path
    with e -> Alcotest.failf "%s: failed to load: %s" allow_list_path (Printexc.to_string e)
  in
  List.map allow_entry_of_sexp sexps

(* L1 -- the only season-divergence class this layer expects: every
   EASTER_TRIDUUM-tagged litcal row (Holy Thursday's own evening Mass,
   Good Friday, Holy Saturday -- see the fixture header for why the
   Chrism Mass row is excluded upstream, in the generator, rather than
   here). *)
let is_l1_triduum (r : litcal_row) = String.equal r.season "easter_triduum"

(* ---------------------------------------------------------------------- *)
(* Tests *)
(* ---------------------------------------------------------------------- *)

let test_fixture_checksum () =
  Alcotest.(check string) "fixture SHA-256 matches its provenance header" fixture_sha256 (sha256_of_file fixture_path)

let test_dates_align () =
  let litcal = litcal_rows () in
  let colitur = colitur_rows () in
  Alcotest.(check int) "the fixture has 4382 rows (2023-12-03..2035-12-01)" 4382 (List.length litcal);
  Alcotest.(check int) "colitur resolved the same number of days" (List.length litcal) (List.length colitur);
  (match litcal with
  | l :: _ -> Alcotest.(check string) "first date" window_first l.date
  | [] -> Alcotest.fail "empty");
  (match List.rev litcal with
  | l :: _ -> Alcotest.(check string) "last date" window_last l.date
  | [] -> Alcotest.fail "empty");
  let mismatched =
    List.filter_map
      (fun (l, c) -> if String.equal l.date c.c_date then None else Some (l.date, c.c_date))
      (List.combine litcal colitur)
  in
  Alcotest.(check (list (pair string string))) "no misaligned dates" [] mismatched

(* The season comparison: every litcal row either matches colitur's own
   season outright, or is named in the allow-list (L1, the Triduum class)
   -- zero unexplained anywhere in the 4382-day window. *)
let test_season_matches_or_is_explained () =
  let litcal = litcal_rows () in
  let colitur = colitur_rows () in
  let allow_list = load_allow_list () in
  let by_id = List.map (fun e -> (e.id, e)) allow_list in
  let unexplained = ref [] in
  let l1_count = ref 0 in
  List.iter2
    (fun (l : litcal_row) (c : colitur_row) ->
      if not (String.equal l.date c.c_date) then Alcotest.failf "misaligned: litcal %s vs colitur %s" l.date c.c_date;
      match expected_season l.season with
      | None ->
          (* easter_triduum *)
          if is_l1_triduum l then incr l1_count
          else Alcotest.failf "%s: unrecognised no-mapping season %S" l.date l.season
      | Some expected ->
          if expected = c.c_season then ()
          else
            unexplained :=
              Printf.sprintf "%s: colitur season=%s, litcal season=%s (event_key=%S)" l.date
                (V.season_to_string c.c_season) l.season l.event_key
              :: !unexplained)
    litcal colitur;
  Alcotest.(check (list string)) "every season mismatch is named in the allow-list -- none unexplained" []
    (List.rev !unexplained);
  (match List.assoc_opt "L1" by_id with
  | None -> Alcotest.failf "allow-list entry L1 is used by the comparator but not declared in %s" allow_list_path
  | Some e -> Alcotest.(check int) "L1 (Easter Triduum, no colitur season value) expected_rows" e.expected_rows !l1_count);
  List.iter
    (fun e -> if not (String.equal e.id "L1") then Alcotest.failf "unknown allow-list entry %s (only L1 is used)" e.id)
    allow_list

(* THE load-bearing test: the Ordinary Time week, on every day litcal
   actually witnesses one (an Ord* event_key present on that date) --
   Normae n. 44's own two-block resumption arithmetic, the risk this whole
   layer exists to validate. Zero tolerance: every witnessed week must
   match exactly, with no allow-list at all -- a real mismatch here would
   mean colitur serves the WRONG MASS FORMULARY, not a cosmetic
   difference, so there is no "expected divergence" shape for this half of
   the comparison the way there is for season/Triduum. *)
let test_ordinary_time_week_matches () =
  let litcal = litcal_rows () in
  let colitur = colitur_rows () in
  let mismatched = ref [] in
  let witnessed = ref 0 in
  List.iter2
    (fun (l : litcal_row) (c : colitur_row) ->
      if not (String.equal l.date c.c_date) then Alcotest.failf "misaligned: litcal %s vs colitur %s" l.date c.c_date;
      match l.ot_week with
      | None -> ()
      | Some n ->
          incr witnessed;
          if c.c_ot_week <> Some n then
            mismatched :=
              Printf.sprintf "%s: colitur week=%s, litcal week=%d (event_key=%S, colitur season=%s)" l.date
                (match c.c_ot_week with Some w -> string_of_int w | None -> "None")
                n l.event_key (V.season_to_string c.c_season)
              :: !mismatched)
    litcal colitur;
  Alcotest.(check (list string)) "every witnessed Ordinary Time week matches exactly -- zero tolerance" []
    (List.rev !mismatched);
  (* Pinned so a change in the fixture or the extraction rules is visible,
     not merely "still zero mismatches" -- the same discipline every
     count assertion in this project's other Ordo/oracle layers follows. *)
  Alcotest.(check int) "1876 of the 4382 days witness an Ordinary Time week" 1876 !witnessed

(* The UNWITNESSED half of Ordinary Time, mirroring the EF module's own
   [Comm_identity_unresolved] precedent (CLAUDE.md's "know what each layer
   cannot see" section): NOT a mismatch (litcal has no answer to compare
   against on these days, an obligatory celebration having suppressed its
   own weekday/Sunday row), so NOT allow-listed -- but counted and
   classified rather than silently skipped. Two shapes, both named in the
   fixture's own header: (a) an obligatory celebration suppresses the
   weekday outright (by far the majority); (b) a handful of dates (the
   Immaculate-Heart-of-Mary window) where litcal's own data omits the
   weekday despite showing only optional-memorial-grade rows -- both
   collapse to the same "grade_lcl <> weekday" signal here, since the
   ONLY grade litcal ever gives an Ord* row is "weekday"/"FEAST OF THE
   LORD" (a Sunday) -- checked directly against the fixture's own content,
   not assumed. *)
let test_unwitnessed_ordinary_time_is_counted () =
  let litcal = litcal_rows () in
  let unwitnessed = List.filter (fun (l : litcal_row) -> String.equal l.season "ordinary_time" && l.ot_week = None) litcal in
  Alcotest.(check int) "859 Ordinary Time days have no litcal-witnessed week" 859 (List.length unwitnessed);
  let by_grade = Hashtbl.create 8 in
  List.iter
    (fun (l : litcal_row) ->
      Hashtbl.replace by_grade l.grade_lcl (1 + try Hashtbl.find by_grade l.grade_lcl with Not_found -> 0))
    unwitnessed;
  let total = Hashtbl.fold (fun _ n acc -> n + acc) by_grade 0 in
  Alcotest.(check int) "grade_lcl buckets sum to the same 859" 859 total

let suite =
  ( "litcal-of",
    [ Alcotest.test_case "fixture checksum" `Quick test_fixture_checksum;
      Alcotest.test_case "dates align" `Quick test_dates_align;
      Alcotest.test_case "season matches or is explained" `Quick test_season_matches_or_is_explained;
      Alcotest.test_case "Ordinary Time week matches exactly where witnessed" `Quick test_ordinary_time_week_matches;
      Alcotest.test_case "unwitnessed Ordinary Time is counted, not skipped" `Quick test_unwitnessed_ordinary_time_is_counted
    ] )