(* 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 ->
    temporal:'r candidate ->
    ('r candidate * privilege * int) list ->
    ('r candidate * privilege) list;
      (** the trailing [int] on each input triple is that candidate's own
          [band] value, computed once by {!resolve} below (a rite's [admit]
          has no [context] of its own to compute it with) -- see [resolve]'s
          own comment for why this is a KERNEL-level policy, not a rite-
          specific rule threaded in as data. *)
  vigil_feast : 'r candidate -> Slug.t option;
      (** RG 33's third omission trigger: the slug of the feast this candidate
          is a vigil OF, when the rite subjects that vigil to omission;
          [None] for every other candidate. See the .mli for the contract and
          for why the kernel asks the rite to NAME the feast rather than infer
          it. *)
}

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
  (* RG 113 (EF; docs/research/rules-register.md §4 "Commemorations"): "in
     admittendis et ordinandis aliis commemorationibus, servetur ordo
     tabellae praecedentiae" -- admitting AND ordering commemorations both
     run on the rite's own table of precedence, the same [band] already
     used above to pick [observed]. Computed here, once, generically (a
     rite's own [admit] has no [ctx] of its own to call [band] with) rather
     than inside every rite's [admit] separately -- a kernel-level POLICY
     ("commemorations are ordered by the rite's own band"), not a
     rite-specific RULE baked into the kernel: the actual [band] function,
     and whether a rite's [admit] even uses the value it is handed, both
     stay entirely rite-supplied. *)
  let comms_by_precedence = List.map (fun (c, p) -> (c, p, rules.band ctx c)) comms in
  let admitted = rules.admit ~observed ~temporal comms_by_precedence 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;
  }

(* RG 111(a): at most one commemoration, and it must be privileged -- see
   the .mli for the full citation and why this is a derivation over the
   admitted Low-Mass list rather than a second admission rule. [List.find_opt]
   keeps input order, which is already precedence order (RG 113), so "the
   first privileged entry, if any" is "the highest-precedence privileged
   entry, if any" -- the correct single survivor if more than one privileged
   commemoration were ever admitted together (not known to occur on any
   shipped rite's data, but not assumed impossible either: this reads the
   list rather than asserting its length). *)
let sung_mass_commemorations low_mass_set =
  match List.find_opt (fun (_, p) -> p = Privileged) low_mass_set with
  | Some c -> [ c ]
  | None -> []