path: root/test/test_lang_coverage.ml

module L = Colitur_naming.Lang

let read path =
  let ic = open_in_bin path in
  let s = really_input_string ic (in_channel_length ic) in
  close_in ic;
  s

let la () =
  match L.of_string (read "../lang/la.ini") with
  | Ok t -> t
  | Error e -> Alcotest.failf "lang/la.ini: %s" e

(* en.ini resolved THROUGH la.ini, the way a real run resolves it: en
   declares `fallback = la`, so a key it omits must reach the Latin table
   rather than degrade to the raw key. *)
let en () =
  match L.of_string (read "../lang/en.ini") with
  | Ok t -> L.with_fallback t (la ())
  | Error e -> Alcotest.failf "lang/en.ini: %s" e

(* Every slug the engine can emit -- temporal ("^ef-") AND sanctoral (a fixed
   saint's day) alike -- must have a Latin name. THIS IS THE TEST THAT WOULD
   HAVE CAUGHT THE ORIGINAL DEFECT -- a booklet printed "ef-septuagesima-
   sunday-2" because nothing asserted coverage. It must fail loudly the
   moment a new slug appears without a name.

   Task 3 restricted this to "^ef-" slugs only (la.ini's [celebration] table
   carried the temporal half alone at the time); Task 4 added the sanctoral
   half and REMOVED that filter -- every slug is now in scope, with no
   exceptions.

   Task 5 CLOSED A SECOND BLIND SPOT: this test used to walk only the
   OBSERVED day (one Celebration.t per date). A Liturgical_day.t also
   carries a whole second stream of slugs -- commemorations (kept when the
   observed day does not fully displace a losing candidate, RG 108-111) and
   transfers (an impeded I/II-class feast moved to a later date, RG 96-98).
   The ordo booklet printed raw slugs ("Commemoratio canute-martyr",
   "Commemoratio maur-abbot", "Commemoratio peter") precisely because
   nothing here ever looked at [commemorations], [transferred_in] or
   [transferred_out] -- the test asserted coverage of what it happened to
   WALK, not of what the engine can EMIT. Now walks all four fields, so any
   slug reachable through any of them is in scope. *)
let slugs_of_day (d : (Rite_ef.Vocab_ef.season, Rite_ef.Vocab_ef.rank) Colitur_kernel.Liturgical_day.t) =
  let open Colitur_kernel in
  let slug (c : _ Celebration.t) = Slug.to_string c.Celebration.slug in
  (slug d.Liturgical_day.observed)
  :: List.map (fun (c, _priv) -> slug c) d.Liturgical_day.commemorations
  @ (match d.Liturgical_day.transferred_in with None -> [] | Some c -> [ slug c ])
  @ List.map (fun (c, _date) -> slug c) d.Liturgical_day.transferred_out

let test_every_slug_has_a_latin_name () =
  let t = la () in
  let layer = match Test_support.load_ef_layer () with Ok l -> l | Error e -> Alcotest.failf "%s" e in
  let ctx = Test_support.ef_context () in
  let missing = ref [] in
  for y = 2020 to 2045 do
    Array.iter
      (fun d ->
        List.iter
          (fun slug ->
            (* A miss returns the key itself, so name = slug means "no entry". *)
            if L.celebration t slug = slug && not (List.mem slug !missing) then
              missing := slug :: !missing)
          (slugs_of_day d))
      (Colitur_kernel.Calendar.year ctx layer y)
  done;
  if !missing <> [] then
    Alcotest.failf "%d slugs have no Latin name: %s" (List.length !missing)
      (String.concat ", " (List.sort compare !missing))

let test_vocabularies_are_complete () =
  let t = la () in
  List.iter
    (fun s -> if L.season t s = s then Alcotest.failf "no Latin season name for %S" s)
    [ "advent"; "christmastide"; "time-after-epiphany"; "septuagesima"; "lent";
      "passiontide"; "paschaltide"; "time-after-pentecost" ];
  List.iter
    (fun r -> if L.rank t r = r then Alcotest.failf "no Latin rank name for %S" r)
    [ "class-1"; "class-2"; "class-3"; "class-4" ];
  List.iter
    (fun c -> if L.colour t c = c then Alcotest.failf "no Latin colour name for %S" c)
    [ "white"; "red"; "green"; "violet"; "rose"; "black" ];
  for n = 0 to 6 do
    if L.weekday t n = string_of_int n then Alcotest.failf "no Latin weekday for %d" n
  done;
  for n = 1 to 12 do
    if L.month t n = string_of_int n then Alcotest.failf "no Latin month for %d" n
  done;
  for n = 1 to 12 do
    if L.month_abbr t n = string_of_int n then Alcotest.failf "no Latin month abbreviation for %d" n
  done

(* Defect 1: the booklet used to print the bare rite id ("ef") because no
   [rite] section existed in either language file. Walks every rite id the
   engine can actually emit -- one today (Rite_ef.Temporal_ef.id, the same
   id `Rite_ef.context` stamps onto every Rite.t.id -- see rite_ef.ml) -- so
   this is cheap now and fails loudly the moment a second rite module (OF)
   is wired in without a matching [rite] entry in la.ini. *)
let test_every_rite_has_a_latin_name () =
  let t = la () in
  List.iter
    (fun id -> if L.rite t id = id then Alcotest.failf "no Latin display name for rite %S" id)
    [ Rite_ef.Temporal_ef.id ]

(* Task 10: every id Colitur_citation.Book.all knows must have BOTH a
   `.full` and an `.abbr` row in lang/la.ini's own [bible] section -- this is
   the check that would have caught a forgotten tradition target (the seven
   ids in book.ml's own `tradition_targets`, never cited by the data itself,
   so nothing else here would ever notice one missing -- see book.mli's own
   note on why `default_spelling` falls back to the bare id for exactly
   this case). The total-lookup contract makes this a one-line miss test:
   `Lang.bible la key = key` IS "no entry", the same pattern
   `test_every_slug_has_a_latin_name` above already uses for [celebration]. *)
let test_every_book_named () =
  let la = la () in
  let missing =
    List.concat_map
      (fun id ->
        let n = Colitur_citation.Book.to_string id in
        List.filter_map
          (fun form ->
            let key = n ^ "." ^ form in
            if L.bible la key = key then Some key else None)
          [ "full"; "abbr" ])
      Colitur_citation.Book.all
  in
  Alcotest.(check (list string)) "every book named, both forms" [] missing

(* A name must not BE the internal id. The check above compares the value
   against the KEY ("kings_1.full"), so a row reading `kings_1.full = kings_1`
   passes it -- the two strings differ. That is exactly what shipped: all seven
   tradition targets carried their own id as their name, and
   `--sigla-tradition modern` printed "kings_1 19:3-8", leaking a key that
   book.mli states is never shown to a reader.

   The two checks are complementary and neither subsumes the other: that one
   catches a MISSING row, this one catches a row present but filled with the
   wrong thing. *)
let test_no_book_name_is_an_internal_id () =
  let la = la () in
  let leaked =
    List.concat_map
      (fun id ->
        let n = Colitur_citation.Book.to_string id in
        List.filter_map
          (fun form ->
            let v = L.bible la (n ^ "." ^ form) in
            if v = n then Some (n ^ "." ^ form) else None)
          [ "full"; "abbr" ])
      Colitur_citation.Book.all
  in
  Alcotest.(check (list string)) "no book name is its own internal id" []
    leaked

(* Two DIFFERENT books must not share a name. Found by audit: `1 Cor` and
   `2 Cor` both rendered as "Epistola ad Corinthios" under --sigla-book full,
   and so did Thessalonians, Timothy and Peter -- 108 citations in 2027 alone
   that a reader cannot resolve to a book. The same defect had already been
   fixed for the two Books of Kings and simply not generalised.

   Sharing a name is CORRECT, though, when the two ids are the same physical
   book under different numbering -- `osee`/`hosea`, `jonas`/`jonah`,
   `apocalypse`/`revelation`. A tradition maps one onto the other, so the
   rule is exact: a shared name is a defect UNLESS some tradition relates the
   two ids. *)
let test_no_two_books_share_a_name () =
  let la = la () in
  let traditions =
    let text =
      let ic = open_in_bin "../lang/traditions.ini" in
      let s = really_input_string ic (in_channel_length ic) in
      close_in ic; s
    in
    match Colitur_kernel.Overlay_ini.parse_sections text with
    | Ok ss ->
        List.concat_map (fun (sc : Colitur_kernel.Overlay_ini.section) ->
          sc.Colitur_kernel.Overlay_ini.fields) ss
    | Error e -> Alcotest.failf "traditions.ini: %s" e
  in
  let related a b =
    List.exists (fun (x, y) -> (x = a && y = b) || (x = b && y = a)) traditions
  in
  let offenders = ref [] in
  List.iter
    (fun form ->
      let seen = Hashtbl.create 64 in
      List.iter
        (fun id ->
          let n = Colitur_citation.Book.to_string id in
          let key = n ^ "." ^ form in
          let v = L.bible la key in
          if v <> key then
            match Hashtbl.find_opt seen v with
            | Some other when not (related n other) ->
                offenders := Printf.sprintf "%s: %s and %s" v other n :: !offenders
            | _ -> Hashtbl.replace seen v n)
        Colitur_citation.Book.all)
    [ "full"; "abbr" ];
  Alcotest.(check (list string)) "no two different books share a name" []
    (List.sort compare !offenders)

(* SPEC SECTION 8.5: each shipped style must parse its own rendered output.
   It did not. Measured at the time: 32 of 52 Latin abbreviations and 49 of 52
   Latin full titles failed to re-parse, so a user who copied a citation out
   of `colitur readings` into an overlay handed the parser a string it could
   not read; [Sigla.format] passed it through untouched and, say, an English
   full-name booklet printed a Latin abbreviation with no warning. Closed by
   registering every shipped name as a spelling and by teaching [split_book]
   multi-word titles.

   A name may resolve to a DIFFERENT id than the one it was rendered from,
   but only when the two are the same physical book under different
   numbering: "Sir" is registered to [ecclesiasticus] and the modern id
   [sirach] maps onto it. The parser has no tradition context, so it returns
   the Vulgate id, and that is right rather than tolerated. *)
let test_shipped_styles_round_trip () =
  let traditions =
    let text =
      let ic = open_in_bin "../lang/traditions.ini" in
      let s = really_input_string ic (in_channel_length ic) in
      close_in ic; s
    in
    match Colitur_kernel.Overlay_ini.parse_sections text with
    | Ok ss ->
        List.concat_map
          (fun (sc : Colitur_kernel.Overlay_ini.section) ->
            sc.Colitur_kernel.Overlay_ini.fields)
          ss
    | Error e -> Alcotest.failf "traditions.ini: %s" e
  in
  let related a b =
    a = b || List.exists (fun (x, y) -> (x = a && y = b) || (x = b && y = a)) traditions
  in
  let check_file label t =
    List.concat_map
      (fun form ->
        List.filter_map
          (fun id ->
            let n = Colitur_citation.Book.to_string id in
            let name = L.bible t (n ^ "." ^ form) in
            if name = n ^ "." ^ form then None
            else
              match Colitur_citation.Parse.parse (name ^ " 5:12-14") with
              | Ok r
                when related
                       (Colitur_citation.Book.to_string r.Colitur_citation.Parse.book)
                       n ->
                  None
              | Ok r ->
                  Some
                    (Printf.sprintf "%s %s/%s -> %s" label name form
                       (Colitur_citation.Book.to_string r.Colitur_citation.Parse.book))
              | Error e -> Some (Printf.sprintf "%s %s/%s: %s" label name form e))
          Colitur_citation.Book.all)
      [ "full"; "abbr" ]
  in
  let bad = check_file "la" (la ()) @ check_file "en" (en ()) in
  Alcotest.(check (list string)) "every shipped book name re-parses" []
    (List.sort compare bad)

(* lang/en.ini is DELIBERATELY partial (see its own header note): it declares
   [meta] fallback = la, so a slug it does not carry itself should still
   resolve through the chain to la.ini's name rather than degrade to the bare
   slug -- that is what makes an incomplete translation shippable from its
   first line. This test proves the CHAIN MECHANISM itself, independent of
   how complete lang/en.ini happens to be today: a from-scratch table with NO
   [celebration] entries at all, chained to the real la.ini, must still
   resolve a real la.ini key -- so the test cannot be defeated simply by
   en.ini becoming more complete over time. It also sanity-checks the real
   shipped file: that it parses, declares the right fallback code, and that
   at least one of its own entries resolves directly (not merely through the
   chain). *)
let test_en_falls_back_to_latin () =
  let en =
    match L.of_string (read "../lang/en.ini") with
    | Ok t -> t
    | Error e -> Alcotest.failf "lang/en.ini: %s" e
  in
  Alcotest.(check string) "declares la fallback" "la"
    (Option.value (L.fallback_code en) ~default:"NONE");
  (* The real shipped file: at least one of its own entries resolves without
     needing the chain at all. *)
  Alcotest.(check bool) "en.ini names ef-epiphany directly" true
    (L.celebration en "ef-epiphany" <> "ef-epiphany");
  (* The mechanism, isolated from today's en.ini coverage: an EMPTY table
     (no [celebration] section) chained to la.ini must still resolve a real
     la.ini-only key through the fallback. *)
  let empty =
    match L.of_string "[meta]\nlang = en\nfallback = la\n" with
    | Ok t -> t
    | Error e -> Alcotest.failf "synthetic empty en table: %s" e
  in
  let chained = L.with_fallback empty (la ()) in
  Alcotest.(check bool) "empty table falls back to la.ini for a real slug" true
    (L.celebration chained "hilary" <> "hilary")

(* ------------------------------------------------------------------ *)
(* Fix wave I1 (final-review.md, 2026-08-25-colitur-of-phases-3-5):     *)
(* --rite of used to resolve every displayed name through lang/la.ini,  *)
(* EF's own independently-cited 1962-vocabulary table, keyed on slug.   *)
(* 18 of 222 shipped OF sanctoral slugs happen to collide with an EF    *)
(* slug there and all 18 printed the WRONG (1962) title -- e.g.         *)
(* "S. Marthae Virg." (a title the 1969 reform deleted, and which also  *)
(* silently overrode amendment 011's own rename) instead of             *)
(* calendar-2002.sexp's own "Ss. Marthae, Mariae et Lazari". The other  *)
(* 204 had no entry there at all and degraded to a bare slug, so none   *)
(* of the 208 hand-verified titles Task 1 transcribed (cited against    *)
(* the 2002 Missal) was ever reachable.                                 *)
(*                                                                       *)
(* bin/main.ml's [observed_name_of] now prefers the observed            *)
(* celebration's OWN {!Colitur_kernel.Celebration.names}, falling back  *)
(* to the lang table only on a miss. That priority order is duplicated  *)
(* here -- bin/ and test/ are separate dune stanzas that do not share   *)
(* code, the same reasoning test_support.ml's own header gives for why  *)
(* it duplicates bin/main.ml's EF loaders rather than requiring them --  *)
(* and checked against every entry the REAL, assembled OF layer         *)
(* actually carries (calendar-2002.sexp + all 13 amendments), not a     *)
(* synthetic fixture. Walking {!Colitur_kernel.Layer.t.entries} directly *)
(* rather than a resolved calendar year: several of the 18 real          *)
(* collisions (e.g. Margaret of Scotland, 16 November) never win the     *)
(* alphabetical tie-break against a same-day rival in ANY year and so    *)
(* are never the OBSERVED day at all -- the collision in the DATA is     *)
(* real and load-bearing regardless (a future tie-break or Calendar      *)
(* change could make her win one), so this test does not depend on       *)
(* which slugs happen to be observed in any particular year range. *)
let of_base_path = "../data/of/calendar-2002.sexp"
let of_amendments_dir = "../data/of/amendments/"
let of_amendment_files =
  [ "001-padre-pio.sexp"; "002-juan-diego-cuauhtlatoatzin.sexp"; "003-our-lady-of-guadalupe.sexp";
    "004-john-xxiii-john-paul-ii.sexp"; "005-mary-magdalene-rank.sexp"; "006-mary-mother-of-the-church.sexp";
    "007-paul-vi.sexp"; "008-our-lady-of-loreto.sexp"; "009-faustina-kowalska.sexp";
    "010-narek-avila-hildegard.sexp"; "011-martha-mary-lazarus.sexp"; "012-teresa-of-calcutta.sexp";
    "013-john-henry-newman.sexp" ]

let of_layer () =
  match Colitur_kernel.Layer.load Rite_of.Vocab_of.rank_of_sexp of_base_path with
  | Error e -> Alcotest.failf "%s: %s" of_base_path e
  | Ok base ->
      let overlays =
        List.map
          (fun name ->
            let path = of_amendments_dir ^ name in
            match Colitur_kernel.Overlay.load Rite_of.Vocab_of.rank_of_sexp path with
            | Ok o -> o
            | Error e -> Alcotest.failf "%s: %s" path e)
          of_amendment_files
      in
      let layer, diagnostics = Colitur_kernel.Overlay.merge base overlays in
      if diagnostics <> [] then Alcotest.failf "unexpected OF amendment diagnostics on the shipped data";
      layer

let la_lang = Colitur_kernel.Lang.of_string_exn "la"

(* [observed_name_of]'s own resolution order (bin/main.ml), duplicated
   rather than called -- see this section's own header. *)
let resolve_like_cli t (cel : Rite_of.Vocab_of.rank Colitur_kernel.Celebration.t) slug_s =
  match Colitur_kernel.Names.find cel.Colitur_kernel.Celebration.names la_lang with
  | Some n -> n
  | None -> L.celebration t slug_s

let test_of_names_win_over_ef_lang_table () =
  let t = la () in
  let layer = of_layer () in
  let collisions = ref [] in
  List.iter
    (fun (e : _ Colitur_kernel.Layer.entry) ->
      let cel = e.Colitur_kernel.Layer.cel in
      let slug_s = Colitur_kernel.Slug.to_string cel.Colitur_kernel.Celebration.slug in
      (* A miss returns the key itself (lang.mli's own TOTAL-lookup
         contract): [L.celebration t slug_s <> slug_s] means la.ini really
         does carry an entry for this OF slug -- a genuine collision, not
         a hypothetical one. *)
      if L.celebration t slug_s <> slug_s then collisions := slug_s :: !collisions)
    layer.Colitur_kernel.Layer.entries;
  (* Not asserting the collision count -- two independently-authored
     vocabularies sharing a slug is expected (the whole reason this fix
     exists) and not itself a defect; what matters, and what regresses
     silently if [observed_name_of]'s priority order is ever reverted, is
     what happens on EVERY one of them: *)
  if !collisions = [] then
    Alcotest.fail
      "expected at least one real OF/EF slug collision (e.g. \"martha\") -- if this is now empty, \
       either lang/la.ini or calendar-2002.sexp changed and this test's own premise needs re-checking, \
       not silently passing on zero cases";
  List.iter
    (fun slug_s ->
      match Colitur_kernel.Layer.find layer (Colitur_kernel.Slug.of_string_exn slug_s) with
      | None -> Alcotest.failf "%s: found in entries but not via Layer.find" slug_s
      | Some (e : _ Colitur_kernel.Layer.entry) -> (
          let cel = e.Colitur_kernel.Layer.cel in
          match Colitur_kernel.Names.find cel.Colitur_kernel.Celebration.names la_lang with
          | None ->
              Alcotest.failf
                "%s: collides with lang/la.ini and calendar-2002.sexp carries NO own `la` name for it \
                 -- would silently print EF's 1962 title (%s)"
                slug_s (L.celebration t slug_s)
          | Some own_name ->
              Alcotest.(check string)
                (Printf.sprintf "%s: resolves to the OF's own transcribed name, not lang/la.ini's EF one"
                   slug_s)
                own_name (resolve_like_cli t cel slug_s)))
    !collisions

let suite =
  ( "Lang/coverage",
    [ Alcotest.test_case "every slug has a Latin name" `Slow test_every_slug_has_a_latin_name;
      Alcotest.test_case "vocabularies complete" `Quick test_vocabularies_are_complete;
      Alcotest.test_case "every rite has a Latin name" `Quick test_every_rite_has_a_latin_name;
      Alcotest.test_case "every book named, both forms" `Quick test_every_book_named;
      Alcotest.test_case "no book name is an internal id" `Quick
        test_no_book_name_is_an_internal_id;
      Alcotest.test_case "no two books share a name" `Quick
        test_no_two_books_share_a_name;
      Alcotest.test_case "shipped styles round-trip" `Quick
        test_shipped_styles_round_trip;
      Alcotest.test_case "en.ini falls back to Latin" `Quick test_en_falls_back_to_latin;
      Alcotest.test_case "OF names win over lang/la.ini on every real slug collision" `Quick
        test_of_names_win_over_ef_lang_table ] )