path: root/test/test_names.ml

module N = Colitur_kernel.Names
module L = Colitur_kernel.Lang
module C = Colitur_kernel.Citation
module DS = Colitur_kernel.Date_spec

(* Task: Date_spec.resolve now takes the rite's own Easter (movable specs).
   These fixtures are all [Fixed], so the value is irrelevant to them -- but it
   must be supplied, and the Gregorian one is the honest choice here. *)
let easter_of y = Colitur_kernel.Computus.gregorian_easter y
module D = Colitur_kernel.Date

let lang s = L.of_string_exn s

let test_names_basics () =
  let n = N.of_list [ (lang "pl", "Wielkanoc"); (lang "la", "Pascha") ] in
  Alcotest.(check (option string)) "find la" (Some "Pascha") (N.find n (lang "la"));
  Alcotest.(check (option string)) "find en" None (N.find n (lang "en"));
  Alcotest.(check (option string)) "fallback la then en"
    (Some "Pascha") (N.find_first n [ lang "en"; lang "la" ]);
  (* canonical order is by language code, so sexp output is byte-stable *)
  Alcotest.(check (list string)) "canonical order" [ "la"; "pl" ]
    (List.map (fun (l, _) -> L.to_string l) (N.to_list n))

let test_names_set_remove () =
  let n = N.of_list [ (lang "la", "Pascha") ] in
  let n = N.set n (lang "en") "Easter" in
  Alcotest.(check (option string)) "set en" (Some "Easter") (N.find n (lang "en"));
  let n = N.set n (lang "en") "Easter Sunday" in
  Alcotest.(check (option string)) "last writer wins" (Some "Easter Sunday") (N.find n (lang "en"));
  let n = N.remove n (lang "en") in
  Alcotest.(check (option string)) "removed" None (N.find n (lang "en"))

let test_names_of_list_duplicates () =
  (* of_list with duplicate language: last entry wins *)
  let n = N.of_list [ (lang "en", "Easter"); (lang "en", "Easter Sunday") ] in
  Alcotest.(check (option string)) "of_list last wins" (Some "Easter Sunday") (N.find n (lang "en"))

let test_names_sexp_canonical () =
  (* Two Names.t with different input order must serialize identically *)
  let n1 = N.of_list [ (lang "pl", "Wielkanoc"); (lang "la", "Pascha"); (lang "en", "Easter") ] in
  let n2 = N.of_list [ (lang "en", "Easter"); (lang "pl", "Wielkanoc"); (lang "la", "Pascha") ] in
  Alcotest.(check bool) "same sexp despite different input order"
    true (N.sexp_of_t n1 = N.sexp_of_t n2)

let test_names_sexp_roundtrip () =
  let n = N.of_list [ (lang "la", "Pascha"); (lang "en", "Easter") ] in
  let sexp = N.sexp_of_t n in
  let n' = N.t_of_sexp sexp in
  Alcotest.(check bool) "sexp roundtrip" true (n = n')

let test_citation () =
  let c = { C.part = C.Gospel; reference = "Jn 3:16" } in
  Alcotest.(check bool) "sexp roundtrip" true (C.t_of_sexp (C.sexp_of_t c) = c);
  Alcotest.(check string) "part string" "gospel" (C.part_to_string C.Gospel);
  Alcotest.(check bool) "part of_string" true (C.part_of_string "first" = Some C.First)

let test_date_spec () =
  (match DS.fixed ~month:3 ~day:25 with
   | Ok ds -> (
       match DS.resolve ds ~year:2026 ~easter:(easter_of 2026) with
       | Some d -> Alcotest.(check string) "resolve" "2026-03-25" (D.to_iso8601 d)
       | None -> Alcotest.fail "resolve returned None")
   | Error e -> Alcotest.failf "fixed: %s" e);
  (* Feb 29 is a legitimate fixed date that simply does not occur every year. *)
  (match DS.fixed ~month:2 ~day:29 with
   | Ok ds ->
       Alcotest.(check bool) "Feb 29 resolves in 2024" true (DS.resolve ds ~year:2024 ~easter:(easter_of 2024) <> None);
       Alcotest.(check bool) "Feb 29 absent in 2026" true (DS.resolve ds ~year:2026 ~easter:(easter_of 2026) = None)
   | Error e -> Alcotest.failf "Feb 29 must be constructible: %s" e);
  Alcotest.(check bool) "reject Feb 30" true (Result.is_error (DS.fixed ~month:2 ~day:30));
  Alcotest.(check bool) "reject Apr 31" true (Result.is_error (DS.fixed ~month:4 ~day:31));
  Alcotest.(check bool) "reject month 13" true (Result.is_error (DS.fixed ~month:13 ~day:1))

let test_date_spec_sexp_roundtrip () =
  (match DS.fixed ~month:3 ~day:25 with
   | Ok ds ->
       let sexp = DS.sexp_of_t ds in
       let ds' = DS.t_of_sexp sexp in
       Alcotest.(check bool) "sexp roundtrip" true (ds = ds')
   | Error e -> Alcotest.failf "fixed: %s" e)

let test_date_spec_sexp_validates () =
  (* Register finding 6: [ppx_sexp_conv]'s plain derived [t_of_sexp] would
     accept any in-range int pair for [Fixed], so [(Fixed(month 13)(day 1))]
     would silently deserialise into a spec that simply never resolves -- a
     saint quietly vanishing with no diagnostic. [t_of_sexp] now re-runs the
     value through [fixed], matching how [Slug] and [Lang] already validate
     on load. *)
  let bad = Sexplib.Sexp.of_string "(Fixed(month 13)(day 1))" in
  Alcotest.check_raises "month 13 rejected at load"
    (Sexplib0.Sexp_conv_error.Of_sexp_error
       (Failure "date_spec: month 13 out of range 1..12", bad))
    (fun () -> ignore (DS.t_of_sexp bad));
  let bad_day = Sexplib.Sexp.of_string "(Fixed(month 4)(day 31))" in
  Alcotest.check_raises "31 April rejected at load"
    (Sexplib0.Sexp_conv_error.Of_sexp_error
       (Failure "date_spec: day 31 out of range for month 4", bad_day))
    (fun () -> ignore (DS.t_of_sexp bad_day))

module Cel = Colitur_kernel.Celebration
module S = Colitur_kernel.Slug
module Col = Colitur_kernel.Colour
module Sub = Colitur_kernel.Subject

(* A throwaway rank vocabulary, to exercise the parametric type. *)
type demo_rank = High | Low [@@deriving sexp]

let test_celebration () =
  let c =
    Cel.make ~slug:(S.of_string_exn "ef-easter-sunday")
      ~names:(N.of_list [ (lang "la", "Dominica Resurrectionis") ])
      ~rank:High ~colour:Col.White ~subject:Sub.Lord ~layer:"temporal" ()
  in
  Alcotest.(check string) "slug" "ef-easter-sunday" (S.to_string c.Cel.slug);
  Alcotest.(check bool) "default citations empty" true (c.Cel.citations = []);
  let sexp = Cel.sexp_of_t sexp_of_demo_rank c in
  Alcotest.(check bool) "sexp roundtrip" true (Cel.t_of_sexp demo_rank_of_sexp sexp = c)

let test_celebration_status () =
  let c =
    Cel.make ~slug:(S.of_string_exn "telesphorus") ~rank:High ~colour:Col.Red
      ~subject:Sub.Saint ~layer:"tridentine" ()
  in
  Alcotest.(check bool) "defaults to Feast" true (c.Cel.status = Cel.Feast);
  let k =
    Cel.make ~slug:(S.of_string_exn "hyginus") ~rank:High ~colour:Col.Red
      ~status:Cel.Commemoration_only ~subject:Sub.Saint ~layer:"tridentine" ()
  in
  Alcotest.(check bool) "explicit status" true (k.Cel.status = Cel.Commemoration_only);
  let sexp = Cel.sexp_of_t sexp_of_demo_rank k in
  Alcotest.(check bool) "sexp roundtrip" true (Cel.t_of_sexp demo_rank_of_sexp sexp = k)

module Rec = Colitur_kernel.Record
module Voc = Colitur_kernel.Vocab
module Tmp = Colitur_kernel.Temporal

type demo_season = Ordinary [@@deriving sexp]

let demo_vocab : (demo_season, demo_rank) Voc.t =
  { seasons = [ Ordinary ];
    season_to_string = (fun Ordinary -> "ordinary");
    season_of_string = (function "ordinary" -> Some Ordinary | _ -> None);
    ranks = [ High; Low ];
    rank_to_string = (function High -> "high" | Low -> "low");
    rank_of_string = (function "high" -> Some High | "low" -> Some Low | _ -> None) }

let test_record () =
  let date = match D.make ~year:2026 ~month:4 ~day:5 with
    | Ok d -> d | Error e -> Alcotest.failf "%s" e
  in
  let office =
    Cel.make ~slug:(S.of_string_exn "ef-easter-sunday")
      ~names:(N.of_list [ (lang "la", "Dominica Resurrectionis") ])
      ~rank:High ~colour:Col.White ~subject:Sub.Lord ~layer:"temporal" ()
  in
  let t = { Tmp.season = Ordinary; week = Some 1; weekday = D.Sun; office } in
  let r = Rec.of_temporal ~rite:"ef" demo_vocab date t in
  Alcotest.(check string) "date" "2026-04-05" r.Rec.date;
  Alcotest.(check string) "season" "ordinary" r.Rec.season;
  Alcotest.(check string) "week" "1" r.Rec.week;
  Alcotest.(check string) "weekday" "sunday" r.Rec.weekday;
  Alcotest.(check string) "rank" "high" r.Rec.rank;
  Alcotest.(check string) "colour" "white" r.Rec.colour;
  Alcotest.(check string) "subject" "lord" r.Rec.subject;
  Alcotest.(check (list string)) "names flattened" [ "la" ]
    (List.map fst r.Rec.names);
  (* A day outside a numbered week renders week as the empty string, not "0". *)
  let r' = Rec.of_temporal ~rite:"ef" demo_vocab date { t with Tmp.week = None } in
  Alcotest.(check string) "no week" "" r'.Rec.week;
  (* Schema is pinned: headers and to_row derive from a single columns list,
     so alignment cannot drift. Assert the column names in order. *)
  Alcotest.(check (list string)) "headers schema"
    [ "date"; "rite"; "season"; "week"; "weekday"; "slug"; "rank"; "colour"; "subject" ]
    Rec.headers;
  (* Register finding 14: with headers and to_row both derived from the same
     [columns] list, equal length holds by construction -- a length-only
     check here is vacuous, since it cannot fail without headers and to_row
     already being defined from different sources. Assert the row's actual
     values, in header order, instead. *)
  Alcotest.(check (list string)) "row values in header order"
    [ "2026-04-05"; "ef"; "ordinary"; "1"; "sunday"; "ef-easter-sunday"; "high"; "white"; "lord" ]
    (Rec.to_row r)


(* ---- movable Date_spec variants (2026-08-17) ----
   Every date literal below was checked against `date -d` before being typed,
   the same rule test_golden.ml states for itself. Easter 2026 is 5 April. *)

let easter_2026 = easter_of 2026

let test_easter_offset_resolves () =
  let ds = match DS.easter_offset 38 with Ok d -> d | Error e -> failwith e in
  (* Easter 2026 = 5 April; +38 = 13 May, the Wednesday before Ascension --
     the offset Rogation Wednesday needs (RG 87). *)
  Alcotest.(check string) "Easter+38 in 2026" "2026-05-13"
    (match DS.resolve ds ~year:2026 ~easter:easter_2026 with Some d -> D.to_iso8601 d | None -> "none")

let test_easter_offset_zero_is_easter () =
  let ds = match DS.easter_offset 0 with Ok d -> d | Error e -> failwith e in
  Alcotest.(check string) "Easter+0 is Easter itself" "2026-04-05"
    (match DS.resolve ds ~year:2026 ~easter:easter_2026 with Some d -> D.to_iso8601 d | None -> "none")

let test_easter_offset_negative () =
  let ds = match DS.easter_offset (-46) with Ok d -> d | Error e -> failwith e in
  (* Ash Wednesday 2026 is 18 February, Easter-46. *)
  Alcotest.(check string) "Easter-46 is Ash Wednesday" "2026-02-18"
    (match DS.resolve ds ~year:2026 ~easter:easter_2026 with Some d -> D.to_iso8601 d | None -> "none")

let test_nth_weekday_first_sunday_october () =
  let ds = match DS.nth_weekday ~month:10 ~nth:1 ~weekday:D.Sun with Ok d -> d | Error e -> failwith e in
  (* 1 October 2026 is a Thursday, so the first Sunday is the 4th. *)
  Alcotest.(check string) "first Sunday of October 2026" "2026-10-04"
    (match DS.resolve ds ~year:2026 ~easter:easter_2026 with Some d -> D.to_iso8601 d | None -> "none")

let test_nth_weekday_last_sunday_october () =
  let ds = match DS.nth_weekday ~month:10 ~nth:(-1) ~weekday:D.Sun with Ok d -> d | Error e -> failwith e in
  Alcotest.(check string) "last Sunday of October 2026" "2026-10-25"
    (match DS.resolve ds ~year:2026 ~easter:easter_2026 with Some d -> D.to_iso8601 d | None -> "none")

let test_nth_weekday_absent_fifth () =
  let ds = match DS.nth_weekday ~month:10 ~nth:5 ~weekday:D.Sun with Ok d -> d | Error e -> failwith e in
  (* October 2026 has four Sundays (4, 11, 18, 25). A fifth is not an error --
     it simply does not occur, the same contract 29 February has. *)
  Alcotest.(check bool) "a fifth Sunday the month lacks resolves to None" true
    (DS.resolve ds ~year:2026 ~easter:easter_2026 = None)

let test_nth_weekday_february_leap_edge () =
  let ds = match DS.nth_weekday ~month:2 ~nth:(-1) ~weekday:D.Sat with Ok d -> d | Error e -> failwith e in
  (* 2024 is a leap year; 29 February is a Thursday, so the last Saturday is
     the 24th. Exercises the month-length probe against Date.make rather than
     a duplicated leap rule. *)
  Alcotest.(check string) "last Saturday of February 2024" "2024-02-24"
    (match DS.resolve ds ~year:2024 ~easter:(easter_of 2024) with Some d -> D.to_iso8601 d | None -> "none")

let test_movable_constructors_reject_nonsense () =
  Alcotest.(check bool) "nth = 0 rejected" true (Result.is_error (DS.nth_weekday ~month:10 ~nth:0 ~weekday:D.Sun));
  Alcotest.(check bool) "nth = 6 rejected" true (Result.is_error (DS.nth_weekday ~month:10 ~nth:6 ~weekday:D.Sun));
  Alcotest.(check bool) "nth = -6 rejected" true (Result.is_error (DS.nth_weekday ~month:10 ~nth:(-6) ~weekday:D.Sun));
  Alcotest.(check bool) "month 13 rejected" true (Result.is_error (DS.nth_weekday ~month:13 ~nth:1 ~weekday:D.Sun));
  Alcotest.(check bool) "offset 400 rejected" true (Result.is_error (DS.easter_offset 400));
  Alcotest.(check bool) "offset -400 rejected" true (Result.is_error (DS.easter_offset (-400)))

(* The failure this guards is INVISIBLE: an unvalidated spec deserialises into
   something that silently never resolves, and a celebration vanishes with no
   diagnostic anywhere. Date_spec quarantines the derived parser in [Repr] and
   re-validates in a hand-written [t_of_sexp] for exactly that reason; the two
   new variants are held to it too, or the guarantee is only partial. *)
let test_movable_sexp_parser_rejects_invalid () =
  List.iter
    (fun s ->
      Alcotest.(check bool)
        (Printf.sprintf "rejects %s" s)
        true
        (try
           ignore (DS.t_of_sexp (Sexplib.Sexp.of_string s));
           false
         with _ -> true))
    [ "(Nth_weekday (month 10) (nth 0) (weekday Sun))";
      "(Nth_weekday (month 13) (nth 1) (weekday Sun))";
      "(Nth_weekday (month 10) (nth 9) (weekday Sun))";
      "(Easter_offset 100000)";
      "(Easter_offset -100000)" ]

let test_movable_sexp_roundtrip () =
  List.iter
    (fun ds -> Alcotest.(check bool) "sexp round-trips" true (DS.t_of_sexp (DS.sexp_of_t ds) = ds))
    [ (match DS.fixed ~month:6 ~day:30 with Ok d -> d | Error e -> failwith e);
      (match DS.easter_offset 38 with Ok d -> d | Error e -> failwith e);
      (match DS.easter_offset (-63) with Ok d -> d | Error e -> failwith e);
      (match DS.nth_weekday ~month:10 ~nth:1 ~weekday:D.Sun with Ok d -> d | Error e -> failwith e);
      (match DS.nth_weekday ~month:10 ~nth:(-1) ~weekday:D.Sat with Ok d -> d | Error e -> failwith e) ]

(* Year-independent properties: the confidence-past-2050 mechanism. *)
let prop_nth_weekday_lands_correctly =
  QCheck.Test.make ~count:500 ~name:"Nth_weekday resolves into its own month with its own weekday"
    QCheck.(triple (int_range 1583 9998) (int_range 1 12) (int_range 1 5))
    (fun (year, month, nth) ->
      match DS.nth_weekday ~month ~nth ~weekday:D.Sun with
      | Error _ -> false
      | Ok ds -> (
          match DS.resolve ds ~year ~easter:(easter_of year) with
          | None -> true (* a 5th Sunday the month lacks: legitimate *)
          | Some d -> D.month d = month && D.weekday d = D.Sun))

let prop_easter_offset_is_exactly_that_offset =
  QCheck.Test.make ~count:500 ~name:"Easter_offset n resolves exactly n days from Easter"
    QCheck.(pair (int_range 1600 9900) (int_range (-60) 200))
    (fun (year, n) ->
      match DS.easter_offset n with
      | Error _ -> false
      | Ok ds -> (
          match DS.resolve ds ~year ~easter:(easter_of year) with
          | None -> false
          | Some d -> D.to_rata d - D.to_rata (easter_of year) = n))

let suite =
  ( "Names/Citation/DateSpec",
    [ Alcotest.test_case "names basics" `Quick test_names_basics;
      Alcotest.test_case "names set/remove" `Quick test_names_set_remove;
      Alcotest.test_case "names of_list duplicates" `Quick test_names_of_list_duplicates;
      Alcotest.test_case "names sexp canonical" `Quick test_names_sexp_canonical;
      Alcotest.test_case "names sexp roundtrip" `Quick test_names_sexp_roundtrip;
      Alcotest.test_case "citation" `Quick test_citation;
      Alcotest.test_case "date_spec" `Quick test_date_spec;
      Alcotest.test_case "date_spec sexp roundtrip" `Quick test_date_spec_sexp_roundtrip;
      Alcotest.test_case "date_spec sexp validates" `Quick test_date_spec_sexp_validates;
      Alcotest.test_case "Easter_offset resolves" `Quick test_easter_offset_resolves;
      Alcotest.test_case "Easter_offset 0 is Easter" `Quick test_easter_offset_zero_is_easter;
      Alcotest.test_case "Easter_offset negative" `Quick test_easter_offset_negative;
      Alcotest.test_case "Nth_weekday first Sunday" `Quick test_nth_weekday_first_sunday_october;
      Alcotest.test_case "Nth_weekday last Sunday" `Quick test_nth_weekday_last_sunday_october;
      Alcotest.test_case "Nth_weekday absent fifth" `Quick test_nth_weekday_absent_fifth;
      Alcotest.test_case "Nth_weekday February leap edge" `Quick test_nth_weekday_february_leap_edge;
      Alcotest.test_case "movable constructors reject nonsense" `Quick test_movable_constructors_reject_nonsense;
      Alcotest.test_case "movable sexp parser rejects invalid" `Quick test_movable_sexp_parser_rejects_invalid;
      Alcotest.test_case "movable sexp roundtrip" `Quick test_movable_sexp_roundtrip;
      Alcotest.test_case "celebration" `Quick test_celebration;
      Alcotest.test_case "celebration status" `Quick test_celebration_status;
      Alcotest.test_case "record" `Quick test_record ]
    @ List.map QCheck_alcotest.to_alcotest
        [ prop_nth_weekday_lands_correctly; prop_easter_offset_is_exactly_that_offset ] )