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 = V.of_days ~lang:(Lazy.force default_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)) 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) <> "") (* 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" 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 = V.of_days ~lang:(latin ()) ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y (days_of_year y) (* 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 ~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 ~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)) 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 "padding and real days share key set" `Quick test_padding_and_real_share_key_set; 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 ] )