path: root/test/test_precedence_of.ml

(* Table-driven, one Alcotest case per Tabula entry, so a transcription error
   names the entry it broke. Mirrors test/test_precedence_ef.ml. *)
open Colitur_kernel
module Vocab_of = Rite_of.Vocab_of

let mk_cel ?(layer = Rite_of.Precedence_of.universal_layer)
    ?(status = Celebration.Feast) ?(colour = Colour.White)
    ?(subject = Subject.Saint) ~slug ~rank () =
  { Celebration.slug = Slug.of_string_exn slug;
    names = Names.empty; rank; status; colour; subject;
    citations = []; layer }

let mk ?layer ?status ?colour ?subject ~slug ~rank ~origin () =
  { Precedence.cel = mk_cel ?layer ?status ?colour ?subject ~slug ~rank ();
    origin }

let ctx ~iso ~season =
  let date = Date.of_iso8601 iso |> Result.get_ok in
  { Precedence.date; season; weekday = Date.weekday date }

(* Each row: label, context, candidate, expected band value. *)
let part1_cases =
  [ ( "entry 1: Good Friday",
      ctx ~iso:"2026-04-03" ~season:Vocab_of.Lent,
      mk ~slug:"of-lent-6-friday" ~rank:Vocab_of.Feria ~origin:Precedence.Temporal (),
      10 );
    ( "entry 1: Holy Saturday",
      ctx ~iso:"2026-04-04" ~season:Vocab_of.Lent,
      mk ~slug:"of-lent-6-saturday" ~rank:Vocab_of.Feria ~origin:Precedence.Temporal (),
      10 );
    ( "entry 1: Easter Sunday",
      ctx ~iso:"2026-04-05" ~season:Vocab_of.Easter,
      mk ~slug:"of-easter-sunday" ~rank:Vocab_of.Sollemnitas ~origin:Precedence.Temporal (),
      10 );
    ( "entry 2: Holy Thursday is a Holy Week feria, not the Triduum",
      ctx ~iso:"2026-04-02" ~season:Vocab_of.Lent,
      mk ~slug:"of-lent-6-thursday" ~rank:Vocab_of.Feria ~origin:Precedence.Temporal (),
      20 );
    ( "entry 2: the Nativity",
      ctx ~iso:"2026-12-25" ~season:Vocab_of.Christmas,
      mk ~slug:"of-nativity" ~rank:Vocab_of.Sollemnitas ~origin:Precedence.Temporal (),
      20 );
    ( "entry 2: a Sunday of Advent",
      ctx ~iso:"2026-11-29" ~season:Vocab_of.Advent,
      mk ~slug:"of-advent-sunday-1" ~rank:Vocab_of.Sollemnitas ~origin:Precedence.Temporal (),
      20 );
    ( "entry 2: Ash Wednesday",
      ctx ~iso:"2026-02-18" ~season:Vocab_of.Lent,
      mk ~slug:"of-ash-wednesday" ~rank:Vocab_of.Feria ~origin:Precedence.Temporal (),
      20 );
    ( "entry 2: a day within the Octave of Easter",
      ctx ~iso:"2026-04-07" ~season:Vocab_of.Easter,
      mk ~slug:"of-easter-octave-day-3" ~rank:Vocab_of.Sollemnitas ~origin:Precedence.Temporal (),
      20 );
    ( "entry 3: a universal solemnity of a saint",
      ctx ~iso:"2026-06-29" ~season:Vocab_of.Ordinary_time,
      mk ~slug:"of-peter-and-paul" ~rank:Vocab_of.Sollemnitas ~origin:Precedence.Sanctoral (),
      30 );
    ( "entry 4: a proper solemnity",
      ctx ~iso:"2026-06-29" ~season:Vocab_of.Ordinary_time,
      mk ~layer:"proper:diocese-of-poznan" ~slug:"of-local-patron"
        ~rank:Vocab_of.Sollemnitas ~origin:Precedence.Sanctoral (),
      40 ) ]

let test_part1 () =
  List.iter
    (fun (label, c, cand, expected) ->
      Alcotest.(check int) label expected (Rite_of.Precedence_of.band c cand))
    part1_cases

let part2_cases =
  [ ( "entry 5: a universal feast of the Lord",
      ctx ~iso:"2026-08-06" ~season:Vocab_of.Ordinary_time,
      mk ~subject:Subject.Lord ~slug:"of-transfiguration" ~rank:Vocab_of.Festum
        ~origin:Precedence.Sanctoral (),
      50 );
    ( "entry 6: a Sunday per annum",
      ctx ~iso:"2026-07-12" ~season:Vocab_of.Ordinary_time,
      (* rank is Festum, not the brief's original Sollemnitas: a real Sunday
         per annum is never Sollemnitas (temporal_of.ml only grades Advent,
         Lent and Easter Sundays that way, and those are entry 2, tested
         before this one), and a Sollemnitas candidate here would hit entry 3
         first regardless of layer -- the brief's own adjacent "Sunday of
         Christmas time" row already uses Festum for the identical reason. *)
      mk ~slug:"of-ordinary-time-sunday-15" ~rank:Vocab_of.Festum
        ~origin:Precedence.Temporal (),
      60 );
    ( "entry 6: a Sunday of Christmas time",
      ctx ~iso:"2027-01-03" ~season:Vocab_of.Christmas,
      mk ~slug:"of-christmas-sunday-2" ~rank:Vocab_of.Festum
        ~origin:Precedence.Temporal (),
      60 );
    ( "entry 7: a universal feast of a saint",
      ctx ~iso:"2026-04-25" ~season:Vocab_of.Easter,
      mk ~subject:Subject.Saint ~slug:"of-mark" ~rank:Vocab_of.Festum
        ~origin:Precedence.Sanctoral (),
      70 );
    ( "entry 7: a universal feast of the BVM",
      ctx ~iso:"2026-05-31" ~season:Vocab_of.Ordinary_time,
      mk ~subject:Subject.Bvm ~slug:"of-visitation" ~rank:Vocab_of.Festum
        ~origin:Precedence.Sanctoral (),
      70 );
    ( "entry 8: a proper feast",
      ctx ~iso:"2026-04-25" ~season:Vocab_of.Easter,
      mk ~layer:"proper:diocese-of-poznan" ~slug:"of-cathedral-dedication"
        ~rank:Vocab_of.Festum ~origin:Precedence.Sanctoral (),
      80 );
    ( "entry 9: an Advent feria on 17 December",
      ctx ~iso:"2026-12-17" ~season:Vocab_of.Advent,
      mk ~slug:"of-advent-3-thursday" ~rank:Vocab_of.Feria
        ~origin:Precedence.Temporal (),
      90 );
    ( "entry 9: a day within the Octave of the Nativity",
      ctx ~iso:"2026-12-29" ~season:Vocab_of.Christmas,
      mk ~slug:"of-christmas-0-tuesday" ~rank:Vocab_of.Feria
        ~origin:Precedence.Temporal (),
      90 );
    ( "entry 9: a Lenten feria",
      ctx ~iso:"2026-03-03" ~season:Vocab_of.Lent,
      mk ~slug:"of-lent-2-tuesday" ~rank:Vocab_of.Feria
        ~origin:Precedence.Temporal (),
      90 );
    (* MY RULING (2026-08-25, task-2-brief correction): every temporal-origin
       celebration Temporal_of.temporal constructs carries [layer = "temporal"],
       never [Precedence_of.universal_layer] -- so entries 3, 5 and 7 must test
       [not (is_proper layer)], not [is_universal layer]. These four rows pin
       exactly what that correction fixes: without it, Corpus Christi comes out
       unclassified (a hole) and Trinity/Christ the King land at entry 6 instead
       of entry 3. *)
    ( "entry 3: Trinity Sunday is a solemnity of the general calendar",
      ctx ~iso:"2026-05-31" ~season:Vocab_of.Ordinary_time,
      mk ~slug:"of-trinity" ~rank:Vocab_of.Sollemnitas ~origin:Precedence.Temporal (),
      30 );
    ( "entry 3: Corpus Christi, a Thursday, is not unclassified",
      ctx ~iso:"2026-06-04" ~season:Vocab_of.Ordinary_time,
      mk ~slug:"of-corpus-christi" ~rank:Vocab_of.Sollemnitas ~origin:Precedence.Temporal (),
      30 );
    (* Fix round 1 (coordinator review, 2026-08-25). (a) THE TENSION: the
       Tabula's own entry 9 reads "Feriae Adventus a die 17 ad 24 decembris
       INCLUSIVE" -- 24 December is textually a late-Advent feria -- yet
       Phase 1's temporal_of.ml gives that civil day the identity
       [of-nativity-vigil] at rank Sollemnitas, because the Vigil Mass is
       celebrated that evening; at colitur's one-office-per-civil-day
       granularity only one identity can hold the day. (b) THE RESOLUTION:
       Phase 2 classifies whatever identity Phase 1 already chose to emit, it
       does not reach back and override that choice -- the same shape, and
       the same settlement, as Holy Thursday (entry 2, not entry 1) above.
       So this candidate's rank (Sollemnitas) and layer (temporal, hence
       [not (is_proper layer)]) correctly route it to entry 3, band 30, not
       entry 9's 90. (c) OBSERVABILITY: on the universal calendar nothing
       else competes for 24 December, so this value can never be OBSERVED
       today -- it is unobservable, not untested. It becomes live the moment
       a proper/diocesan overlay places a proper solemnity (entry 4, band 40)
       on 24 December: at 30 the Vigil beats it, but at the textually-arguable
       90 the proper solemnity would beat the Vigil instead. That reversal is
       exactly what this row guards against a silent branch-reorder. *)
    ( "entry 3, not 9: the Nativity Vigil is a solemnity, though 24 December \
       is also a late-Advent feria",
      ctx ~iso:"2026-12-24" ~season:Vocab_of.Advent,
      mk ~slug:"of-nativity-vigil" ~rank:Vocab_of.Sollemnitas
        ~origin:Precedence.Temporal (),
      30 );
    ( "entry 5: the Baptism of the Lord is a feast OF THE LORD",
      ctx ~iso:"2026-01-11" ~season:Vocab_of.Christmas,
      mk ~subject:Subject.Lord ~slug:"of-baptism-of-the-lord" ~rank:Vocab_of.Festum
        ~origin:Precedence.Temporal (),
      50 );
    ( "entry 6, not 5: an ordinary Christmas Sunday has no Lord subject",
      ctx ~iso:"2027-01-03" ~season:Vocab_of.Christmas,
      mk ~subject:Subject.Temporal ~slug:"of-christmas-sunday-2" ~rank:Vocab_of.Festum
        ~origin:Precedence.Temporal (),
      60 ) ]

let test_part2 () =
  List.iter
    (fun (label, c, cand, expected) ->
      Alcotest.(check int) label expected (Rite_of.Precedence_of.band c cand))
    part2_cases

let part3_cases =
  [ ( "entry 10: a universal obligatory memorial",
      ctx ~iso:"2026-01-21" ~season:Vocab_of.Ordinary_time,
      mk ~slug:"of-agnes" ~rank:Vocab_of.Memoria_obligatoria
        ~origin:Precedence.Sanctoral (),
      100 );
    ( "entry 11: a proper obligatory memorial",
      ctx ~iso:"2026-01-21" ~season:Vocab_of.Ordinary_time,
      mk ~layer:"proper:diocese-of-poznan" ~slug:"of-secondary-patron"
        ~rank:Vocab_of.Memoria_obligatoria ~origin:Precedence.Sanctoral (),
      110 );
    ( "entry 12: an optional memorial",
      ctx ~iso:"2026-01-13" ~season:Vocab_of.Ordinary_time,
      mk ~slug:"of-hilary" ~rank:Vocab_of.Memoria_ad_libitum
        ~origin:Precedence.Sanctoral (),
      120 );
    ( "entry 12: an optional memorial is entry 12 on a proper layer too",
      ctx ~iso:"2026-01-13" ~season:Vocab_of.Ordinary_time,
      mk ~layer:"proper:diocese-of-poznan" ~slug:"of-local-optional"
        ~rank:Vocab_of.Memoria_ad_libitum ~origin:Precedence.Sanctoral (),
      120 );
    ( "entry 13: an ordinary feria per annum",
      ctx ~iso:"2026-07-14" ~season:Vocab_of.Ordinary_time,
      mk ~slug:"of-ordinary-time-15-tuesday" ~rank:Vocab_of.Feria
        ~origin:Precedence.Temporal (),
      130 );
    ( "entry 13: a Christmas-time feria after 1 January",
      ctx ~iso:"2027-01-05" ~season:Vocab_of.Christmas,
      mk ~slug:"of-christmas-1-tuesday" ~rank:Vocab_of.Feria
        ~origin:Precedence.Temporal (),
      130 );
    ( "entry 13, not 9: an Advent feria on 16 December",
      ctx ~iso:"2026-12-16" ~season:Vocab_of.Advent,
      mk ~slug:"of-advent-3-wednesday" ~rank:Vocab_of.Feria
        ~origin:Precedence.Temporal (),
      130 );
    ( "entry 13: a paschal feria after the Octave",
      ctx ~iso:"2026-04-14" ~season:Vocab_of.Easter,
      mk ~slug:"of-easter-2-tuesday" ~rank:Vocab_of.Feria
        ~origin:Precedence.Temporal (),
      130 ) ]

let test_part3 () =
  List.iter
    (fun (label, c, cand, expected) ->
      Alcotest.(check int) label expected (Rite_of.Precedence_of.band c cand))
    part3_cases

(* The temporal candidate Temporal_of produces for [d], as Precedence.resolve
   would build it. *)
let temporal_candidate d =
  let t = Rite_of.Temporal_of.temporal d in
  { Precedence.cel = t.Temporal.office; origin = Precedence.Temporal }

let ctx_of_date d =
  let t = Rite_of.Temporal_of.temporal d in
  { Precedence.date = d; season = t.Temporal.season; weekday = Date.weekday d }

let band_of_date d = Rite_of.Precedence_of.band (ctx_of_date d) (temporal_candidate d)

(* Every day of a year: the temporal candidate must land on a real table
   entry, never [unclassified]. *)
let check_year y =
  let mk_date y m dd =
    Date.make ~year:y ~month:m ~day:dd |> Result.get_ok in
  let d = ref (mk_date y 1 1) in
  let last = mk_date y 12 31 in
  while Date.compare !d last <= 0 do
    let b = band_of_date !d in
    if b = Rite_of.Precedence_of.unclassified then
      Alcotest.failf "%s: temporal candidate is unclassified"
        (Date.to_iso8601 !d);
    d := Date.add_days !d 1
  done

let prop_band_total =
  QCheck.Test.make ~count:200 ~name:"band classifies every temporal candidate"
    (QCheck.int_range 1583 9999)
    (fun y -> check_year y; true)

let test_exhaustive_band_total () =
  if Sys.getenv_opt "COLITUR_EXHAUSTIVE_SWEEP" = None then
    Alcotest.skip ()
  else for y = 1583 to 9999 do check_year y done

let disposition_cases =
  [ ( "a losing solemnity transfers (Normae n. 60)",
      mk ~slug:"of-advent-sunday-2" ~rank:Vocab_of.Sollemnitas ~origin:Precedence.Temporal (),
      mk ~slug:"of-immaculate-conception" ~rank:Vocab_of.Sollemnitas ~origin:Precedence.Sanctoral (),
      Precedence.Transfer );
    ( "a losing feast is omitted, never commemorated",
      mk ~slug:"of-lent-sunday-3" ~rank:Vocab_of.Sollemnitas ~origin:Precedence.Temporal (),
      mk ~slug:"of-mark" ~rank:Vocab_of.Festum ~origin:Precedence.Sanctoral (),
      Precedence.Omit );
    ( "a losing obligatory memorial is omitted",
      mk ~slug:"of-lent-2-monday" ~rank:Vocab_of.Feria ~origin:Precedence.Temporal (),
      mk ~slug:"of-agnes" ~rank:Vocab_of.Memoria_obligatoria ~origin:Precedence.Sanctoral (),
      Precedence.Omit );
    ( "a losing optional memorial is omitted",
      mk ~slug:"of-ordinary-time-15-tuesday" ~rank:Vocab_of.Feria ~origin:Precedence.Temporal (),
      mk ~slug:"of-hilary" ~rank:Vocab_of.Memoria_ad_libitum ~origin:Precedence.Sanctoral (),
      Precedence.Omit );
    ( "a losing feria is omitted",
      mk ~slug:"of-peter-and-paul" ~rank:Vocab_of.Sollemnitas ~origin:Precedence.Sanctoral (),
      mk ~slug:"of-ordinary-time-13-monday" ~rank:Vocab_of.Feria ~origin:Precedence.Temporal (),
      Precedence.Omit ) ]

let test_disposition () =
  List.iter
    (fun (label, winner, loser, expected) ->
      Alcotest.(check string) label
        (Precedence.sexp_of_disposition expected |> Sexplib0.Sexp.to_string)
        (Rite_of.Precedence_of.disposition ~winner ~loser
        |> Precedence.sexp_of_disposition |> Sexplib0.Sexp.to_string))
    disposition_cases

(* The rule stated as a property rather than as five rows: across every
   rank/rank pairing, disposition returns Transfer exactly when the loser is a
   solemnity, and Omit otherwise -- never Commemorate, never Repose. *)
let test_disposition_never_commemorates () =
  List.iter
    (fun lr ->
      List.iter
        (fun wr ->
          let winner = mk ~slug:"of-winner" ~rank:wr ~origin:Precedence.Temporal () in
          let loser = mk ~slug:"of-loser" ~rank:lr ~origin:Precedence.Sanctoral () in
          match Rite_of.Precedence_of.disposition ~winner ~loser with
          | Precedence.Transfer ->
              Alcotest.(check bool) "only a solemnity transfers" true
                (lr = Vocab_of.Sollemnitas)
          | Precedence.Omit ->
              Alcotest.(check bool) "a solemnity never merely omits" false
                (lr = Vocab_of.Sollemnitas)
          | Precedence.Commemorate _ ->
              Alcotest.fail "OF has no commemorations (Normae n. 60)"
          | Precedence.Repose -> Alcotest.fail "OF never reposes a celebration")
        Vocab_of.ranks)
    Vocab_of.ranks

let test_admit_is_always_empty () =
  let cand slug rank =
    mk ~slug ~rank ~origin:Precedence.Sanctoral () in
  let observed = cand "of-winner" Vocab_of.Sollemnitas in
  let temporal = cand "of-feria" Vocab_of.Feria in
  let losers =
    [ (cand "of-a" Vocab_of.Festum, Precedence.Ordinary, 70);
      (cand "of-b" Vocab_of.Memoria_obligatoria, Precedence.Privileged, 100) ] in
  Alcotest.(check int) "nothing is ever admitted" 0
    (List.length (Rite_of.Precedence_of.admit ~observed ~temporal losers))

let test_vigil_feast_is_always_none () =
  List.iter
    (fun slug ->
      let c = mk ~slug ~rank:Vocab_of.Sollemnitas ~origin:Precedence.Sanctoral () in
      Alcotest.(check bool)
        (Printf.sprintf "%s has no vigil-feast link" slug)
        true
        (Rite_of.Precedence_of.vigil_feast c = None))
    [ "of-nativity-vigil"; "of-nativity"; "of-pentecost"; "of-peter-and-paul" ]

let suite =
  ( "precedence-of",
    [ Alcotest.test_case "Tabula part I (entries 1-4)" `Quick test_part1;
      Alcotest.test_case "Tabula part II (entries 5-9)" `Quick test_part2;
      Alcotest.test_case "Tabula part III (entries 10-13)" `Quick test_part3;
      Alcotest.test_case "band is total over the domain" `Slow test_exhaustive_band_total;
      Alcotest.test_case "disposition (Normae n. 60)" `Quick test_disposition;
      Alcotest.test_case "disposition never commemorates" `Quick test_disposition_never_commemorates;
      Alcotest.test_case "admit is always empty" `Quick test_admit_is_always_empty;
      Alcotest.test_case "vigil_feast is always none" `Quick test_vigil_feast_is_always_none ]
    @ List.map QCheck_alcotest.to_alcotest [ prop_band_total ] )