path: root/test/test_lms_ordo.ml

(* Task 6 (2026-08-21-colitur-celebrant-rubrics-phase1): validation layer 6
   -- the Latin Mass Society's own printed Ordo for England & Wales
   (test/fixtures/lms-ordo-2024-2025.sexp; that file's own provenance
   header carries the full source citation, SHA-256 and the
   characterisation record demanded before trusting a single row of it).

   WHY THIS LAYER EXISTS, AND WHAT IT IS INDEPENDENT OF: layers 3-4
   (test_differential.ml, test_oracle.ml) are ONE LINEAGE running Divinum
   Officium -> missalemeum -> lectio -> colitur (CLAUDE.md's "know what
   each layer cannot see" section); layer 5 (test_golden.ml) pins colitur's
   own output against itself. This Ordo is compiled independently by the
   Latin Mass Society (a printed book, ISBN 9781739209636, England & Wales
   diocesan propers) from the 1962 Missal/1960 rubrics directly -- it never
   passed through Divinum Officium, missalemeum or lectio at any point, so
   an error inherited by that whole lineage (colitur's own bootstrap
   included) is visible here for the first time.

   SCOPE, decided after running the comparison against real data (not
   guessed in advance -- see the fixture's own CHARACTERISATION section
   and task-6-report.md for the measurements this scoping rests on):

     - The CREED (RG 475-476, {!Rite_ef.Rubrics_ef.creed}): compared on
       every day, full 1:1. One genuine day is EXCLUDED, not silently
       skipped: 2025-04-18 (Good Friday) has no Mass in the 1955-restored
       Holy Week, so the Ordo prints no Gl/Cr line at all -- [test_
       creed_coverage] asserts this is the ONLY such day, so a future
       parsing regression that swallowed a real row would fail loudly
       here, not slip into "explained" silently.

     - The BVM-SATURDAY SEASONAL SELECTION (RG 309(a), "iuxta temporum
       diversitatem", {!Rite_ef.Lectionary_ef.bvm_saturday_citations}):
       the coordinator addendum's own "sharper check" -- the Ordo's own
       roman numeral (I-V) names WHICH of the five seasonal "Missae de
       sancta Maria in sabbato" is said, so it validates colitur's
       SEASONAL SELECTION, not merely that some BVM Mass was chosen.
       Built, because the extraction supports it (whole-line anchored
       match against all five, see the fixture header on why substring
       matching is wrong): every {!Colitur_kernel.Mass_formulary.Votive}
       day inside the fixture's own 2024-11-27..2025-12-31 window is
       checked against the numeral's implied season.

     - The FORMULARY OVERRIDE (does the day say its own Mass, or a
       borrowed one) -- compared for THREE of {!Colitur_kernel.
       Mass_formulary.source}'s five constructors, each independently
       100% clean against the real fixture:
         [Proper] (179 of 400 days): the Ordo shows NO "Mass of ..." line.
         [Preceding_sunday] (66 of 400): the Ordo ALWAYS shows one.
         [Common] (2 of 400): the Ordo shows NO "Mass of ..." line either
           -- a Common-routed saint (ubaldus, didacus) still keeps his OWN
           title in the Ordo, borrowing only the Common's PREFACE ("Common
           Pr" on the title line itself), never a separate override line.
       [Votive] is covered by the BVM check above instead (its own
       override line IS the roman-numeral line).
       [Own_slug] (139 of 400) is DELIBERATELY EXCLUDED from this axis,
       not silently -- a real, evidenced data-representation fact, not a
       guess: 11 of its 139 days DO show a "Mass of ..." override
       ("2nd Sunday of Advent", "the Epiphany", "1st Sunday after
       Pentecost"), because data/ef/lectionary.sexp carries some ferial
       slugs (e.g. [ef-advent-2-monday]) as an EXPLICIT entry whose
       citations are byte-identical to the following Sunday's own
       ([ef-advent-sunday-2]: both "Rom 15:4-13" / "Matt 11:2-10" --
       checked directly against the shipped data), rather than resolving
       through the {!Colitur_kernel.Mass_formulary.Preceding_sunday}
       fallback path. Both representations name the SAME texts -- this is
       a provenance-field ambiguity in colitur's own data, not a rubric
       question the Ordo could adjudicate either way, so asserting on it
       would manufacture exactly the kind of false divergence the
       coordinator addendum's "collapsed to ~0 real ones" warning is
       about. Recorded here rather than dropped silently, per the task
       brief's own instruction for exactly this situation.

   GLORIA is extracted into the fixture (a genuine, independently useful
   field for the still-unbuilt Phase 2 Gloria rule) but NOT compared here:
   colitur has no {!Rite_ef.Rubrics_ef}-level Gloria predicate yet (the
   design doc defers it explicitly), so there is nothing on colitur's own
   side to compare it against. Comparing it would be comparing the Ordo
   against nothing.

   DIOCESAN SCOPE: colitur computes the UNIVERSAL General Roman Calendar
   only (no diocesan overlay loaded by the differential/oracle harnesses
   anywhere in this suite) -- the Ordo is an England & Wales diocesan
   Ordo, and 156 of its 400 days (39%) carry at least one diocesan
   variant. Every comparison in this file reads ONLY the fixture's own
   universal-block fields ([formulary_override], [bvm_numeral], [gloria],
   [creed] are all derived from the text BEFORE the first diocese-list
   line -- see extract_lms_ordo.ml's own [scan_block]); the diocesan text
   itself is never read at all, only its PRESENCE is recorded
   ([has_diocesan_variant]), so no diocesan variant can leak into a
   comparison here by construction, not merely by care. *)

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 MF = Colitur_kernel.Mass_formulary
module V = Rite_ef.Vocab_ef

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

(* Asserted, not merely documented -- test_oracle.ml's own [fixture_sha256]
   comment explains why: a hand-edit or partial re-extraction would
   otherwise silently turn the oracle into an unlabelled snapshot of
   whatever someone last ran. Matches the fixture's own provenance header. *)
let fixture_sha256 = "da817b75c5bf40ed3be1d5f6890b199705e02ce4d42111253ab8547bccabc3f7"

(* Duplicated, not shared, from test_oracle.ml/test_differential.ml's own
   identical function -- neither file exposes an .mli the other could
   depend on, and this is three lines (test_oracle.ml's own comment). *)
let sha256_of_file path =
  let tmp = Filename.temp_file "colitur_lms_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 (not shared -- see this file's    *)
(* own header) from tools/extract_lms_ordo.ml's own [row].                 *)
(* ---------------------------------------------------------------------- *)

open Sexplib0.Sexp_conv

type ordo_row = {
  date : string;
  weekday : string;
  title : string;
  formulary_override : string option;
  bvm_numeral : string option;
  gloria : bool option;
  creed : bool option;
  has_diocesan_variant : bool;
}
[@@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

(* The fixture's own real window -- 2024-11-27 ("End of November 2024")
   through 2025-12-31 (the day before the extractor's own stop marker).
   400 = 4 (27-30 Nov 2024) + 31 (Dec 2024) + 365 (2025, not a leap year). *)
let window_first = "2024-11-27"
let window_last = "2025-12-31"

(* ---------------------------------------------------------------------- *)
(* The colitur side, over the same window. Mirrors test_oracle.ml's own    *)
(* [colitur_rows]: the resolution walk starts a year EARLY because a       *)
(* liturgical year is Advent-anchored and straddles two civil years.       *)
(* ---------------------------------------------------------------------- *)

type colitur_row = {
  c_date : string;
  c_season : V.season;
  c_formulary : MF.t option;
  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 = 2023 to 2025 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 y m d = match Date.make ~year:y ~month:m ~day:d with Ok t -> t | Error e -> failwith e in
  let rows = ref [] in
  let d = ref (mk 2024 11 27) in
  let stop = mk 2025 12 31 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_season = day.LD.temporal.Colitur_kernel.Temporal.season;
            c_formulary = day.LD.formulary; 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

(* ---------------------------------------------------------------------- *)
(* RG 309(a), "iuxta temporum diversitatem" -- INDEPENDENTLY re-derived    *)
(* from the rubric, not called from Lectionary_ef.bvm_saturday_citations   *)
(* (private to that .ml, no .mli export, and re-deriving here is itself   *)
(* the more useful check: importing colitur's own function would make     *)
(* this axis tautological). Mirrors that function's own season match      *)
(* exactly -- see its citation in lectionary_ef.ml for the scan lines.    *)
(* ---------------------------------------------------------------------- *)

let expected_bvm_numeral season ~month ~day =
  match (season : V.season) with
  | V.Advent -> "I"
  | V.Christmastide -> "II"
  | V.Time_after_epiphany when month = 1 || (month = 2 && day <= 2) -> "II"
  | V.Time_after_epiphany | V.Septuagesima | V.Lent | V.Passiontide -> "III"
  | V.Paschaltide -> "IV"
  | V.Time_after_pentecost -> "V"

(* ---------------------------------------------------------------------- *)
(* data/ef/expected-divergences-lms.sexp -- same shape as                  *)
(* test_oracle.ml's own [allow_entry]/[load_allow_list].                   *)
(* ---------------------------------------------------------------------- *)

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 (2024-11-27..2025-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

(* Good Friday (2025-04-18) has no Mass at all in the 1955-restored Holy
   Week -- the Ordo prints no Gl/Cr line, confirmed directly against the
   source (extract_lms_ordo's own row for that date, and the raw pdftotext
   text: "The Solemn Liturgical Action is celebrated in the afternoon...",
   no "Gl"/"Cr" token anywhere in the block). Asserted as the ONLY such
   day, not merely observed once: a future parsing regression that
   swallowed a real Gl/Cr line would otherwise silently join this
   "not applicable" 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.creed = None) ordo in
  Alcotest.(check (list string)) "only Good Friday has no Ordo Creed marker" [ "2025-04-18" ]
    (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 (formulary=%s)" o.date o.title c.c_creed
    (Option.get o.creed)
    (match c.c_formulary with
    | Some f -> Colitur_kernel.Slug.to_string f.MF.said
    | None -> "NONE")

(* The core assertion: every Creed divergence, over all 400 days (Good
   Friday excluded per [test_creed_coverage] above -- it is not a
   divergence, it is a day with nothing on the Ordo's side to compare),
   falls in a named, cited, adjudicated allow-list entry. Zero
   unexplained. *)
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 l1_dates = [ "2025-11-03" ] 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.creed with
      | None -> () (* Good Friday, see test_creed_coverage *)
      | Some ocreed ->
          if Bool.equal ocreed c.c_creed then ()
          else if List.mem o.date l1_dates then
            Hashtbl.replace explained_counts "L1" (1 + try Hashtbl.find explained_counts "L1" with Not_found -> 0)
          else 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;
  (* every declared entry must actually have fired, so the allow-list
     cannot silently accumulate a dead entry nothing triggers any more *)
  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

(* ---------------------------------------------------------------------- *)
(* The BVM-Saturday seasonal selection -- the coordinator addendum's own   *)
(* "sharper check". Restricted to colitur's [Votive] days, which is        *)
(* exactly {!Rite_ef.Lectionary_ef.is_bvm_saturday_office}'s own domain.   *)
(* ---------------------------------------------------------------------- *)

let test_bvm_seasonal_selection () =
  let ordo = ordo_rows () in
  let colitur = colitur_rows () in
  let votive_pairs =
    List.filter_map
      (fun (o, c) ->
        match c.c_formulary with
        | Some { MF.via = MF.Votive; _ } -> Some (o, c)
        | _ -> None)
      (List.combine ordo colitur)
  in
  Alcotest.(check int) "14 BVM-Saturday (Votive) days fall inside the fixture's own window" 14
    (List.length votive_pairs);
  let mismatches =
    List.filter_map
      (fun (o, c) ->
        let expected = expected_bvm_numeral c.c_season ~month:(int_of_string (String.sub c.c_date 5 2))
                          ~day:(int_of_string (String.sub c.c_date 8 2)) in
        match o.bvm_numeral with
        | Some got when String.equal got expected -> None
        | Some got -> Some (Printf.sprintf "%s: Ordo says %s, expected %s (season-derived)" o.date got expected)
        | None -> Some (Printf.sprintf "%s: colitur says Votive but the Ordo shows no BVM numeral" o.date))
      votive_pairs
  in
  Alcotest.(check (list string)) "every BVM-Saturday numeral matches its season -- none unexplained" [] mismatches

(* Reverse direction: every Ordo BVM-numeral day is a colitur Votive day
   too (rules out the Ordo naming a Saturday BVM Mass colitur never
   computed the office for at all). *)
let test_bvm_numeral_implies_votive () =
  let ordo = ordo_rows () in
  let colitur = colitur_rows () in
  let mismatches =
    List.filter_map
      (fun (o, c) ->
        match (o.bvm_numeral, c.c_formulary) with
        | Some n, Some { MF.via = MF.Votive; _ } -> ignore n; None
        | Some n, other ->
            Some
              (Printf.sprintf "%s: Ordo shows %S Mass of BVM but colitur's via is %s" o.date n
                 (match other with
                 | Some f -> MF.source_to_string f.MF.via
                 | None -> "NONE"))
        | None, _ -> None)
      (List.combine ordo colitur)
  in
  Alcotest.(check (list string)) "every Ordo BVM numeral day is a colitur Votive day" [] mismatches

(* ---------------------------------------------------------------------- *)
(* Formulary override, restricted to Proper/Preceding_sunday/Common --     *)
(* see this file's own header for why Own_slug is excluded, and Votive is *)
(* covered by the BVM checks above instead. *)
(* ---------------------------------------------------------------------- *)

let test_formulary_override_by_source () =
  let ordo = ordo_rows () in
  let colitur = colitur_rows () in
  let pairs = List.combine ordo colitur in
  let counts = Hashtbl.create 8 in
  let bump k = Hashtbl.replace counts k (1 + try Hashtbl.find counts k with Not_found -> 0) in
  let bad = ref [] in
  List.iter
    (fun (o, c) ->
      match c.c_formulary with
      | Some { MF.via = MF.Proper; _ } ->
          bump "proper";
          if o.formulary_override <> None then
            bad := Printf.sprintf "%s: Proper day but Ordo shows override %s" o.date (Option.get o.formulary_override)
                    :: !bad
      | Some { MF.via = MF.Common; _ } ->
          bump "common";
          if o.formulary_override <> None then
            bad := Printf.sprintf "%s: Common day but Ordo shows override %s" o.date (Option.get o.formulary_override)
                    :: !bad
      | Some { MF.via = MF.Preceding_sunday; _ } ->
          bump "preceding_sunday";
          if o.formulary_override = None then bad := Printf.sprintf "%s: Preceding_sunday day but Ordo shows no override" o.date :: !bad
      | Some { MF.via = MF.Votive; _ } | Some { MF.via = MF.Own_slug; _ } | None -> ())
    pairs;
  Alcotest.(check (list string)) "no unexplained formulary-override mismatch on Proper/Common/Preceding_sunday days"
    [] (List.rev !bad);
  Alcotest.(check int) "179 Proper days in the window" 179 (try Hashtbl.find counts "proper" with Not_found -> 0);
  Alcotest.(check int) "2 Common days in the window" 2 (try Hashtbl.find counts "common" with Not_found -> 0);
  Alcotest.(check int) "66 Preceding_sunday days in the window" 66
    (try Hashtbl.find counts "preceding_sunday" with Not_found -> 0)

let test_via_distribution_totals_400 () =
  let colitur = colitur_rows () in
  let via_name c =
    match c.c_formulary with
    | None -> "none"
    | Some f -> MF.source_to_string f.MF.via
  in
  let counts = Hashtbl.create 8 in
  List.iter
    (fun c -> Hashtbl.replace counts (via_name c) (1 + try Hashtbl.find counts (via_name c) with Not_found -> 0))
    colitur;
  let total = Hashtbl.fold (fun _ n acc -> acc + n) counts 0 in
  Alcotest.(check int) "every via bucket sums to the full 400-day window" 400 total

let suite =
  ( "lms-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 Good Friday 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;
      Alcotest.test_case "every BVM-Saturday numeral matches its season" `Quick test_bvm_seasonal_selection;
      Alcotest.test_case "every Ordo BVM numeral day is a colitur Votive day" `Quick
        test_bvm_numeral_implies_votive;
      Alcotest.test_case "formulary override matches on Proper/Common/Preceding_sunday days" `Quick
        test_formulary_override_by_source;
      Alcotest.test_case "the via distribution sums to the full window" `Quick test_via_distribution_totals_400
    ] )