path: root/test/test_efdotorg_ordo.ml

(* efdotorg-preface task (2026-08-24-colitur-celebrant-rubrics-phase1): the
   THIRD independent preface witness, extraordinaryform.org's own three
   annual Ordo editions (2024-2025, 2025-2026, 2026-2027). A prior task
   (2026-08-21-colitur-celebrant-rubrics-phase1, see
   .superpowers/sdd/2026-08-21-colitur-celebrant-rubrics-phase1/preface-
   witnesses-report.md) DECLINED to wire this source in, for two reasons:
   an unexplained "Advent" label in the preface column, and this corpus's
   own known Vigil-of-St-Lawrence gap. Both are now characterisation work,
   not blockers -- see tools/extract_efdotorg_ordo.py's own header for the
   full account this file's own comparator relies on.

   WHY THIS LAYER IS DIFFERENT FROM test_fiuv_ordo.ml/test_lms_ordo.ml:
   this source prints ONE preface value per day (unlike the LMS Ordo's own
   option lists), already reduced to the day's own real OFFICE by the
   menu-trap filter baked into the generator (see that script's own
   header, finding 1) -- so the comparison here is a single equality
   check per day, not a membership check. It is also the only one of the
   three witnesses whose own JSON, not a fresh pdftotext dump, is the
   input -- the JSON is already fidelity-audited
   (.superpowers/ordo-fidelity-report.md, 1091/1091 against an
   independently-written parser) and is treated as the source; this file
   does not re-parse the PDFs.

   SCOPE: preface only (RG 482-499, {!Rite_ef.Rubrics_ef.preface}) -- this
   source carries no Creed/Gloria/Te Deum data at all
   (docs/research/ordo/PROVENANCE-ordo-corpus.md: "The extraordinaryform.org
   editions carry NO Gloria or Creed"), so there is nothing else to
   compare it against. *)

module Cal = Colitur_kernel.Calendar
module Layer = Colitur_kernel.Layer
module Overlay = Colitur_kernel.Overlay
module LD = Colitur_kernel.Liturgical_day
module Date = Colitur_kernel.Date
module V = Rite_ef.Vocab_ef
module Preface = Colitur_kernel.Preface

let sanctoral_path = "../data/ef/sanctoral.sexp"
let adjustments_path = "../data/ef/adjustments.sexp"

(* Duplicated, not shared -- test_fiuv_ordo.ml/test_lms_ordo.ml's own
   identical function carries the same "no shared .mli" reasoning. *)
let sha256_of_file path =
  let tmp = Filename.temp_file "colitur_efdotorg_ordo_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 real_layer () =
  let layer =
    match Layer.load V.rank_of_sexp sanctoral_path with
    | Ok l -> l
    | Error e -> Alcotest.failf "%s: failed to load: %s" sanctoral_path e
  in
  let overlay =
    match Overlay.load V.rank_of_sexp adjustments_path with
    | Ok o -> o
    | Error e -> Alcotest.failf "%s: failed to load: %s" adjustments_path e
  in
  let layer, diagnostics = Overlay.apply layer overlay in
  Alcotest.(check (list string)) "the committed overlay applies cleanly, no diagnostics" []
    (List.map Overlay.diagnostic_to_string diagnostics);
  layer

let real_lectionary () =
  match Colitur_kernel.Lectionary.load "../data/ef/lectionary.sexp" with
  | Ok l -> l
  | Error e -> Alcotest.failf "../data/ef/lectionary.sexp: failed to load: %s" e

let real_commons () =
  match Rite_ef.Lectionary_ef.Commons.load "../data/ef/commons.sexp" with
  | Ok c -> c
  | Error e -> Alcotest.failf "../data/ef/commons.sexp: failed to load: %s" e

(* ---------------------------------------------------------------------- *)
(* The Ordo side: the sexp row, mirrored from tools/extract_efdotorg_ordo.py's *)
(* own row shape. *)
(* ---------------------------------------------------------------------- *)

open Sexplib0.Sexp_conv

type ordo_row = { date : string; mass : string option; cls : int option; colour : string option; praef : string option }
[@@deriving sexp]

let ordo_rows fixture_path =
  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 ordo_row_of_sexp sexp

(* ---------------------------------------------------------------------- *)
(* The colitur side, over the same window -- mirrors test_fiuv_ordo.ml's  *)
(* own [colitur_rows]. *)
(* ---------------------------------------------------------------------- *)

type colitur_row = { c_date : string; c_weekday : Date.weekday; c_preface : Preface.t option }

let colitur_rows ~year_lo ~year_hi ~window_first ~window_last =
  let layer = real_layer () in
  let rite = Rite_ef.context ~lectionary:(real_lectionary ()) ~commons:(real_commons ()) in
  let by_rata : (int, (V.season, V.rank) LD.t) Hashtbl.t = Hashtbl.create 800 in
  for y = year_lo to year_hi do
    let days = Cal.year rite layer y in
    Array.iter (fun (d : (V.season, V.rank) LD.t) -> Hashtbl.replace by_rata (Date.to_rata d.LD.date) d) days
  done;
  let mk s = match Date.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 Date.compare !d stop <= 0 do
    (match Hashtbl.find_opt by_rata (Date.to_rata !d) with
    | Some day ->
        rows :=
          { c_date = Date.to_iso8601 day.LD.date; c_weekday = Date.weekday day.LD.date; c_preface = day.LD.preface }
          :: !rows
    | None -> Alcotest.failf "no colitur day resolved for %s" (Date.to_iso8601 !d));
    d := Date.add_days !d 1
  done;
  List.rev !rows

(* ---------------------------------------------------------------------- *)
(* Classification -- see tools/extract_efdotorg_ordo.py's own header,     *)
(* finding 3, for why "Advent" needs the day's own weekday rather than a  *)
(* static table entry: RG 494(b) grants the TRINITY preface on every      *)
(* Advent SUNDAY, RG 498 the residual COMMON on every Advent FERIA, and   *)
(* this source's own "Advent" label does not distinguish the two. Every   *)
(* other raw value maps 1:1 onto exactly one {!Preface.t} constructor --  *)
(* verified exhaustive over the whole 1091-day office-selected population *)
(* while building this comparison (16 distinct raw values: these 14 fixed *)
(* mappings, "Advent" itself, and [None]) -- unlike the FIUV/LMS sources, *)
(* nothing here is genuinely unclassifiable. *)
(* ---------------------------------------------------------------------- *)

let classify_praef ~(weekday : Date.weekday) (raw : string) : Preface.t option =
  match raw with
  | "Common" -> Some Preface.Common
  | "For the Dead" -> Some Preface.Requiem
  | "Easter" -> Some Preface.Easter
  | "Lent" -> Some Preface.Lent
  | "BVM" -> Some Preface.Bvm
  | "Holy Trinity" -> Some Preface.Trinity
  | "Holy Cross" -> Some Preface.Holy_cross
  | "Nativity" -> Some Preface.Nativity
  | "Apostles" -> Some Preface.Apostles
  | "Ascension" -> Some Preface.Ascension
  | "Holy Spirit" -> Some Preface.Holy_spirit
  | "Epiphany" -> Some Preface.Epiphany
  | "St. Joseph" -> Some Preface.St_joseph
  | "Sacred Heart" -> Some Preface.Sacred_heart
  | "Christ the King" -> Some Preface.Christ_the_king
  | "Advent" -> Some (if weekday = Date.Sun then Preface.Trinity else Preface.Common)
  | _ -> None

(* ---------------------------------------------------------------------- *)
(* data/ef/expected-divergences-efdotorg.sexp -- same shape as the other  *)
(* Ordo allow-lists' own [allow_entry]. A SEPARATE file: this Ordo is a   *)
(* FIFTH lineage (lectio/missalemeum, LMS, FIUV, and now this one), a     *)
(* different publisher and a different compiler from all three others.   *)
(* ---------------------------------------------------------------------- *)

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

let load_allow_list allow_list_path =
  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

let allow_list_path = "../data/ef/expected-divergences-efdotorg.sexp"

(* ---------------------------------------------------------------------- *)
(* [make_suite]: one edition's worth of tests, parameterised -- mirrors   *)
(* test_lms_ordo.ml's own shape. *)
(* ---------------------------------------------------------------------- *)

let make_suite ~label ~fixture_path ~fixture_sha256 ~window_first ~window_last ~year_lo ~year_hi ~expected_rows
    ~expected_no_data ~allow_list_id_for_date =
  let test_fixture_checksum () =
    Alcotest.(check string) "fixture SHA-256 matches its provenance note" fixture_sha256
      (sha256_of_file fixture_path)
  in
  let test_dates_align () =
    let ordo = ordo_rows fixture_path in
    let colitur = colitur_rows ~year_lo ~year_hi ~window_first ~window_last in
    Alcotest.(check int) (Printf.sprintf "the Ordo fixture has %d rows (%s..%s)" expected_rows window_first window_last)
      expected_rows (List.length ordo);
    Alcotest.(check int) "colitur resolved the same number of days" (List.length ordo) (List.length colitur);
    (match ordo with o :: _ -> Alcotest.(check string) "first date" window_first o.date | [] -> Alcotest.fail "empty");
    (match List.rev ordo with
    | o :: _ -> Alcotest.(check string) "last date" window_last o.date
    | [] -> Alcotest.fail "empty");
    let mismatched =
      List.filter_map
        (fun (o, c) -> if String.equal o.date c.c_date then None else Some (o.date, c.c_date))
        (List.combine ordo colitur)
    in
    Alcotest.(check (list (pair string string))) "no misaligned dates" [] mismatched
  in
  (* This window's own Good Friday(s), RE-DERIVED from
     {!Colitur_kernel.Computus.gregorian_easter} for every civil year the
     window touches (never hardcoded), plus this edition's own share of
     the single known SOURCE GAP (2027-03-03) -- the only two shapes a row
     can have no [praef] at all for (see tools/extract_efdotorg_ordo.py's
     own header, findings 2 and 5). *)
  let window_no_praef () =
    let first_year = int_of_string (String.sub window_first 0 4) in
    let last_year = int_of_string (String.sub window_last 0 4) in
    let good_fridays =
      List.map
        (fun y -> Date.to_iso8601 (Date.add_days (Colitur_kernel.Computus.gregorian_easter y) (-2)))
        (List.init (last_year - first_year + 1) (fun i -> first_year + i))
    in
    let candidates = good_fridays @ [ "2027-03-03" ] in
    List.filter (fun d -> String.compare d window_first >= 0 && String.compare d window_last <= 0) candidates
    |> List.sort_uniq String.compare
  in
  let test_praef_coverage () =
    let ordo = ordo_rows fixture_path in
    let no_praef = List.filter (fun o -> o.praef = None) ordo in
    let expected = window_no_praef () in
    Alcotest.(check int) "the no-praef population matches this window's own Good-Friday-plus-source-gap count"
      expected_no_data (List.length no_praef);
    Alcotest.(check (list string)) "every no-praef row is either this window's own Good Friday or the known source gap"
      expected (List.map (fun o -> o.date) no_praef)
  in
  let describe_praef_mismatch (o : ordo_row) (c : colitur_row) (expected : Preface.t) =
    Printf.sprintf "%s %S: colitur preface=%s, %s praef=%S (classified %s, weekday %s)" o.date
      (Option.value o.mass ~default:"?")
      (match c.c_preface with Some p -> Preface.to_string p | None -> "NONE")
      label (Option.get o.praef) (Preface.to_string expected) (Date.weekday_to_string c.c_weekday)
  in
  let test_praef_matches_or_is_explained () =
    let ordo = ordo_rows fixture_path in
    let colitur = colitur_rows ~year_lo ~year_hi ~window_first ~window_last in
    let allow_list = load_allow_list allow_list_path in
    let by_id = List.map (fun e -> (e.id, e)) allow_list in
    let unexplained = ref [] in
    let unclassifiable = ref [] in
    let explained_counts = Hashtbl.create 8 in
    List.iter2
      (fun (o : ordo_row) (c : colitur_row) ->
        if not (String.equal o.date c.c_date) then Alcotest.failf "misaligned: ordo %s vs colitur %s" o.date c.c_date;
        match o.praef with
        | None -> ()
        | Some raw -> (
            match classify_praef ~weekday:c.c_weekday raw with
            | None -> unclassifiable := o.date :: !unclassifiable
            | Some expected ->
                if c.c_preface = Some expected then ()
                else
                  match allow_list_id_for_date o.date with
                  | Some id ->
                      Hashtbl.replace explained_counts id (1 + try Hashtbl.find explained_counts id with Not_found -> 0)
                  | None -> unexplained := describe_praef_mismatch o c expected :: !unexplained))
      ordo colitur;
    Alcotest.(check (list string))
      (Printf.sprintf "[%s] every preface mismatch is named in the allow-list -- none unexplained" label)
      [] (List.rev !unexplained);
    Alcotest.(check (list string))
      (Printf.sprintf "[%s] every raw praef value classifies -- none dropped" label)
      [] (List.rev !unclassifiable);
    Hashtbl.iter
      (fun id n ->
        match List.assoc_opt id by_id with
        | None -> Alcotest.failf "allow-list entry %s used by the comparator but not declared in %s" id allow_list_path
        | Some e -> Alcotest.(check int) (Printf.sprintf "%s: expected_rows matches the actual count" id) e.expected_rows n)
      explained_counts
  in
  (* The known Vigil-of-St-Lawrence corpus gap (tools/extract_efdotorg_ordo.py's
     own header, finding 4; docs/research/ordo/PROVENANCE-ordo-corpus.md;
     .superpowers/ordo-class-report.md) is RECONFIRMED present, but its
     effect on THIS axis now differs by year -- checked per date, not
     assumed uniform, because colitur's own CURRENT behaviour (RG 33's
     third trigger, which landed after the reports above were written --
     CLAUDE.md's own warning that `day`/`readings` output is not stable
     across commits is exactly this) already omits the vigil in SOME of
     these years for its own, entirely independent reason:
       - 2025-08-09 (Saturday): colitur's own RG33-third-trigger ALSO
         omits the vigil this year (RG 78's BVM Saturday Office wins
         outright), and Rule A (this generator's own finding 6) picks the
         SAME office from the corpus's own listing -- a full, direct
         match (office identity AND preface), not a lucky coincidence
         limited to preface alone.
       - 2027-08-09 (Monday): colitur's own vigil IS genuinely observed
         this year (RG33's trigger does not fire); the corpus still shows
         no trace of it at all -- STILL the known gap, reconfirmed, naming
         St Romanus instead -- but both the true Vigil (Class3, no
         title-preface trigger) and the corpus's own substitute fall
         through RG 482's chain to the identical Common preface, so the
         identity error stays invisible to this one axis. Asserted
         POSITIVELY (not merely "no failure occurred") so a future change
         giving either office a real trigger would surface here.
       - 2026-08-09 (Sunday): the vigil is impeded on every source (a
         Sunday outranks a Class3 vigil outright); no special case is
         needed and none is asserted here. *)
  let test_known_vigil_of_st_lawrence_shape () =
    let ordo = ordo_rows fixture_path in
    let colitur = colitur_rows ~year_lo ~year_hi ~window_first ~window_last in
    let by_date = List.combine ordo colitur in
    let find d = List.find_opt (fun ((o : ordo_row), _) -> String.equal o.date d) by_date in
    let in_window d = String.compare d window_first >= 0 && String.compare d window_last <= 0 in
    (match find "2025-08-09" with
    | Some (o, c) when in_window "2025-08-09" ->
        Alcotest.(check (option string)) "2025-08-09: Rule A selects the BVM Saturday Office directly" (Some "BVM")
          o.praef;
        Alcotest.(check (option string))
          "2025-08-09: colitur's own answer is the same office (RG33 3rd trigger + RG78)" (Some "bvm")
          (Option.map Preface.to_string c.c_preface)
    | _ -> ());
    match find "2027-08-09" with
    | Some (o, c) when in_window "2027-08-09" ->
        Alcotest.(check (option string))
          "2027-08-09: the known gap is reconfirmed -- the corpus still shows no Vigil of St Lawrence"
          (Some "Common") o.praef;
        Alcotest.(check (option string))
          "2027-08-09: colitur's own real Vigil office also reads Common -- the identity error stays invisible here"
          (Some "common") (Option.map Preface.to_string c.c_preface)
    | _ -> ()
  in
  ( label,
    [ Alcotest.test_case "fixture SHA-256 matches its provenance note" `Quick test_fixture_checksum;
      Alcotest.test_case "streams are N rows each, dates aligned 1:1" `Quick test_dates_align;
      Alcotest.test_case "no-praef population matches Good Friday plus the known source gap" `Quick
        test_praef_coverage;
      Alcotest.test_case "every preface mismatch is named in the allow-list -- none unexplained" `Quick
        test_praef_matches_or_is_explained;
      Alcotest.test_case "the known Vigil-of-St-Lawrence gap: reconfirmed in 2027, resolved by Rule A in 2025" `Quick
        test_known_vigil_of_st_lawrence_shape
    ] )

(* The seven adjudicated root causes behind this comparison's own 11 row-
   level divergences (three editions combined) -- see
   data/ef/expected-divergences-efdotorg.sexp for the full citation of
   each. Date-keyed, the same discipline test_lms_ordo.ml's own
   [allow_list_id_for_date] and test_fiuv_ordo.ml's own
   [fiuv_allow_list_id_for_date] use, and for the identical reason: an
   entry that starts firing on an unexpected new date must be visible as
   a real change, not silently absorbed. Shared across all three editions
   (unlike the LMS file's per-window function) because every id here is
   adjudicated against colitur's own DATA or RULES, not against a single
   edition's own printing quirk -- E1/E3/E4 each recur, unchanged, in
   more than one edition. *)
let allow_list_id_for_date = function
  | "2025-07-16" | "2026-07-16" | "2027-07-16" -> Some "E1"
  | "2026-09-24" -> Some "E2"
  | "2025-11-27" | "2026-11-27" -> Some "E3"
  | "2025-05-06" | "2026-05-06" -> Some "E4"
  | "2025-09-29" -> Some "E5"
  | "2026-11-01" -> Some "E6"
  | "2025-11-29" -> Some "E7"
  | _ -> None

let suite_2024_2025 =
  make_suite ~label:"efdotorg-ordo-2024-2025" ~fixture_path:"fixtures/efdotorg-ordo-2024-2025.sexp"
    ~fixture_sha256:"7de633e292fdb85415dd3ad87fcf9414fbb8f34c42772663b78e107e68c6e571" ~window_first:"2024-12-01"
    ~window_last:"2025-11-29" ~year_lo:2023 ~year_hi:2026 ~expected_rows:364 ~expected_no_data:1
    ~allow_list_id_for_date

let suite_2025_2026 =
  make_suite ~label:"efdotorg-ordo-2025-2026" ~fixture_path:"fixtures/efdotorg-ordo-2025-2026.sexp"
    ~fixture_sha256:"c810ec437cae9fde785f6b3453f77e667644fb82f465b3652040bb2a3b888b9b" ~window_first:"2025-11-30"
    ~window_last:"2026-11-28" ~year_lo:2024 ~year_hi:2027 ~expected_rows:364 ~expected_no_data:1
    ~allow_list_id_for_date

let suite_2026_2027 =
  make_suite ~label:"efdotorg-ordo-2026-2027" ~fixture_path:"fixtures/efdotorg-ordo-2026-2027.sexp"
    ~fixture_sha256:"19c35b45d7964dd357f92a871e81423af8217dff6c40178f3a95d3ec9c4091ea" ~window_first:"2026-11-29"
    ~window_last:"2027-11-27" ~year_lo:2025 ~year_hi:2028 ~expected_rows:364 ~expected_no_data:2
    ~allow_list_id_for_date

(* Guards against a stale allow-list entry, the same discipline
   test_lms_ordo.ml's own [test_allow_list_ids_are_exactly_l4] uses: a
   STATIC check that the sexp file's own declared ids are exactly this
   set -- not a cross-edition "did every id actually fire" proof (neither
   test_lms_ordo.ml nor test_fiuv_ordo.ml's own analogous guard attempts
   that either; each edition's own [test_praef_matches_or_is_explained]
   already fails loudly if an id fires the WRONG number of times, or if a
   real divergence names an id that does not exist at all). *)
let test_allow_list_ids_are_exactly_e1_to_e7 () =
  let ids = List.sort String.compare (List.map (fun e -> e.id) (load_allow_list allow_list_path)) in
  Alcotest.(check (list string)) "the efdotorg allow-list declares exactly E1..E7"
    [ "E1"; "E2"; "E3"; "E4"; "E5"; "E6"; "E7" ] ids

let suite_allow_list =
  ( "efdotorg-ordo-allow-list",
    [ Alcotest.test_case "declares exactly E1..E7" `Quick test_allow_list_ids_are_exactly_e1_to_e7 ] )