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")

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 ] )