(* EF (1962) temporal cycle. Every boundary and rank rule cites its Rubricae
   Generales paragraph; see docs/research/rules-register.md §3-§4. *)

open Colitur_kernel
open Vocab_ef

let mk y m d =
  match Date.make ~year:y ~month:m ~day:d with
  | Ok t -> t
  | Error e -> failwith ("temporal_ef: " ^ e)

let weekday_index d =
  match Date.weekday d with
  | Date.Sun -> 0 | Date.Mon -> 1 | Date.Tue -> 2 | Date.Wed -> 3
  | Date.Thu -> 4 | Date.Fri -> 5 | Date.Sat -> 6

(* The Sunday on or before [d]. *)
let sunday_on_or_before d = Date.add_days d (-(weekday_index d))

(* RG 71: Advent I is the Sunday nearest 30 November -- equivalently the fourth
   Sunday before Christmas, i.e. three weeks before the last Sunday on or before
   24 December. *)
let advent_start y = Date.add_days (sunday_on_or_before (mk y 12 24)) (-21)
let year_start = advent_start

let before a b = Date.compare a b < 0
let on_or_after a b = Date.compare a b >= 0

(* RG 71-77. Tested in chronological order within the civil year. *)
let season d =
  let y = Date.year d in
  let easter = Computus.gregorian_easter y in
  let advent_this = advent_start y in
  let christmas_this = mk y 12 25 in
  let jan14 = mk y 1 14 in
  let septuagesima_sunday = Date.add_days easter (-63) in
  let ash_wednesday = Date.add_days easter (-46) in
  let passion_sunday = Date.add_days easter (-14) in
  let paschal_end = Date.add_days easter 55 in
  if on_or_after d advent_this && before d christmas_this then Advent (* RG 71 *)
  else if on_or_after d christmas_this then Christmastide (* RG 72-73: 25-31 Dec *)
  else if before d jan14 then Christmastide (* RG 72-73: 1-13 Jan inclusive *)
  else if before d septuagesima_sunday then Time_after_epiphany (* RG 77: from 14 Jan *)
  else if before d ash_wednesday then Septuagesima (* RG 73 *)
  else if before d passion_sunday then Lent (* RG 74 *)
  else if before d easter then Passiontide (* RG 75; Holy Saturday included *)
  else if Date.compare d paschal_end <= 0 then Paschaltide (* RG 76 *)
  else Time_after_pentecost (* RG 77 *)