path: root/test/test_view.ml

module V = Colitur_render.View
module T = Colitur_render.Template

(* Build one civil year of resolved days exactly as the CLI does. *)
let days_of_year y =
  let layer =
    match Test_support.load_ef_layer () with Ok l -> l | Error e -> Alcotest.failf "layer: %s" e
  in
  let context = Test_support.ef_context () in
  let module Cal = Colitur_kernel.Calendar in
  let module D = Colitur_kernel.Date in
  let tbl = Hashtbl.create 400 in
  let index days =
    Array.iter (fun d -> Hashtbl.replace tbl (D.to_rata d.Colitur_kernel.Liturgical_day.date) d) days
  in
  index (Cal.year context layer (y - 1));
  index (Cal.year context layer y);
  let jan1 = Result.get_ok (D.make ~year:y ~month:1 ~day:1) in
  let dec31 = Result.get_ok (D.make ~year:y ~month:12 ~day:31) in
  let out = ref [] and d = ref jan1 in
  while D.compare !d dec31 <= 0 do
    (match Hashtbl.find_opt tbl (D.to_rata !d) with Some x -> out := x :: !out | None -> ());
    d := D.add_days !d 1
  done;
  List.rev !out

(* Shared across this file and test_emit.ml: the ENGLISH table, chained to
   Latin (en.ini's own [meta] fallback = la), so a slug en.ini does not name
   directly still resolves through the chain rather than degrading to its
   slug. English (not Latin, and not Lang.raw) is deliberate: it keeps the
   emitter tests' own literal expectations -- "St. Joseph, Spouse of the Bl.
   Virgin Mary" (a comma, for CSV quoting), "Sts. Fabian & Sebastian" (an
   ampersand, for XML escaping) -- byte-identical to lang/en.ini's own
   [celebration] entries, verified by grep against the shipped file rather
   than assumed. *)
let read_lang path =
  let ic = open_in_bin path in
  let s = really_input_string ic (in_channel_length ic) in
  close_in ic;
  match Colitur_naming.Lang.of_string s with
  | Ok t -> t
  | Error e -> Alcotest.failf "%s: %s" path e

let default_lang =
  lazy (Colitur_naming.Lang.with_fallback (read_lang "../lang/en.ini") (read_lang "../lang/la.ini"))

let view_of y =
  let lang = Lazy.force default_lang in
  V.of_days ~lang ~sigla:(Test_support.default_sigla lang) ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y
    (days_of_year y)

let get path v =
  let rec go v = function
    | [] -> v
    | k :: tl -> (
        match v with
        | T.Obj kvs -> (
            match List.assoc_opt k kvs with Some v' -> go v' tl | None -> Alcotest.failf "no key %s" k)
        | _ -> Alcotest.failf "not an object at %s" k)
  in
  go v path

let as_list = function T.List l -> l | _ -> Alcotest.fail "expected a list"
let as_str = function T.Str s -> s | _ -> Alcotest.fail "expected a string"
let as_bool = function T.Bool b -> b | _ -> Alcotest.fail "expected a bool"

let test_year_shape () =
  let v = view_of 2027 in
  Alcotest.(check string) "rite" "ef" (as_str (get [ "rite" ] v));
  (* Defect 1: [rite] stays the stable key ("ef"); [rite_name] is the
     reader-facing display name a template prints instead. en.ini's own
     [rite] section names it directly. *)
  Alcotest.(check string) "rite_name" "Roman Missal, 1962 typical edition"
    (as_str (get [ "rite_name" ] v));
  Alcotest.(check string) "year" "2027" (as_str (get [ "year" ] v));
  Alcotest.(check int) "twelve months" 12 (List.length (as_list (get [ "months" ] v)));
  Alcotest.(check int) "365 days" 365 (List.length (as_list (get [ "days" ] v)))

(* THE property the grid depends on: weeks flatten to the month's days plus
   padding, and every real day appears exactly once (spec section 9.3). *)
let test_weeks_flatten_to_days () =
  let v = view_of 2027 in
  List.iter
    (fun m ->
      let weeks = as_list (get [ "weeks" ] m) in
      let cells = List.concat_map (fun w -> as_list (get [ "days" ] w)) weeks in
      List.iter
        (fun w -> Alcotest.(check int) "seven cells per week" 7 (List.length (as_list (get [ "days" ] w))))
        weeks;
      let real = List.filter (fun c -> as_bool (get [ "in_month" ] c)) cells in
      let own = as_list (get [ "days" ] m) in
      Alcotest.(check int) "real cells = month days" (List.length own) (List.length real);
      List.iter2
        (fun a b -> Alcotest.(check string) "same day, same order" (as_str (get [ "iso" ] a)) (as_str (get [ "iso" ] b)))
        own real)
    (as_list (get [ "months" ] v))

(* Defect 2 (the continuous ordo booklet): [first] is true on exactly one
   week per month -- the first -- so a template can print a strong,
   standalone month banner at that point instead of every week's own header
   looking identical. *)
let test_first_week_flag () =
  let v = view_of 2027 in
  List.iter
    (fun m ->
      let weeks = as_list (get [ "weeks" ] m) in
      match weeks with
      | [] -> Alcotest.fail "a month with no weeks at all"
      | first :: rest ->
          Alcotest.(check bool) "first week flagged" true (as_bool (get [ "first" ] first));
          List.iter
            (fun w -> Alcotest.(check bool) "later week not flagged" false (as_bool (get [ "first" ] w)))
            rest)
    (as_list (get [ "months" ] v))

let test_padding_cells_are_flagged () =
  let v = view_of 2027 in
  let jan = List.hd (as_list (get [ "months" ] v)) in
  let first_week = List.hd (as_list (get [ "weeks" ] jan)) in
  let cells = as_list (get [ "days" ] first_week) in
  (* 1 January 2027 is a Friday, so the first week has five padding cells. *)
  Alcotest.(check int) "five padding cells" 5
    (List.length (List.filter (fun c -> not (as_bool (get [ "in_month" ] c))) cells));
  List.iter
    (fun c ->
      if not (as_bool (get [ "in_month" ] c)) then
        Alcotest.(check string) "padding has empty iso" "" (as_str (get [ "iso" ] c)))
    cells

let test_day_fields () =
  let v = view_of 2027 in
  let d =
    List.find (fun d -> as_str (get [ "iso" ] d) = "2027-01-13") (as_list (get [ "days" ] v))
  in
  Alcotest.(check string) "slug" "commemoration-of-the-baptism-of-the-lord" (as_str (get [ "slug" ] d));
  Alcotest.(check string) "colour" "white" (as_str (get [ "colour" ] d));
  Alcotest.(check bool) "is_white" true (as_bool (get [ "is_white" ] d));
  Alcotest.(check bool) "is_violet" false (as_bool (get [ "is_violet" ] d));
  Alcotest.(check int) "dow friday" 3 (int_of_string (as_str (get [ "dow" ] d)));
  Alcotest.(check bool) "first citation present" true (as_str (get [ "first" ] d) <> "");
  Alcotest.(check bool) "gospel citation present" true (as_str (get [ "gospel" ] d) <> "")

(* W5's own reason for existing: OF cannot reach [View.of_days] through the
   CLI today ([bin/main.ml]'s [reject_rite_for] refuses [--rite] on every
   command that would build one), so the only honest way to exercise a
   THREE-citation day through this path is to drive [View.of_days] directly
   with a hand-built [Liturgical_day.t] -- which rite actually produced the
   citations is irrelevant to the render layer; only [citations] itself is.
   Reuses a real EF day's [temporal]/[observed]/etc. (record update syntax)
   purely as scaffolding, with its own two real citations discarded and
   replaced -- nothing here asserts anything EF-specific. Exposed (not
   [let () = ...] inline) so [test_emit.ml]/[test_ics.ml] can drive the same
   synthetic day through [Emit_xml]/[Emit_ics] without duplicating it. *)
let three_citation_view () =
  let module K = Colitur_kernel in
  let real = List.hd (days_of_year 2027) in
  let synthetic =
    { real with
      K.Liturgical_day.citations =
        [ { K.Citation.part = K.Citation.First; reference = "Rom 1:1-7" };
          { K.Citation.part = K.Citation.Second; reference = "1 Cor 1:3-9" };
          { K.Citation.part = K.Citation.Gospel; reference = "Ioann 1:1-14" } ] }
  in
  let lang = Lazy.force default_lang in
  V.of_days ~lang ~sigla:(Test_support.default_sigla lang) ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:2027
    [ synthetic ]

let test_three_citation_day_exposes_all_three () =
  let v = three_citation_view () in
  let d = List.hd (as_list (get [ "days" ] v)) in
  Alcotest.(check string) "first" "Rom 1:1-7" (as_str (get [ "first" ] d));
  Alcotest.(check string) "second" "1 Cor 1:3-9" (as_str (get [ "second" ] d));
  (* "Ioann" -> "John": the stored (Latin) book abbreviation renders through
     [sigla] the same as [first]/[gospel] always have -- proving [second]
     shares the identical [Sigla.format] path, not a second, divergent one. *)
  Alcotest.(check string) "gospel" "John 1:1-14" (as_str (get [ "gospel" ] d))

(* Exactly one of the six colour booleans is true on every day of a whole year:
   a template that keys a cell colour off them can never get no colour or two. *)
let test_exactly_one_colour_flag () =
  let v = view_of 2027 in
  List.iter
    (fun d ->
      let n =
        List.length
          (List.filter
             (fun k -> as_bool (get [ k ] d))
             [ "is_white"; "is_red"; "is_green"; "is_violet"; "is_rose"; "is_black" ])
      in
      if n <> 1 then Alcotest.failf "%s has %d colour flags set" (as_str (get [ "iso" ] d)) n)
    (as_list (get [ "days" ] v))

(* Padding cells and real days must carry the SAME key set: a template that
   walks a grid row must never hit a missing key on a padding cell. Compares
   the sorted key lists of a real day and a padding cell (the first cell of
   January 2027's first week -- 1 Jan 2027 is a Friday, so that cell IS a
   padding cell, see test_padding_cells_are_flagged above). *)
let keys_of = function
  | T.Obj kvs -> List.sort compare (List.map fst kvs)
  | _ -> Alcotest.fail "expected an object"

(* W5: EF's own citations are always exactly [First; Gospel]
   ({!Rite_ef}'s own [citation_shapes]) -- so no EF day's key set should
   EVER include "second" (or any of the other still-unbuilt parts:
   "psalm"/"tract"/"alleluia"/"sequence"). Confirms the "absent key, not a
   present key holding the empty string" half of [View.citation_fields]'s
   own design, over a whole year rather than one sampled day. *)
let test_ef_days_never_carry_a_second_key () =
  let v = view_of 2027 in
  List.iter
    (fun d ->
      List.iter
        (fun k -> if List.mem k (keys_of d) then Alcotest.failf "%s carries an unexpected key %s" (as_str (get [ "iso" ] d)) k)
        [ "second"; "psalm"; "tract"; "alleluia"; "sequence" ])
    (as_list (get [ "days" ] v))

let test_padding_and_real_share_key_set () =
  let v = view_of 2027 in
  let jan = List.hd (as_list (get [ "months" ] v)) in
  let first_week = List.hd (as_list (get [ "weeks" ] jan)) in
  let cells = as_list (get [ "days" ] first_week) in
  let padding = List.find (fun c -> not (as_bool (get [ "in_month" ] c))) cells in
  let real = List.find (fun c -> as_bool (get [ "in_month" ] c)) cells in
  Alcotest.(check (list string)) "padding and real days have the same key set" (keys_of real)
    (keys_of padding)

let latin () =
  let ic = open_in_bin "../lang/la.ini" in
  let s = really_input_string ic (in_channel_length ic) in
  close_in ic;
  match Colitur_naming.Lang.of_string s with
  | Ok t -> t | Error e -> Alcotest.failf "la.ini: %s" e

let view_named y =
  let lang = latin () in
  V.of_days ~lang ~sigla:(Test_support.default_sigla lang) ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y
    (days_of_year y)

(* The ordo booklet's week header (Hebdomada I (Ian 1-2)): a Roman numeral
   beside the existing arabic one, and month_num/month_name/month_abbr
   carried onto every week the same way (there is no {{../}} parent-path
   syntax to reach the enclosing month otherwise). January 2027 has six
   weeks (1 Jan 2027 is a Friday, 31 Jan a lone trailing Sunday), so I-VI
   is a real witness, not a guess capped at a small sample. *)
let test_week_num_roman_and_month_fields () =
  let v = view_named 2027 in
  let jan = List.hd (as_list (get [ "months" ] v)) in
  let weeks = as_list (get [ "weeks" ] jan) in
  Alcotest.(check int) "January 2027 has six weeks" 6 (List.length weeks);
  Alcotest.(check (list string)) "I..VI" [ "I"; "II"; "III"; "IV"; "V"; "VI" ]
    (List.map (fun w -> as_str (get [ "num_roman" ] w)) weeks);
  List.iter
    (fun w ->
      Alcotest.(check string) "month_num" "1" (as_str (get [ "month_num" ] w));
      Alcotest.(check string) "month_name" "Ianuarius" (as_str (get [ "month_name" ] w));
      Alcotest.(check string) "month_abbr" "Ian" (as_str (get [ "month_abbr" ] w)))
    weeks

(* The date-span fields a template needs to print "(Ian 1-2)" without ever
   being handed a preformatted string (spec: the engine is logic-less, so a
   punctuation choice between "Ian 1" and "Ian 1-2" must stay data the
   template or a language file can still change). Verified against real
   1 January 2027 = Friday / 31 January 2027 = Sunday arithmetic: the
   month's first week holds only its own leading two in-month days (1-2),
   and its own LAST week -- a lone trailing Sunday, 31 -- is this whole
   suite's single-day-week witness. *)
let test_week_date_span () =
  let v = view_named 2027 in
  let jan = List.hd (as_list (get [ "months" ] v)) in
  let weeks = as_list (get [ "weeks" ] jan) in
  let first_week = List.hd weeks in
  Alcotest.(check string) "week 1 first_dom" "1" (as_str (get [ "first_dom" ] first_week));
  Alcotest.(check string) "week 1 last_dom" "2" (as_str (get [ "last_dom" ] first_week));
  Alcotest.(check bool) "week 1 is not a single day" false (as_bool (get [ "single_day" ] first_week));
  let last_week = List.nth weeks (List.length weeks - 1) in
  Alcotest.(check string) "week 6 first_dom" "31" (as_str (get [ "first_dom" ] last_week));
  Alcotest.(check string) "week 6 last_dom" "31" (as_str (get [ "last_dom" ] last_week));
  Alcotest.(check bool) "week 6 IS a single day" true (as_bool (get [ "single_day" ] last_week))

(* Property, not a one-off sample: over every week of every month of a whole
   year, [single_day] must agree exactly with [first_dom] = [last_dom], and
   the count of in-month cells in [days] must match what [single_day] claims
   -- proves the flag is computed FROM the same in-month cells a template
   walks, not from a separately-derived (and possibly drifting) count. *)
let test_single_day_agrees_with_span_and_cells () =
  let v = view_of 2027 in
  List.iter
    (fun m ->
      List.iter
        (fun w ->
          let first_dom = as_str (get [ "first_dom" ] w) and last_dom = as_str (get [ "last_dom" ] w) in
          let single = as_bool (get [ "single_day" ] w) in
          Alcotest.(check bool) "single_day iff first_dom = last_dom" (first_dom = last_dom) single;
          let real_cells =
            List.filter (fun c -> as_bool (get [ "in_month" ] c)) (as_list (get [ "days" ] w))
          in
          if single then Alcotest.(check int) "single day: exactly one real cell" 1 (List.length real_cells))
        (as_list (get [ "weeks" ] m)))
    (as_list (get [ "months" ] v))

(* The defect this whole branch exists to fix: no rendered day may show a slug
   where a name exists. Asserted over a whole year, not a sample. *)
let test_no_day_shows_a_slug () =
  let v = view_named 2027 in
  List.iter
    (fun d ->
      let name = as_str (get [ "name" ] d) and slug = as_str (get [ "slug" ] d) in
      if name = slug then Alcotest.failf "%s renders its slug as its name" (as_str (get [ "iso" ] d));
      if name = "" then Alcotest.failf "%s has an empty name" (as_str (get [ "iso" ] d)))
    (as_list (get [ "days" ] v))

let test_slug_is_unchanged_by_naming () =
  let raw =
    V.of_days ~lang:Colitur_naming.Lang.raw ~sigla:Colitur_citation.Sigla.verbatim
      ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:2027 (days_of_year 2027)
  in
  let named = view_named 2027 in
  List.iter2
    (fun a b -> Alcotest.(check string) "slug identical" (as_str (get [ "slug" ] a)) (as_str (get [ "slug" ] b)))
    (as_list (get [ "days" ] raw)) (as_list (get [ "days" ] named))

(* Under --raw the name IS the slug: that is what makes raw output byte-stable. *)
let test_raw_name_equals_slug () =
  let raw =
    V.of_days ~lang:Colitur_naming.Lang.raw ~sigla:Colitur_citation.Sigla.verbatim
      ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:2027 (days_of_year 2027)
  in
  List.iter
    (fun d -> Alcotest.(check string) "raw" (as_str (get [ "slug" ] d)) (as_str (get [ "name" ] d)))
    (as_list (get [ "days" ] raw))

(* Weekday, month, season, rank and colour must localise too -- a calendar in a
   language needs more than feast names. *)
let test_vocabularies_localise () =
  let v = view_named 2027 in
  let jan = List.hd (as_list (get [ "months" ] v)) in
  Alcotest.(check string) "month name" "Ianuarius" (as_str (get [ "name" ] jan));
  let d1 = List.hd (as_list (get [ "days" ] v)) in
  Alcotest.(check string) "weekday" "Feria VI" (as_str (get [ "weekday" ] d1));
  Alcotest.(check string) "rank" "I classis" (as_str (get [ "rank_name" ] d1));
  Alcotest.(check string) "colour" "albus" (as_str (get [ "colour_name" ] d1));
  Alcotest.(check string) "rite_name" "Missale Romanum, editio typica 1962"
    (as_str (get [ "rite_name" ] v))

(* A month answers to BOTH spellings of its own name. The week objects nested
   inside a month expose [month_name]/[month_num]/[month_abbr], so an author
   who learned those names there reaches for them one level up too -- and an
   unknown key renders as the EMPTY STRING by design, so the mistake produced
   a silently blank heading rather than any error. Found by writing a template
   from scratch; the shipped ones all sidestep it. *)
let test_month_answers_to_both_spellings () =
  let v = view_named 2027 in
  let jan = List.hd (as_list (get [ "months" ] v)) in
  let same a b =
    Alcotest.(check string) (a ^ " = " ^ b) (as_str (get [ a ] jan))
      (as_str (get [ b ] jan))
  in
  same "name" "month_name";
  same "num" "month_num";
  Alcotest.(check string) "month_name" "Ianuarius" (as_str (get [ "month_name" ] jan));
  Alcotest.(check bool) "month_abbr is present and non-empty" true
    (as_str (get [ "month_abbr" ] jan) <> "")

let suite =
  ( "View",
    [ Alcotest.test_case "year shape" `Quick test_year_shape;
      Alcotest.test_case "weeks flatten to days" `Quick test_weeks_flatten_to_days;
      Alcotest.test_case "padding cells flagged" `Quick test_padding_cells_are_flagged;
      Alcotest.test_case "first week flagged" `Quick test_first_week_flag;
      Alcotest.test_case "padding and real days share key set" `Quick test_padding_and_real_share_key_set;
      Alcotest.test_case "EF days never carry a second key" `Quick test_ef_days_never_carry_a_second_key;
      Alcotest.test_case "three-citation day exposes all three" `Quick test_three_citation_day_exposes_all_three;
      Alcotest.test_case "week num_roman and month fields" `Quick test_week_num_roman_and_month_fields;
      Alcotest.test_case "week date span" `Quick test_week_date_span;
      Alcotest.test_case "single_day agrees with span and cells" `Quick test_single_day_agrees_with_span_and_cells;
      Alcotest.test_case "no day shows a slug" `Quick test_no_day_shows_a_slug;
      Alcotest.test_case "slug unchanged by naming" `Quick test_slug_is_unchanged_by_naming;
      Alcotest.test_case "raw name equals slug" `Quick test_raw_name_equals_slug;
      Alcotest.test_case "vocabularies localise" `Quick test_vocabularies_localise;
      Alcotest.test_case "day fields" `Quick test_day_fields;
      Alcotest.test_case "exactly one colour flag" `Quick test_exactly_one_colour_flag ] )