(* See lectionary_of.mli for the full citations and design argument. *)
open Colitur_kernel

type sunday_cycle = Year_a | Year_b | Year_c
type weekday_cycle = Year_i | Year_ii

let sunday_cycle_letter = function Year_a -> "a" | Year_b -> "b" | Year_c -> "c"
let weekday_cycle_letter = function Year_i -> "i" | Year_ii -> "ii"

(* The civil year in which the liturgical year CONTAINING [date] opened --
   i.e. the year y such that [year_start y <= date < year_start (y + 1)].
   This is the one piece of arithmetic both cycle rules share, and it is
   exactly the "get the boundary right" the task brief names: a date in,
   say, early December belongs to the liturgical year that opened THAT
   same Advent only once Advent has actually started that year (compared
   by real date, not by month) -- a month-based shortcut ("December always
   means the new liturgical year") is wrong in the (real, if rare) case of
   a December date still ahead of that year's own Advent I. *)
let liturgical_year_open_year ~year_start date =
  let y = Date.year date in
  if Date.compare date (year_start y) >= 0 then y else y - 1

(* OLM n.66 + footnote 102 (mli's own citation): the LABEL year is the one
   most of the liturgical year falls in, i.e. one more than the year
   Advent opened in ("a prima hebdomada Adventus, quae cadit in anno
   civili praecedente" -- the first week of Advent falls in the PRECEDING
   civil year relative to the label). Divisible by 3 -> C, then A, then B,
   worked example 1980=C/1981=A/1982=B/1983=C verified against the real
   page image. *)
let sunday_cycle ~year_start date =
  let label = liturgical_year_open_year ~year_start date + 1 in
  match label mod 3 with 0 -> Year_c | 1 -> Year_a | _ -> Year_b

(* OLM n.69 point 4 (mli's own citation): "Annus primus adhibetur annis
   imparibus, annus secundus vero annis paribus" -- Year I in odd label
   years, Year II in even. Same label-year computation as [sunday_cycle]
   above, for the identical reason: this is a two-year cycle, not a
   three-year one, but the label-year definition itself does not depend on
   which modulus governs it. *)
let weekday_cycle ~year_start date =
  let label = liturgical_year_open_year ~year_start date + 1 in
  if label mod 2 = 1 then Year_i else Year_ii

(* Tries [base] flat, then [base]-<sunday letter>, then [base]-<weekday
   letter>, in that order. Safe unconditionally: tools/
   bootstrap_lectionary_of.ml emits a given base under AT MOST ONE of
   these three forms (a flat entry when the two/three cycle years were
   byte-identical, a cycle-lettered family otherwise -- never both), so at
   most one of the three lookups below can ever hit, and trying the two
   irrelevant forms for a family of the other kind or a flat family is
   simply two wasted, harmless misses. This is what lets [readings] below
   stay ignorant of which of the two cycle systems (or neither) a given
   slug's own family actually uses. *)
let lookup_any lectionary ~year_start base date =
  match Lectionary.find lectionary base with
  | Some cs -> Some cs
  | None -> (
      let with_suffix suffix = Slug.of_string_exn (Slug.to_string base ^ "-" ^ suffix) in
      match Lectionary.find lectionary (with_suffix (sunday_cycle_letter (sunday_cycle ~year_start date))) with
      | Some cs -> Some cs
      | None -> Lectionary.find lectionary (with_suffix (weekday_cycle_letter (weekday_cycle ~year_start date))))

(* See lectionary_of.mli's own doc comment for the full citation (OLM n.
   69.3) and argument. Kept as ordinary [Printf.sprintf] string
   construction, not a lookup table, so tools/bootstrap_lectionary_of.ml's
   own reachability sweep (which calls this function directly, not a
   hand-copied re-implementation) and this module's own runtime lookup can
   never drift apart -- the single failure mode a hand-duplicated version
   in each place would invite. *)
let date_keyed_slug date =
  if Date.weekday date = Date.Sun then None
  else
    let m = Date.month date and dd = Date.day date in
    if m = 12 && dd >= 17 && dd <= 24 then Some (Slug.of_string_exn (Printf.sprintf "of-advent-dec-%d" dd))
    else if m = 12 && dd >= 29 && dd <= 31 then
      Some (Slug.of_string_exn (Printf.sprintf "of-christmas-dec-%d" dd))
    else if m = 1 && ((dd >= 2 && dd <= 5) || dd = 7) then
      Some (Slug.of_string_exn (Printf.sprintf "of-christmas-jan-%d" dd))
    else None

let readings ~lectionary ~year_start ~(observed : Vocab_of.rank Celebration.t)
    ~(temporal : (Vocab_of.season, Vocab_of.rank) Temporal.t) ~date ~temporal_at:_ =
  match observed.Celebration.citations with
  | _ :: _ as cs ->
      (Some { Mass_formulary.said = Some observed.Celebration.slug; via = Mass_formulary.Proper }, cs)
  | [] -> (
      (* Step 2: a sanctoral entity actually won the day -- i.e. the
         observed celebration is not itself the day's own temporal office.
         Same guard shape as Rite_ef.Lectionary_ef.readings' own step 4
         (see that module's implementation comment for the full argument
         for why this comparison, not a [subject]/[status] test, is the
         right one): comparing SLUGS is exact whenever the temporal and
         sanctoral streams cannot collide, which holds here for the
         identical reason it holds for EF -- every Temporal_of slug this
         module ever constructs carries the "of-" prefix (temporal_of.ml's
         own [temporal], every branch), and 0 of the 222 shipped
         data/of/calendar-2002.sexp + amendments sanctoral slugs do. *)
      let sanctoral_office =
        not (Slug.equal observed.Celebration.slug temporal.Temporal.office.Celebration.slug)
      in
      match
        if sanctoral_office then lookup_any lectionary ~year_start observed.Celebration.slug date else None
      with
      | Some cs ->
          (* Mass_formulary.Proper, not .Common -- see lectionary_of.mli's
             own doc comment on this branch for the full argument. In
             short: EF's [Common] constructor names a SPECIFIC mechanism
             (several saints sharing one formulary via an explicit
             assignment table, data/ef/commons.sexp) that OF's own data has
             no counterpart for -- every sanctoral slug this step resolves
             carries its OWN dedicated lectio entry, not a shared one, so
             relabelling it [Common] would claim a mechanism that is not
             actually present. [Proper] is the honest fit: "the observed
             celebration's own proper Mass", true regardless of whether the
             citations are embedded on Celebration.t (step 1) or held
             externally in [lectionary] (this step) -- a storage detail
             Mass_formulary.source was never built to carry. *)
          (Some { Mass_formulary.said = Some observed.Celebration.slug; via = Mass_formulary.Proper }, cs)
      | None -> (
          (* OLM n. 69.3's own date-fixed windows (see date_keyed_slug's
             own doc comment): tried BEFORE the ordinary weekday-keyed
             slug lookup, not instead of it, so every other temporal day
             is unaffected -- this branch only ever hits inside the two
             named civil-date windows, and [date_keyed_slug] itself
             already refuses a Sunday, where a NAMED Sunday office (never
             one of these weekday-keyed ferial slugs) is what temporal.
             office actually names. *)
          match (match date_keyed_slug date with Some s -> Lectionary.find lectionary s | None -> None) with
          | Some cs ->
              ( Some { Mass_formulary.said = Some temporal.Temporal.office.Celebration.slug;
                       via = Mass_formulary.Own_slug },
                cs )
          | None -> (
              match lookup_any lectionary ~year_start temporal.Temporal.office.Celebration.slug date with
              | Some cs ->
                  ( Some { Mass_formulary.said = Some temporal.Temporal.office.Celebration.slug;
                           via = Mass_formulary.Own_slug },
                    cs )
              | None -> (None, []))))