path: root/test/test_differential.ml

(* Task 15: differential harness vs lectio (sibling project, Go), EF only,
   2005-2050 -- validation layer 3 of the design spec's five (colitur CLAUDE.md
   "Validation" section; layers 1-2, Types and Property, are already built and
   green). lectio's own EF stream is committed as a fixture
   (test/fixtures/lectio-ef-2005-2050.txt, provenance -- including the
   SHA-256 this file's own [test_fixture_checksum] asserts, so a hand-edit or
   partial re-copy of the fixture fails loudly rather than silently becoming
   an unlabelled snapshot -- in the sibling .provenance file next to it);
   colitur's side is recomputed fresh from this library on every run, through
   the SAME pipeline `colitur day` uses (Colitur_kernel.Calendar over the
   real data/ef/sanctoral.sexp + adjustments.sexp), not the compiled binary.

   *** THREE STATED LIMITS THIS COMPARATOR DOES NOT PRETEND TO EXCEED ***

   1. Commemorations are NOT compared. lectio's trailing "+other-slug" tokens
      are the LOSING sanctoral candidates for the day (its own dumper's doc
      comment says so), not an RG 111 admitted set -- lectio has no RG 111
      admission logic at all. Comparing that column would compare colitur's
      real admitted commemorations against lectio's rejects, which proves
      nothing. Only the seven leading columns (date weekday season week slug
      rank colour) are read from either stream.

   2. lectio's own EF oracle test (~/git/projects/lectio,
      internal/calendar/oracle_ef_test.go) asserts ONLY season, strictly,
      against missalemeum, and ONLY for 2025-2026. Rank and colour are logged
      there, never asserted. So lectio's advertised "0-error vs references
      2005-2050" covers season-exactness for the EF, not full-row-exactness.
      A rank or colour difference below is therefore NOT presumptive evidence
      that colitur is wrong -- every one is adjudicated against the Missal/RG
      register directly (data/ef/expected-divergences.sexp), never against
      lectio's say-so. (Layer 4, the oracle differential against missalemeum
      itself, is what actually validates rank and colour; that is a later
      task.)

   3. The WEEK column is not compared, at all, on either side. Two reasons,
      both confirmed by reading lectio's own source
      (cmd/lectio-ef-dump/main.go's doc comment): first, lectio prints week
      "0" (rendered "-") "where no season week applies, e.g. named I class
      feasts and per annum green-season ferias" -- an internal DISPLAY
      convention of lectio's, not a liturgical fact, so there is nothing to
      cross-check it against. Second, even where both sides print a real
      number, the two engines anchor Time-after-Epiphany week numbering
      differently (colitur: the first Sunday on/after Epiphany; lectio: a
      fixed offset from 6 January -- register §3c item 5) and the offset
      between them is NOT constant (it depends on which weekday 6 January
      falls on, and re-synchronises mid-season), so no clean formula-based
      check is possible without reimplementing lectio's own algorithm here.
      Slug identity, rank and colour -- where the real liturgical substance
      lives -- remain fully and separately compared; only the bare integer
      is out of scope. See the report for the concrete rows this weakens.

   *** THE THREE-LAYER DESIGN (controller ruling, Task 15 dispatch) ***

   Of 16801 day-pairs (2005-2050), 11206 already match on the seven columns.
   Of the 5595 that don't, exactly 25 distinct (field-diff) signatures cover
   all of them (task-15-class-summary.txt). They resolve into three strictly
   separate layers:

   - Layer A (this file's [norm_season]/[norm_slug]): vocabulary. A
     declarative, explicit, closed table of naming synonyms that carry no
     liturgical substance -- lectio's "easter"/"christmas" ARE colitur's
     "paschaltide"/"christmastide"; a handful of slugs are two different
     engines' names for the identical office (Christmas Vigil, Holy Name
     Sunday, the Pentecost-octave Ember days, the two Passiontide weeks).
     Every entry is a literal string pair, never a pattern -- widening this
     to a wildcard is exactly how a real bug would get hidden, so it is not
     done even where it would shorten the table.

   - Layer B ([strip_epiphany_index]): numbering. The ONE case in the whole
     5595 where a slug's embedded index genuinely cannot be reconciled by a
     literal table (Time-after-Epiphany's non-constant offset, limit 3
     above) -- both sides' embedded week digit is stripped to a common
     family+weekday form before comparing, while rank and colour (which
     carry no week-index information for an ordinary green-season
     feria/Sunday) remain fully compared, so a genuine identity bug in this
     family would still be caught by everything except the digit itself.

   - Layer C (data/ef/expected-divergences.sexp, matched by
     [layer_c_reason] below): the CITED allow-list. Ten genuine liturgical
     disagreements, each citing its RG paragraph and stating which engine is
     right (always colitur, verified against the Missal/register, never
     against lectio's own behaviour -- "lectio does it differently" is not
     itself a justification anywhere in this file). This is the ONLY layer
     that may cover a difference in rank, colour, or which celebration is
     observed; A and B never do (enforced structurally below: A/B only ever
     touch the season/slug fields, and Layer C's predicates each require an
     exact, narrow field-diff SET, not "anything goes").

   13 January (register §6's long-open "Baptism of the Lord" item) is
   EMPIRICALLY CONFIRMED FIXED, not allow-listed: colitur's slug/rank/colour
   for 13 January already equal lectio's exactly, in all 46 years (the
   sanctoral wiring landed in Task 11's "13 Jan now resolves to the Baptism
   of the Lord" review note). The only residual difference there is season
   (covered by Layer C's C1, the Jan 6-13 boundary) -- see the report. *)

module Cal = Colitur_kernel.Calendar
module Layer = Colitur_kernel.Layer
module Overlay = Colitur_kernel.Overlay
module LD = Colitur_kernel.Liturgical_day
module Slug = Colitur_kernel.Slug
module Date = Colitur_kernel.Date
module Cel = Colitur_kernel.Celebration
module Colour = Colitur_kernel.Colour
module V = Rite_ef.Vocab_ef

(* Same relative paths test_rite_ef.ml/test_sanctoral_ef.ml use: dune test
   runs from _build/default/test/. *)
let sanctoral_path = "../data/ef/sanctoral.sexp"
let adjustments_path = "../data/ef/adjustments.sexp"
let fixture_path = "fixtures/lectio-ef-2005-2050.txt"
let allow_list_path = "../data/ef/expected-divergences.sexp"

(* The fixture's own provenance note (test/fixtures/lectio-ef-2005-2050.provenance)
   records this same digest, so it is discoverable by a reader who never runs
   the suite. Recorded here too, and ASSERTED (fix round 1, finding 4): a
   provenance note is enough to REGENERATE the fixture but says nothing about
   whether the committed bytes still match the commit they claim to come
   from -- an unnoticed hand-edit or partial re-copy would silently turn the
   whole oracle into an unlabelled snapshot of whatever someone last ran.
   Regenerate this constant (and the provenance note's copy) together,
   deliberately, after re-running the exact command the provenance note
   names -- never by copying the actual value back in to make a mismatch
   pass, which would defeat the point of pinning it at all. *)
let fixture_sha256 = "2ca3eeeda4e7a0406c4d004c1b2003fc0df671aca9af18a1b506543a721c8bac"

(* Same technique tools/bootstrap_sanctoral.ml already uses for this exact
   purpose (that file's own comment: shelling out to the system's
   [sha256sum], not an OCaml crypto library -- Task 15's deps are frozen).
   Unlike that tool, this avoids even the (already-permitted, per that
   file's own comment, "already in the switch") [unix] library: [Sys.command]
   plus a redirected-to-file capture needs nothing beyond the Stdlib every
   dune executable already links. Depends on [sha256sum] being on PATH,
   which every environment this suite has actually run in (Debian, per
   CLAUDE.md) provides via coreutils; a machine without it fails this check
   with a command-not-found exit code rather than silently skipping it. *)
let sha256_of_file path =
  let tmp = Filename.temp_file "colitur_differential_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

(* --- The seven-column row both streams share (commemorations excluded, --- *)
(* limit 1 above). *)
type row = {
  date : string;
  weekday : string;
  season : string;
  week : string;
  slug : string;
  rank : string;
  colour : string;
}

let read_lines path =
  let ic = open_in path in
  let rec loop acc =
    match input_line ic with
    | line -> loop (line :: acc)
    | exception End_of_file ->
        close_in ic;
        List.rev acc
  in
  loop []

let row_of_line line =
  match String.split_on_char ' ' line with
  | date :: weekday :: season :: week :: slug :: rank :: colour :: _others ->
      { date; weekday; season; week; slug; rank; colour }
  | _ -> Alcotest.failf "malformed fixture line (fewer than 7 fields): %S" line

let lectio_rows () = List.map row_of_line (read_lines fixture_path)

(* Recomputes colitur's day-by-day output straight from the library --
   exactly [Colitur_kernel.Calendar.year] + [Rite_ef.context] over the real
   committed data, the same pipeline bin/main.ml's `colitur day` runs (that
   file's own [day_report]/[day_line] comments explain the two-liturgical-
   year-per-civil-year indexing this mirrors). Duplicated here rather than
   shared with bin/main.ml (an executable, not a library) -- the same choice
   test_rite_ef.ml already made for [real_layer] above. *)
let colitur_rows_2005_2050 () =
  let layer = real_layer () in
  let by_rata : (int, (V.season, V.rank) LD.t) Hashtbl.t = Hashtbl.create 20000 in
  for y = 2004 to 2050 do
    let days = Cal.year Rite_ef.context 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
  for y = 2005 to 2050 do
    let d = ref (mk y 1 1) in
    let stop = mk y 12 31 in
    while Date.compare !d stop <= 0 do
      (match Hashtbl.find_opt by_rata (Date.to_rata !d) with
      | Some day ->
          let t = day.LD.temporal in
          let cel = day.LD.observed in
          let week =
            match t.Colitur_kernel.Temporal.week with Some n -> string_of_int n | None -> "-"
          in
          rows :=
            { date = Date.to_iso8601 day.LD.date;
              weekday = Date.weekday_to_string t.Colitur_kernel.Temporal.weekday;
              season = V.season_to_string t.Colitur_kernel.Temporal.season;
              week;
              slug = Slug.to_string cel.Cel.slug;
              rank = V.rank_to_string cel.Cel.rank;
              colour = Colour.to_string cel.Cel.colour
            }
            :: !rows
      | None -> Alcotest.failf "internal error: no resolved day for %s" (Date.to_iso8601 !d));
      d := Date.add_days !d 1
    done
  done;
  List.rev !rows

(* ---------------------------------------------------------------------- *)
(* Layer A: vocabulary. Explicit, closed tables; no wildcards, no pattern  *)
(* matching against arbitrary content -- every case below is a literal    *)
(* string compared against a literal string.                             *)
(* ---------------------------------------------------------------------- *)

(* lectio's season word -> colitur's season word. The ONLY two seasons that
   are spelled differently; every other season word is shared verbatim
   (both call Advent "advent", Lent "lent", etc.). *)
let norm_season = function
  | "easter" -> "paschaltide"
  | "christmas" -> "christmastide"
  | s -> s

let weekdays = [ "monday"; "tuesday"; "wednesday"; "thursday"; "friday"; "saturday" ]

(* lectio's slug -> the colitur slug for the SAME office, where the two
   projects simply chose different names. [month]/[lectio_rank] disambiguate
   the two cases where lectio reuses one slug for what colitur names two
   different ways (see each branch's own comment). *)
let rec norm_slug ~month ~lectio_rank slug =
  if String.equal slug "vigil-of-christmas" then "ef-nativity-vigil"
    (* register §6: lectio names its vigils "vigil-of-X" (prefix); colitur's
       own convention is "X-vigil" (suffix). Same celebration -- confirmed a
       genuine duplicate in Task 11, where colitur's overlay suppresses
       lectio's key entirely from the sanctoral layer. *)
  else if
    (* "ef-christmas-sunday-0"/"ef-christmas-0-<weekday>" mean TWO different
       things in lectio depending on which window they fall in: the Sunday
       within Holy Name week (2-5 January, colitur's own named feast) or an
       ordinary day within the Nativity Octave (26-31 December, where colitur
       uses its own ef-nativity-octave-day-N naming instead, Layer C's C6 --
       that window keeps a genuine RANK difference too, so it must not be
       absorbed here). Gating on [month = 1] keeps this table from ever
       touching the December occurrence. *)
    month = 1
  then
    if String.equal slug "ef-christmas-sunday-0" then "ef-holy-name-sunday"
    else
      match List.find_opt (fun wd -> String.equal slug ("ef-christmas-0-" ^ wd)) weekdays with
      | Some wd -> "ef-christmas-1-" ^ wd
      | None -> norm_slug_rest ~lectio_rank slug
  else norm_slug_rest ~lectio_rank slug

and norm_slug_rest ~lectio_rank slug =
  (* Passiontide: lectio never distinguishes Passion week (colitur's week 1,
     class-3 ferias) from Holy week (colitur's week 2, class-1 ferias) in the
     slug -- both print "ef-passiontide-0-<weekday>". Rank, independently and
     strictly compared elsewhere, is what actually tells the two weeks apart
     (RG 91 entries 22 vs 2/7), so using it here to pick the expected colitur
     digit does not launder away a genuine identity bug: a colitur bug that
     mixed up the two weeks would, on the evidence available in this stream,
     also very likely show up as a rank mismatch of its own. *)
  match List.find_opt (fun wd -> String.equal slug ("ef-passiontide-0-" ^ wd)) weekdays with
  | Some wd -> (
      match lectio_rank with
      | "class-3" -> "ef-passiontide-1-" ^ wd
      | "class-1" -> "ef-passiontide-2-" ^ wd
      | _ -> slug)
  | None -> (
      match slug with
      | "ef-easter-8-wednesday" -> "ef-pentecost-ember-wed"
      | "ef-easter-8-friday" -> "ef-pentecost-ember-fri"
      | "ef-easter-8-saturday" -> "ef-pentecost-ember-sat"
      | s -> s)

(* ---------------------------------------------------------------------- *)
(* Layer B: numbering (register §3c item 5). The Time-after-Epiphany       *)
(* week-index embedded in a slug is stripped to a common form on BOTH     *)
(* sides before comparing -- see limit 3 in this file's header comment    *)
(* for why a table (Layer A's tool) cannot do this instead.               *)
(* ---------------------------------------------------------------------- *)

let starts_with ~prefix s =
  let lp = String.length prefix in
  String.length s >= lp && String.equal (String.sub s 0 lp) prefix

let is_digit_string s = s <> "" && String.for_all (fun c -> c >= '0' && c <= '9') s

let strip_epiphany_index slug =
  let prefix = "ef-time-after-epiphany-" in
  if not (starts_with ~prefix slug) then slug
  else
    let rest = String.sub slug (String.length prefix) (String.length slug - String.length prefix) in
    match String.index_opt rest '-' with
    | None -> slug
    | Some i ->
        let left = String.sub rest 0 i in
        let right = String.sub rest (i + 1) (String.length rest - i - 1) in
        if is_digit_string left && List.mem right weekdays then prefix ^ right
        else if String.equal left "sunday" && is_digit_string right then prefix ^ "sunday"
        else slug

(* ---------------------------------------------------------------------- *)
(* Field-diff computation: applies Layers A and B, then reports exactly   *)
(* which of the FIVE substantive columns still differ (week is never      *)
(* inspected at all -- limit 3). weekday is included defensively: dates   *)
(* are checked 1:1 aligned before this runs, so it should never fire, and *)
(* if it ever does that is real signal, not noise to normalise away.      *)
(* ---------------------------------------------------------------------- *)

type field = Weekday | Season | Slug_f | Rank | Colour_f

let field_name = function
  | Weekday -> "weekday"
  | Season -> "season"
  | Slug_f -> "slug"
  | Rank -> "rank"
  | Colour_f -> "colour"

let month_of_date date = int_of_string (String.sub date 5 2)

let diff_fields (l : row) (c : row) =
  let m = month_of_date l.date in
  let l_season = norm_season l.season in
  let l_slug = strip_epiphany_index (norm_slug ~month:m ~lectio_rank:l.rank l.slug) in
  let c_slug = strip_epiphany_index c.slug in
  List.filter_map
    (fun x -> x)
    [ (if String.equal l.weekday c.weekday then None else Some Weekday);
      (if String.equal l_season c.season then None else Some Season);
      (if String.equal l_slug c_slug then None else Some Slug_f);
      (if String.equal l.rank c.rank then None else Some Rank);
      (if String.equal l.colour c.colour then None else Some Colour_f)
    ]

(* ---------------------------------------------------------------------- *)
(* Layer C: the cited allow-list (data/ef/expected-divergences.sexp).     *)
(* Each predicate below names the [id] it matches; the sexp file carries  *)
(* that id's citation, verdict and expected row count. A predicate fires  *)
(* only on an EXACT, narrow field-diff set -- never "any difference at    *)
(* all" -- so it cannot silently absorb a difference outside what its own *)
(* citation actually explains.                                            *)
(* ---------------------------------------------------------------------- *)

let subset xs ys = List.for_all (fun x -> List.mem x ys) xs
let day_of_date date = int_of_string (String.sub date 8 2)

let advent_feria_slug slug =
  List.exists
    (fun wk -> List.exists (fun wd -> String.equal slug (Printf.sprintf "ef-advent-%d-%s" wk wd)) weekdays)
    [ 3; 4 ]

let sunday_iclass_slugs =
  [ "ef-advent-sunday-2"; "ef-advent-sunday-4"; "ef-lent-sunday-1"; "ef-lent-sunday-2"; "ef-lent-sunday-3" ]

let rose_sunday_slugs = [ "ef-advent-sunday-3"; "ef-lent-sunday-4" ]

(* Fix round 1, finding 1: C1 and C6 (below) originally gated on calendar
   date alone, with no slug/slug-family check -- unlike every other entry
   here. The reviewer constructed the failure this leaves open: if a future
   sanctoral regeneration made some OTHER 29-31 December celebration win the
   day (colliding coincidentally with C6's own [Slug_f; Rank] diff shape),
   it would be silently absorbed under "RG 91 entry 17, Nativity Octave" --
   a citation that has nothing to do with the real cause. [subset diffs
   [...]] alone was never enough; the SLUG that actually won must also be
   the one each citation is about. Both lists below are exact literals (the
   Nativity Octave's three colitur-only day slugs; the closed set of
   offices that can legitimately observe C1's Jan 6-13 window), not
   patterns -- a slug outside them fails through to [None] instead of being
   absorbed. *)
let jan_6_13_slug slug =
  String.equal slug "ef-epiphany"
  || String.equal slug "commemoration-of-the-baptism-of-the-lord"
  || List.exists (fun wd -> String.equal slug ("ef-christmas-2-" ^ wd)) weekdays

let nativity_octave_day_slugs =
  [ "ef-nativity-octave-day-5"; "ef-nativity-octave-day-6"; "ef-nativity-octave-day-7" ]

(* [layer_c_reason l c diffs] returns the [data/ef/expected-divergences.sexp]
   [id] this row-pair's remaining (post Layer A/B) diff set belongs to, or
   [None] if nothing here explains it (a genuine, uncovered failure). *)
let layer_c_reason (l : row) (c : row) diffs =
  let m = month_of_date l.date and d = day_of_date l.date in
  if diffs = [] then None
  else if
    m = 1 && d >= 6 && d <= 13
    && subset diffs [ Season; Colour_f; Slug_f ]
    && (not (List.mem Slug_f diffs) || jan_6_13_slug c.slug)
  then Some "C1"
  else if List.mem c.slug sunday_iclass_slugs && diffs = [ Rank ] then Some "C2"
  else if List.mem c.slug rose_sunday_slugs && subset diffs [ Rank; Colour_f ] then Some "C3"
  else if advent_feria_slug c.slug && diffs = [ Rank ] then Some "C4"
  else if starts_with ~prefix:"ef-lent-ember-" c.slug && subset diffs [ Slug_f; Rank ] then Some "C5"
  else if
    m = 12
    && (d = 29 || d = 30 || d = 31)
    && subset diffs [ Slug_f; Rank ]
    && (not (List.mem Slug_f diffs) || List.mem c.slug nativity_octave_day_slugs)
  then Some "C6"
  else if (String.equal c.slug "matthew" || String.equal c.slug "thomas") && subset diffs [ Slug_f; Colour_f ]
  then Some "C7"
  else if
    (String.equal c.slug "ef-rogation-monday" || String.equal c.slug "ef-rogation-tuesday")
    && subset diffs [ Season; Slug_f; Colour_f ]
  then Some "C8"
  else if
    (String.equal l.slug "joseph-spouse-of-the-bl-virgin-mary"
    || String.equal c.slug "joseph-spouse-of-the-bl-virgin-mary")
    && subset diffs [ Season; Slug_f; Rank; Colour_f ]
  then Some "C9"
  else if
    (String.equal l.date "2011-07-02" || String.equal l.date "2011-07-04")
    && subset diffs [ Slug_f; Rank; Colour_f ]
  then Some "C10"
  else None

(* ---------------------------------------------------------------------- *)
(* data/ef/expected-divergences.sexp loading -- a plain sequence of        *)
(* top-level records (not one wrapping list: see the file's own header). *)
(* ---------------------------------------------------------------------- *)

open Sexplib0.Sexp_conv

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

(* ---------------------------------------------------------------------- *)
(* The comparison itself, run once and shared by every test case below   *)
(* (Alcotest test cases are independent processes-in-a-list, not free to  *)
(* share mutable state across a suite, so this recomputes per call --     *)
(* acceptable: colitur's own 1583-9999 property sweep runs orders of      *)
(* magnitude more days in tens of seconds, and this is 16801 civil days,  *)
(* once per test case, twice total). *)
(* ---------------------------------------------------------------------- *)

type outcome = Matched | Explained of string | Unexplained of field list

let compare_streams () =
  let lectio = lectio_rows () in
  let colitur = colitur_rows_2005_2050 () in
  (lectio, colitur)

let classify lectio colitur =
  List.map2
    (fun (l : row) (c : row) ->
      if not (String.equal l.date c.date) then
        Alcotest.failf "streams misaligned: lectio %s vs colitur %s" l.date c.date;
      let diffs = diff_fields l c in
      if diffs = [] then (l, c, Matched)
      else
        match layer_c_reason l c diffs with
        | Some id -> (l, c, Explained id)
        | None -> (l, c, Unexplained diffs))
    lectio colitur

let describe_unexplained (l : row) (c : row) diffs =
  Printf.sprintf "%s: %s differ -- lectio=(%s %s %s %s %s) colitur=(%s %s %s %s %s)" l.date
    (String.concat "," (List.map field_name diffs))
    l.weekday l.season l.slug l.rank l.colour c.weekday c.season c.slug c.rank c.colour

(* Fix round 1, finding 4: the fixture's own byte content must still match
   the SHA-256 its provenance note claims (lectio commit 2386a45, recorded
   both here and in test/fixtures/lectio-ef-2005-2050.provenance). Checked
   before anything else reads the fixture -- a drifted fixture makes every
   other assertion in this suite a statement about an unlabelled snapshot,
   not about the pinned lectio commit it claims to be. *)
let test_fixture_checksum () =
  Alcotest.(check string) "fixture SHA-256 matches its provenance note" fixture_sha256
    (sha256_of_file fixture_path)

(* Dates align 1:1 in the same order on both streams (both are one line per
   civil day, 2005-01-01..2050-12-31 -- see the fixture's own provenance
   note and [colitur_rows_2005_2050]'s construction). A silent misalignment
   would make every subsequent comparison meaningless -- checked first, on
   its own, rather than trusted. *)
let test_dates_align () =
  let lectio, colitur = compare_streams () in
  Alcotest.(check int) "both streams have 16801 rows (46*365 + 11 leap days)" 16801 (List.length lectio);
  Alcotest.(check int) "colitur recomputed the same number of rows" (List.length lectio) (List.length colitur);
  let mismatched =
    List.filter_map
      (fun (l, c) -> if String.equal l.date c.date then None else Some (l.date, c.date))
      (List.combine lectio colitur)
  in
  Alcotest.(check (list (pair string string))) "no misaligned dates" [] mismatched

(* The core assertion: every one of the 5595 raw differences is either
   normalised away (Layers A/B) or named in the cited allow-list (Layer C).
   Nothing else is permitted to pass silently. *)
let test_no_unexplained_differences () =
  let lectio, colitur = compare_streams () in
  let classified = classify lectio colitur in
  let unexplained =
    List.filter_map
      (fun (l, c, outcome) ->
        match outcome with Unexplained diffs -> Some (describe_unexplained l c diffs) | _ -> None)
      classified
  in
  Alcotest.(check (list string)) "no differences outside Layers A/B/C" [] unexplained

(* Teeth, not just green: EVERY Layer C entry's actual row count over this
   fixture must equal what data/ef/expected-divergences.sexp declares, in
   BOTH directions -- an id used by [layer_c_reason] that is missing from
   the sexp file, an id declared but never matched, or a count that has
   drifted either up or down, all fail loudly. A silent drift here is
   exactly the "allow-list absorbs a new bug" failure mode this task was
   warned about. *)
let test_layer_c_counts_match_citations () =
  let lectio, colitur = compare_streams () in
  let classified = classify lectio colitur in
  let actual_counts = Hashtbl.create 16 in
  List.iter
    (fun (_, _, outcome) ->
      match outcome with
      | Explained id ->
          Hashtbl.replace actual_counts id (1 + Option.value ~default:0 (Hashtbl.find_opt actual_counts id))
      | _ -> ())
    classified;
  let declared = load_allow_list () in
  let expected =
    List.sort compare (List.map (fun e -> (e.id, e.expected_rows)) declared)
  in
  let actual =
    List.sort compare
      (Hashtbl.fold (fun id n acc -> (id, n) :: acc) actual_counts [])
  in
  Alcotest.(check (list (pair string int)))
    "every allow-list id's actual row count matches its citation's expected_rows, and no id is unused or \
     undeclared"
    expected actual

let suite =
  ( "differential (lectio, EF, 2005-2050)",
    [ Alcotest.test_case "fixture SHA-256 matches its provenance note" `Quick test_fixture_checksum;
      Alcotest.test_case "streams are 16801 rows each, dates aligned 1:1" `Quick test_dates_align;
      Alcotest.test_case "every difference is normalised (A/B) or cited (C) -- none unexplained" `Quick
        test_no_unexplained_differences;
      Alcotest.test_case "Layer C counts match data/ef/expected-divergences.sexp exactly" `Quick
        test_layer_c_counts_match_citations
    ] )