(* The rite-parameterised resolver. RG 91 says who wins; RG 92-95 says what
   happens to the loser; RG 108-111 says how many commemorations are admitted.
   Three separate functions, because the loser's fate depends on the loser's own
   rank, not the winner's. *)
open Sexplib0.Sexp_conv

type origin = Temporal | Sanctoral [@@deriving sexp]
type privilege = Privileged | Ordinary [@@deriving sexp]
type disposition = Omit | Commemorate of privilege | Transfer | Repose [@@deriving sexp]

type 'r candidate = { cel : 'r Celebration.t; origin : origin } [@@deriving sexp]

type 's context = { date : Date.t; season : 's; weekday : Date.weekday }

type ('s, 'r) rules = {
  band : 's context -> 'r candidate -> int;
  disposition : winner:'r candidate -> loser:'r candidate -> disposition;
  admit :
    observed:'r candidate ->
    ('r candidate * privilege) list ->
    ('r candidate * privilege) list;
}

type 'r resolution = {
  observed : 'r candidate;
  commemorations : ('r candidate * privilege) list;
  deferred : 'r candidate list;
  omitted : ('r candidate * string) list;
}

(* Ties break on slug so the result never depends on input order. *)
let compare_by rules ctx a b =
  let ba = rules.band ctx a and bb = rules.band ctx b in
  if ba <> bb then Int.compare ba bb
  else Slug.compare a.cel.Celebration.slug b.cel.Celebration.slug

let resolve rules ctx ~temporal ~sanctoral =
  (* A commemoration-only entry can never be observed (see Celebration.status),
     so it is held out of the contest entirely rather than relying on its band. *)
  let eligible, forced_comm =
    List.partition
      (fun c -> c.cel.Celebration.status = Celebration.Feast)
      sanctoral
  in
  let sorted = List.stable_sort (compare_by rules ctx) (temporal :: eligible) in
  let observed = List.hd sorted in
  let losers = List.tl sorted @ forced_comm in
  let comms, deferred, omitted =
    List.fold_left
      (fun (comms, defs, omits) l ->
        match rules.disposition ~winner:observed ~loser:l with
        | Commemorate p -> ((l, p) :: comms, defs, omits)
        | Transfer | Repose -> (comms, l :: defs, omits)
        | Omit -> (comms, defs, (l, "omitted: yielded to a higher day") :: omits))
      ([], [], []) losers
  in
  let comms = List.rev comms and deferred = List.rev deferred in
  let admitted = rules.admit ~observed comms in
  let dropped =
    List.filter (fun c -> not (List.exists (fun a -> fst a == fst c) admitted)) comms
  in
  {
    observed;
    commemorations = admitted;
    deferred;
    omitted =
      List.rev omitted
      @ List.map (fun (c, _) -> (c, "omitted: admission limit reached")) dropped;
  }