module P = Colitur_kernel.Precedence
module Cel = Colitur_kernel.Celebration
module S = Colitur_kernel.Slug
module Col = Colitur_kernel.Colour
module D = Colitur_kernel.Date

type rank = Hi | Lo [@@deriving sexp]
type season = Green [@@deriving sexp]

let cand ?(origin = P.Sanctoral) ?(status = Cel.Feast) ~rank slug =
  { P.cel = Cel.make ~slug:(S.of_string_exn slug) ~rank ~status ~colour:Col.White
              ~layer:"base" (); origin }

let ctx =
  { P.date = (match D.make ~year:2026 ~month:7 ~day:15 with Ok d -> d | Error e -> failwith e);
    season = Green; weekday = D.Wed }

(* Band: Hi beats Lo. Temporal breaks a tie in its own favour. *)
let rules =
  { P.vigil_feast = (fun _ -> None); band = (fun _ c -> (match c.P.cel.Cel.rank with Hi -> 10 | Lo -> 20)
                         - (match c.P.origin with P.Temporal -> 1 | P.Sanctoral -> 0));
    disposition =
      (fun ~winner:_ ~loser ->
        match loser.P.cel.Cel.status with
        | Cel.Commemoration_only -> P.Commemorate P.Ordinary
        | Cel.Feast -> (match loser.P.cel.Cel.rank with
                        | Hi -> P.Transfer
                        | Lo -> P.Commemorate P.Ordinary));
    admit =
      (fun ~observed:_ ~temporal:_ cs ->
        List.filteri (fun i _ -> i < 2) cs |> List.map (fun (c, p, (_ : int)) -> (c, p))) }

let slug_of c = S.to_string c.P.cel.Cel.slug

let test_highest_band_wins () =
  let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Lo "feria")
            ~sanctoral:[ cand ~rank:Hi "big-feast" ] in
  Alcotest.(check string) "feast wins" "big-feast" (slug_of r.P.observed)

let test_temporal_wins_a_tie () =
  let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Hi "sunday")
            ~sanctoral:[ cand ~rank:Hi "saint" ] in
  Alcotest.(check string) "temporal wins tie" "sunday" (slug_of r.P.observed)

let test_loser_dispositions () =
  let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Hi "sunday")
            ~sanctoral:[ cand ~rank:Hi "transferable"; cand ~rank:Lo "commemorated" ] in
  Alcotest.(check (list string)) "deferred" [ "transferable" ]
    (List.map slug_of r.P.deferred);
  Alcotest.(check (list string)) "commemorated" [ "commemorated" ]
    (List.map (fun (c, _) -> slug_of c) r.P.commemorations)

(* A commemoration-only entry can never be observed, even at a winning band. *)
let test_commemoration_only_never_observed () =
  let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Lo "feria")
            ~sanctoral:[ cand ~rank:Hi ~status:Cel.Commemoration_only "suppressed" ] in
  Alcotest.(check string) "feria still observed" "feria" (slug_of r.P.observed);
  Alcotest.(check (list string)) "suppressed commemorated" [ "suppressed" ]
    (List.map (fun (c, _) -> slug_of c) r.P.commemorations)

(* Anything the admit limit drops is recorded in `omitted`, never dropped silently
   -- and each input candidate lands in exactly one bucket, not zero or two. *)
let test_nothing_silently_lost () =
  let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Hi "sunday")
            ~sanctoral:[ cand ~rank:Lo "a"; cand ~rank:Lo "b"; cand ~rank:Lo "c" ] in
  let bucketed =
    (slug_of r.P.observed
     :: List.map (fun (c, _) -> slug_of c) r.P.commemorations)
    @ List.map slug_of r.P.deferred
    @ List.map (fun (c, _) -> slug_of c) r.P.omitted
  in
  Alcotest.(check (slist string compare)) "every candidate appears exactly once"
    [ "a"; "b"; "c"; "sunday" ] bucketed;
  Alcotest.(check int) "two admitted" 2 (List.length r.P.commemorations)

(* The result must not depend on the order sanctoral candidates arrive in;
   ties break on slug, not on list position. *)
let test_order_independent () =
  let a = cand ~rank:Lo "a" and b = cand ~rank:Lo "b" and c = cand ~rank:Lo "c" in
  let t = cand ~origin:P.Temporal ~rank:Hi "sunday" in
  let observed_for sanctoral = slug_of (P.resolve rules ctx ~temporal:t ~sanctoral).P.observed in
  let comms_for sanctoral =
    List.map (fun (x, _) -> slug_of x) (P.resolve rules ctx ~temporal:t ~sanctoral).P.commemorations
  in
  List.iter
    (fun perm ->
      Alcotest.(check string) "same observed" (observed_for [ a; b; c ]) (observed_for perm);
      Alcotest.(check (list string)) "same commemorations" (comms_for [ a; b; c ]) (comms_for perm))
    [ [ c; b; a ]; [ b; a; c ]; [ c; a; b ] ]

(* The case the "pass temporal separately" design exists to make safe: a day
   with no sanctoral candidate at all. *)
let test_temporal_only_day () =
  let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Lo "feria")
            ~sanctoral:[] in
  Alcotest.(check string) "feria observed" "feria" (slug_of r.P.observed);
  Alcotest.(check int) "no commemorations" 0 (List.length r.P.commemorations);
  Alcotest.(check int) "nothing deferred" 0 (List.length r.P.deferred);
  Alcotest.(check int) "nothing omitted" 0 (List.length r.P.omitted)

let suite =
  ( "Precedence",
    [ Alcotest.test_case "highest band wins" `Quick test_highest_band_wins;
      Alcotest.test_case "temporal wins a tie" `Quick test_temporal_wins_a_tie;
      Alcotest.test_case "loser dispositions" `Quick test_loser_dispositions;
      Alcotest.test_case "commemoration-only never observed" `Quick
        test_commemoration_only_never_observed;
      Alcotest.test_case "nothing silently lost" `Quick test_nothing_silently_lost;
      Alcotest.test_case "order independent" `Quick test_order_independent;
      Alcotest.test_case "temporal-only day" `Quick test_temporal_only_day ] )