path: root/test/test_fiuv_ordo.ml

(* Witnesses task (2026-08-22-colitur-celebrant-rubrics-phase1): the
   SEVENTH validation layer, and the first UNIVERSAL, SECOND-COMPILER
   witness -- the FIUV (Foederatio Internationalis Una Voce) Ordo for
   2025-2026, compiled by Joseph Shaw, independent of the Latin Mass
   Society's own three editions (test_lms_ordo.ml) except for sharing a
   publisher/host (see test/fixtures/fiuv-ordo-2025-2026.sexp's own
   provenance header, and docs/research/ordo/PROVENANCE-ordo-corpus.md,
   for the full account of what independence this source does and does
   not buy).

   WHY THIS LAYER IS MORE VALUABLE THAN THE LMS ONE, per the task brief's
   own four reasons: (1) UNIVERSAL -- no diocesan variants to exclude at
   all, so this fixture's own [row] carries no [has_diocesan_variant]
   field, unlike the LMS one; (2) IN LATIN, the rubrics' own vocabulary;
   (3) BOTH DIRECTIONS EXPLICIT ("Gloria"/"sine Gloria", "Credo"/"sine
   Credo") -- used here exactly as with the LMS source; (4) RECORDS THE
   TE DEUM, the hinge of RG 431(a)'s own Mass-Gloria rule (deferred to
   Phase 2, Breviary nn. 237-238) -- captured into the fixture, NOT
   compared here (no colitur-side Te Deum predicate exists yet).

   SCOPE: the CREED (RG 475-476, {!Rite_ef.Rubrics_ef.creed}) is the ONE
   axis compared against colitur, per the task brief. [praef] and
   [te_deum] are captured into the fixture (a genuinely useful data set
   for Phase 2/3's still-unbuilt Gloria and preface rules) but
   deliberately NOT validated here -- there is nothing on colitur's own
   side yet to compare either against. [class_] (raw, including the FIUV
   ordo's own explicit "III cl." vs "III cl. (Priv.)" Cum Sanctissima
   convention, stated on its own title page) is likewise captured but not
   compared: colitur's core is strictly the 1962 Missal with Cum
   Sanctissima/Quo Magis modelled only as an OVERLAY, never core
   (CLAUDE.md's own binding decision #2), so colitur's UNOVERLAID output
   has no Cum-Sanctissima-aware notion of "III cl." vs "(Priv.)" to
   compare this field against in the first place -- comparing it would be
   comparing the Ordo against a question colitur's default configuration
   was never asked. *)

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

let sanctoral_path = "../data/ef/sanctoral.sexp"
let adjustments_path = "../data/ef/adjustments.sexp"
let fixture_path = "fixtures/fiuv-ordo-2025-2026.sexp"
let allow_list_path = "../data/ef/expected-divergences-fiuv.sexp"

(* Duplicated, not shared -- 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_fiuv_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 fixture_sha256 = "becadaad43b3a42c4eb820cb4e93d68f9b1c07a2c8e5273167cd599758af5c67"

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_fiuv_ordo.ml's *)
(* own [row] -- see this file's own header on why there is no             *)
(* [has_diocesan_variant] field here, unlike the LMS mirror.               *)
(* ---------------------------------------------------------------------- *)

open Sexplib0.Sexp_conv

type ordo_row = {
  date : string;
  class_ : string option;
  title : string;
  te_deum : bool option;
  gloria : bool option;
  credo : bool option;
  praef : string option;
}
[@@deriving sexp]

let ordo_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 ordo_row_of_sexp sexp

let window_first = "2025-11-27"
let window_last = "2026-12-31"

(* ---------------------------------------------------------------------- *)
(* The colitur side, over the same window -- mirrors test_lms_ordo.ml's   *)
(* own [colitur_rows] exactly (a liturgical year straddles two civil      *)
(* years, so the resolution walk starts a civil year early and ends one   *)
(* late). *)
(* ---------------------------------------------------------------------- *)

type colitur_row = { c_date : string; c_creed : bool }

let colitur_rows () =
  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 = 2024 to 2027 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_creed = day.LD.creed } :: !rows
    | None -> Alcotest.failf "no colitur day resolved for %s" (Date.to_iso8601 !d));
    d := Date.add_days !d 1
  done;
  List.rev !rows

(* ---------------------------------------------------------------------- *)
(* data/ef/expected-divergences-fiuv.sexp -- same shape as the LMS/       *)
(* missalemeum allow-lists' own [allow_entry]. A SEPARATE file: this Ordo *)
(* is a fourth, independent lineage from all three others already in this *)
(* project. *)
(* ---------------------------------------------------------------------- *)

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

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

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

let test_dates_align () =
  let ordo = ordo_rows () in
  let colitur = colitur_rows () in
  Alcotest.(check int) "the Ordo fixture has 400 rows (2025-11-27..2026-12-31)" 400 (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

(* Holy Saturday (2026-04-04) is the ONLY day this fixture shows no Credo
   marker for -- confirmed directly against the raw source: unlike the
   LMS Ordo (whose "no Mass" day is Good Friday, the 1955-restored Holy
   Week having no Mass that day at all), THIS Ordo's Good Friday DOES
   carry a Mass rubric ("Missa pr., ... Gloria, sine Credo, praef.
   comm."), leaving Holy Saturday as the sole day with no Mass mentioned
   at all (its own Vigil Mass is conventionally counted under Easter
   Sunday's own date in this source, matching a real, if narrower,
   instance of the same "a vigil Mass is dated to the day it anticipates"
   convention the LMS characterisation already established). Asserted as
   the ONLY such day, not merely observed once: a parsing regression that
   swallowed a real row would otherwise silently join this bucket instead
   of failing loudly as an unexplained mismatch. *)
let test_creed_coverage () =
  let ordo = ordo_rows () in
  let no_creed = List.filter (fun o -> o.credo = None) ordo in
  Alcotest.(check (list string)) "only Holy Saturday has no Ordo Creed marker" [ "2026-04-04" ]
    (List.map (fun o -> o.date) no_creed)

let describe_creed_mismatch (o : ordo_row) (c : colitur_row) =
  Printf.sprintf "%s %S: colitur creed=%b, Ordo creed=%b" o.date o.title c.c_creed (Option.get o.credo)

(* Which allow-list id, if any, explains a Creed mismatch on this date --
   date-keyed, not "any declared entry excuses any mismatch", the same
   discipline test_lms_ordo.ml's own [allow_list_id_for_date] uses 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. Empty until characterisation found a real divergence to
   name. *)
let fiuv_allow_list_id_for_date = ([] : (string * string) list)

let test_creed_matches_or_is_explained () =
  let ordo = ordo_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 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.credo with
      | None -> ()
      | Some ocreed ->
          if Bool.equal ocreed c.c_creed then ()
          else
            match List.assoc_opt o.date fiuv_allow_list_id_for_date with
            | Some id -> Hashtbl.replace explained_counts id (1 + try Hashtbl.find explained_counts id with Not_found -> 0)
            | None -> unexplained := describe_creed_mismatch o c :: !unexplained)
    ordo colitur;
  Alcotest.(check (list string)) "every Creed mismatch is named in the allow-list -- none unexplained" []
    (List.rev !unexplained);
  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;
  List.iter
    (fun e ->
      if not (Hashtbl.mem explained_counts e.id) then
        Alcotest.failf "allow-list entry %s is declared but never matched a real divergence" e.id)
    allow_list

let suite =
  ( "fiuv-ordo",
    [ Alcotest.test_case "fixture SHA-256 matches its provenance note" `Quick test_fixture_checksum;
      Alcotest.test_case "streams are 400 rows each, dates aligned 1:1" `Quick test_dates_align;
      Alcotest.test_case "only Holy Saturday has no Ordo Creed marker" `Quick test_creed_coverage;
      Alcotest.test_case "every Creed difference is named in the cited allow-list -- none unexplained" `Quick
        test_creed_matches_or_is_explained
    ] )