ical2rem/bin/remind.ml

open Utils

type week_first_day = [ `Sunday | `Monday ]

type simple_weekly = {
  count_or_until : Icalendar.count_or_until option;
  interval : int option;  (** Optional interval for weekly recurrence, default is 1 *)
  byday : Icalendar.weekday list;
  week_start : week_first_day option;  (** First day of the week for weekly recurrence *)
}
(** A simple weekly REM command *)

type simple_daily = {
  count_or_until : Icalendar.count_or_until option;
  interval : int option;  (** Optional interval for daily recurrence, default is 1 *)
  week_start : week_first_day option;  (** First day of the week for weekly recurrence *)
}
(** A simple daily REM command *)

type monthly_pattern =
  | By_month_day of int  (** P07: BYMONTHDAY=n or implicit day from DTSTART *)
  | By_nth_weekday of int * Icalendar.weekday  (** P08: BYDAY=nWD, n≠0, can be negative *)

type simple_monthly = {
  count_or_until : Icalendar.count_or_until option;
  interval : int option;
  pattern : monthly_pattern;
}
(** A simple monthly REM command *)

type rem = {
  source : string;  (** Source file or identifier for the reminder *)
  original_uuid : string;  (** Original UID from the iCalendar event *)
  original_event : Icalendar.event option;  (** The original iCalendar event *)
  summary : string;  (** Summary or title of the reminder *)
  location : string option;  (** Optional location of the event *)
  description : string option;  (** Optional description of the event *)
  conference_url : string option;  (** Optional conference URL for virtual meetings *)
  date : Timedesc.Date.t;  (** Date specification (day, month, year) *)
  end_date : Timedesc.Date.t option;  (** Optional end date for a date range *)
  time : Timedesc.Time.t option;  (** Optional time specification (hour, minute) *)
  duration : Timedesc.Span.t option;  (** Optional duration for timed events *)
  yearly : (int * int) option;  (** Optional simple yearly recurrence (month, day) *)
  monthly : simple_monthly option;  (** Optional simple monthly recurrence *)
  weekly : simple_weekly option;  (** Optional simple weekly recurrence *)
  daily : simple_daily option;  (** Optional simple daily recurrence *)
  recurring : Icalendar.event list;
      (** List of events that are part of the same recurring series: these are only the overrides, not the master event
      *)
  exdate : Icalendar.date_or_datetime list;  (** List of excluded dates for recurring events *)
  overrides : rem list;  (** Single-event REMs generated from non-cancelled RECURRENCE-ID overrides *)
  tz : Timedesc.Time_zone.t option;  (** Timezone of the event's DTSTART, used for UNTIL conversion *)
}
(** A complete REM command *)

let empty =
  {
    source = "";
    original_uuid = "";
    original_event = None;
    summary = "";
    location = None;
    description = None;
    conference_url = None;
    date = Timedesc.Date.Ymd.make_exn ~year:1970 ~month:1 ~day:1;
    end_date = None;
    time = None;
    duration = None;
    yearly = None;
    monthly = None;
    weekly = None;
    daily = None;
    recurring = [];
    exdate = [];
    overrides = [];
    tz = None;
  }

(* ── buffer primitives ────────────────────────────────────────── *)

let add_rem b = Buffer.add_string b "REM "
let add_uid b uuid = Buffer.add_string b (spf "\\\n    INFO \"UID: %s\" " uuid)
let add_source b source = Buffer.add_string b (spf "\\\n    INFO \"Calendar: %s\" " (String.uppercase_ascii source))
let add_date b date = Buffer.add_string b (Timedesc.Date.to_rfc3339 date)
let add_weekday b wd = Buffer.add_string b (spf "%s " (string_of_weekday wd))

let add_interval b (w : simple_weekly) =
  let n = Option.value ~default:1 w.interval in
  Buffer.add_string b (spf "*%d " (n * 7))

let add_interval_daily b (d : simple_daily) =
  let n = Option.value ~default:1 d.interval in
  Buffer.add_string b (spf "*%d " n)

(** Adjust an UNTIL date: if the event has a start time and the local time of the UNTIL timestamp is strictly before
    that start time, the last valid occurrence is on the previous day. *)
let until_date_adjusted (until_ts : Timedesc.t) (event_time : Timedesc.Time.t option) : Timedesc.Date.t =
  let until_date = Timedesc.date until_ts in
  match event_time with
  | None -> until_date
  | Some evt_t ->
      let until_t = Timedesc.time until_ts in
      let cmp = Timedesc.Span.compare (Timedesc.Time.to_span until_t) (Timedesc.Time.to_span evt_t) in
      if cmp < 0 then Timedesc.Date.add ~days:(-1) until_date else until_date

let add_until b rem (w : simple_weekly) =
  match w.count_or_until with
  | None -> ()
  | Some (`Until d) ->
      let tz = Option.value ~default:(Timedesc.Time_zone.local_exn ()) rem.tz in
      let ts = timedesc_of_utc_or_timestamp_tz tz d in
      let date = until_date_adjusted ts rem.time in
      Buffer.add_string b (spf "UNTIL %s " (Timedesc.Date.to_rfc3339 date))
  | Some (`Count count) ->
      let wd = Timedesc.Date.weekday rem.date in
      let wd_int = Timedesc.Utils.tm_int_of_weekday wd in
      let sub =
        match w.week_start with
        | Some `Monday -> wd_int - 1
        | _ -> wd_int
      in
      let iv = Option.value ~default:1 w.interval in
      let until = Timedesc.Date.add ~days:((count * 7 * iv) - sub) rem.date in
      Buffer.add_string b (spf "UNTIL %s " (Timedesc.Date.to_rfc3339 until))

let add_until_daily b rem (d : simple_daily) =
  match d.count_or_until with
  | None -> ()
  | Some (`Until dt) ->
      let tz = Option.value ~default:(Timedesc.Time_zone.local_exn ()) rem.tz in
      let ts = timedesc_of_utc_or_timestamp_tz tz dt in
      let date = until_date_adjusted ts rem.time in
      Buffer.add_string b (spf "UNTIL %s " (Timedesc.Date.to_rfc3339 date))
  | Some (`Count count) ->
      let iv = Option.value ~default:1 d.interval in
      let until = Timedesc.Date.add ~days:((count - 1) * iv) rem.date in
      Buffer.add_string b (spf "UNTIL %s " (Timedesc.Date.to_rfc3339 until))

let add_until_monthly b rem (m : simple_monthly) =
  match m.count_or_until with
  | None -> ()
  | Some (`Until dt) ->
      let tz = Option.value ~default:(Timedesc.Time_zone.local_exn ()) rem.tz in
      let ts = timedesc_of_utc_or_timestamp_tz tz dt in
      let date = until_date_adjusted ts rem.time in
      Buffer.add_string b (spf "UNTIL %s " (Timedesc.Date.to_rfc3339 date))
  | Some (`Count count) ->
      let base = Utils.add_months rem.date (count - 1) in
      let until =
        match m.pattern with
        | By_month_day _ -> base
        | By_nth_weekday _ -> Timedesc.Date.add ~days:6 base (* weekday can shift up to 6 days *)
      in
      Buffer.add_string b (spf "UNTIL %s " (Timedesc.Date.to_rfc3339 until))

let add_at b = function
  | Some t -> Buffer.add_string b (spf " AT %s" (string_of_time t))
  | None -> ()

let add_duration b = function
  | Some d -> Buffer.add_string b (spf " DURATION %s" (string_of_span d))
  | None -> ()

let add_through b = function
  | Some d -> Buffer.add_string b (spf " THROUGH %s" (Timedesc.Date.to_rfc3339 d))
  | None -> ()

(** Escape special characters in the body of a MSG clause.
    - '%' must become '%%' (literal percent)
    - '[' must become '["["]' (a Remind expression that evaluates to the literal string "[") *)
let escape_msg s =
  let buf = Buffer.create (String.length s) in
  String.iter
    (function
      | '\n' -> Buffer.add_string buf "\\n"
      | '\t' -> ()
      | '"' -> Buffer.add_string buf "\\\""
      | '%' -> Buffer.add_string buf "%%"
      | '[' -> Buffer.add_string buf {|["["]|}
      | c -> Buffer.add_char buf c)
    s;
  Buffer.contents buf

let add_msg b summary = Buffer.add_string b (spf " MSG %s\n" (escape_msg summary))

let add_location b loc =
  match loc with
  | Some loc -> begin
      let loc = String.trim loc in
      Buffer.add_string b (spf "\\\n    INFO \"Location: %s\" " (escape_msg loc))
    end
  | None -> ()

let add_description b desc =
  match desc with
  | Some desc ->
      let desc = String.trim desc in
      Buffer.add_string b (spf "\\\n    INFO \"Description: %s\" " (escape_msg desc))
  | None -> ()

let add_url b url =
  match url with
  | Some url ->
      let url = String.trim url in
      Buffer.add_string b (spf "\\\n    INFO \"Url: %s\" " (escape_msg url))
  | None -> ()

let add_common_part b rem =
  add_rem b;
  add_uid b rem.original_uuid;
  add_source b rem.source;
  add_location b rem.location;
  add_description b rem.description;
  add_url b rem.conference_url

let date_of_date_or_datetime (d : Icalendar.date_or_datetime) : Timedesc.Date.t =
  match d with
  | `Date (year, month, day) -> Timedesc.Date.Ymd.make_exn ~year ~month ~day
  | `Datetime ts -> Timedesc.date (timedesc_of_timestamp ts)

let add_omit b (d : Icalendar.date_or_datetime) =
  let date = date_of_date_or_datetime d in
  let day = Timedesc.Date.day date in
  let month = string_of_month (month_of_int (Timedesc.Date.month date)) in
  let year = Timedesc.Date.year date in
  Buffer.add_string b (spf "OMIT %d %s %d\n" day month year)

let add_omit_context b exdates =
  if exdates <> [] then begin
    Buffer.add_string b "PUSH-OMIT-CONTEXT\n";
    List.iter (add_omit b) exdates
  end

let close_omit_context b exdates = if exdates <> [] then Buffer.add_string b "POP-OMIT-CONTEXT\n"
let add_skip b exdates = if exdates <> [] then Buffer.add_string b "SKIP "

(* ── rendering ────────────────────────────────────────────────── *)

let render_daily rem (d : simple_daily) =
  let b = Buffer.create 256 in
  add_omit_context b rem.exdate;
  add_common_part b rem;
  add_date b rem.date;
  Buffer.add_char b ' ';
  add_interval_daily b d;
  add_until_daily b rem d;
  add_skip b rem.exdate;
  add_at b rem.time;
  add_duration b rem.duration;
  add_msg b rem.summary;
  close_omit_context b rem.exdate;
  Buffer.contents b

let render_weekly rem (w : simple_weekly) =
  let b = Buffer.create 256 in
  add_omit_context b rem.exdate;
  List.iter
    (fun wd ->
      add_common_part b rem;
      add_weekday b wd;
      add_date b rem.date;
      Buffer.add_char b ' ';
      add_interval b w;
      add_until b rem w;
      add_skip b rem.exdate;
      add_at b rem.time;
      add_duration b rem.duration;
      add_msg b rem.summary)
    w.byday;
  close_omit_context b rem.exdate;
  Buffer.contents b

let render_monthly rem (m : simple_monthly) =
  let b = Buffer.create 256 in
  add_omit_context b rem.exdate;
  add_common_part b rem;
  (match m.pattern with
  | By_month_day day -> Buffer.add_string b (spf "%d " day)
  | By_nth_weekday (n, wd) when n > 0 ->
      let day = ((n - 1) * 7) + 1 in
      add_weekday b wd;
      Buffer.add_string b (spf "%d " day)
  | By_nth_weekday (n, wd) (* n < 0 *) ->
      let back = -n * 7 in
      add_weekday b wd;
      Buffer.add_string b (spf "1 --%d " back));
  Buffer.add_string b (spf "FROM %s " (Timedesc.Date.to_rfc3339 rem.date));
  add_until_monthly b rem m;
  add_skip b rem.exdate;
  add_at b rem.time;
  add_duration b rem.duration;
  add_msg b rem.summary;
  close_omit_context b rem.exdate;
  Buffer.contents b

let render_single rem =
  let b = Buffer.create 256 in
  add_common_part b rem;
  add_date b rem.date;
  add_at b rem.time;
  add_duration b rem.duration;
  add_through b rem.end_date;
  add_msg b rem.summary;
  Buffer.contents b

let render_yearly rem month day =
  let b = Buffer.create 64 in
  add_common_part b rem;
  Buffer.add_string b (spf "%s %d" (month_of_int month |> string_of_month) day);
  add_msg b rem.summary;
  Buffer.contents b

(* ── dispatcher ───────────────────────────────────────────────── *)

let string_of_rem rem =
  let main =
    match rem.daily with
    | Some d -> render_daily rem d
    | None -> (
        match rem.weekly with
        | Some w -> render_weekly rem w
        | None -> (
            match rem.monthly with
            | Some m -> render_monthly rem m
            | None -> (
                match rem.yearly with
                | Some (month, day) -> render_yearly rem month day
                | None -> render_single rem)))
  in
  let overrides = List.map render_single rem.overrides in
  String.concat "" (main :: overrides)