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 *)
  triggers : Timedesc.Span.t list;  (** List of trigger offsets for alarms, in seconds *)
}
(** 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;
    triggers = [];
  }

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

(** Deterministic alarm function name tag derived from the event UID and date. Using both fields ensures uniqueness
    across calendars (UUID is globally unique) and between a master event and its date-specific overrides (which share
    the same UUID). *)
let alarm_hash rem =
  let key = rem.original_uuid ^ Timedesc.Date.to_rfc3339 rem.date in
  let h = String.fold_left (fun acc c -> ((acc * 1000003) + Char.code c) land 0x3FFFFFFF) 0 key in
  spf "%08x" h

(** Convert a Timedesc.Span.t to signed total minutes. Negative = before event; positive = after event. *)
let span_to_minutes (sp : Timedesc.Span.t) : int =
  let v = Timedesc.Span.For_human.view sp in
  let sign =
    match v.Timedesc.Span.For_human.sign with
    | `Pos -> 1
    | `Neg -> -1
  in
  sign * ((v.days * 1440) + (v.hours * 60) + v.minutes)

(** For timed events: keep only negative triggers, convert to positive minutes-before-event, sort ascending (closest to
    event first, suitable for SCHED sequence). *)
let timed_trigger_minutes (triggers : Timedesc.Span.t list) : int list =
  triggers
  |> List.filter_map (fun sp ->
      let m = span_to_minutes sp in
      if m >= 0 then None else Some (-m))
  |> List.sort_uniq compare

(** For all-day events: keep only negative triggers, convert to days-before-event (ceiling, min 1), deduplicate, sort
    descending (furthest first, suitable for WARN sequence). *)
let allday_trigger_days (triggers : Timedesc.Span.t list) : int list =
  triggers
  |> List.filter_map (fun sp ->
      let m = span_to_minutes sp in
      if m >= 0 then None
      else
        let abs_min = -m in
        let days = max 1 ((abs_min + 1439) / 1440) in
        Some days)
  |> List.sort_uniq compare
  |> List.rev

type alarm_rendering = {
  fset : string;  (** FSET line(s) to emit before REM, empty if none *)
  day_delta : string;  (** "++n " or "WARN name " or "" — inserted in trigger spec *)
  time_delta : string;  (** "+n " or "" — appended after AT time (single timed trigger) *)
  sched : string;  (** "SCHED name " or "" — appended after AT clause (multiple timed triggers) *)
}

let empty_alarm = { fset = ""; day_delta = ""; time_delta = ""; sched = "" }

(** Compute alarm rendering for a rem, depending on whether the event is timed or all-day and whether there are one or
    multiple triggers. *)
let render_alarm (rem : rem) : alarm_rendering =
  match rem.triggers with
  | [] -> empty_alarm
  | triggers ->
      if rem.time <> None then
        (* Timed event *)
        begin match timed_trigger_minutes triggers with
        | [] -> empty_alarm
        | [ n ] -> { empty_alarm with time_delta = spf "+%d " n }
        | mins ->
            let name = spf "sched_%s" (alarm_hash rem) in
            (* SCHED sequence: most-advance first (most negative), then 0 to stop.
           mins is sorted ascending (closest first), so reverse for SCHED order. *)
            let sched_vals = List.rev_map (fun n -> spf "%d" (-n)) mins @ [ "0" ] in
            let fset = spf "FSET %s(x) choose(x, %s)\n" name (String.concat ", " sched_vals) in
            { empty_alarm with fset; sched = spf "SCHED %s " name }
        end
      else
        (* All-day event *)
        begin match allday_trigger_days triggers with
        | [] -> empty_alarm
        | [ n ] -> { empty_alarm with day_delta = spf "++%d " n }
        | days ->
            let name = spf "warn_%s" (alarm_hash rem) in
            (* WARN sequence: furthest first (days sorted descending), then 0 to stop. *)
            let warn_vals = List.map string_of_int (days @ [ 0 ]) in
            let fset = spf "FSET %s(x) choose(x, %s)\n" name (String.concat ", " warn_vals) in
            { empty_alarm with fset; day_delta = spf "WARN %s " name }
        end

(* ── buffer primitives ────────────────────────────────────────── *)
let add_rem b = Buffer.add_string b "REM "
let add_uid b uuid = if not !Config.no_uuid then Buffer.add_string b (spf "\\\n    INFO \"UID: %s\" " uuid)

let add_source b source =
  if not !Config.no_source then
    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 (alarm : alarm_rendering) = function
  | Some t -> Buffer.add_string b (spf " AT %s %s%s" (string_of_time t) alarm.time_delta alarm.sched)
  | 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 ?(alarm = empty_alarm) ?(timed = false) summary =
  let has_alarm = alarm.day_delta <> "" || alarm.time_delta <> "" || alarm.sched <> "" in
  let body = escape_msg summary in
  let body =
    if has_alarm then if timed then spf "%%\"%s%%\" (%%b %%3)" body else spf "%%\"%s%%\" (%%b)" body else body
  in
  Buffer.add_string b (spf " MSG %s\n" body)

let add_location b loc =
  if not !Config.no_location then
    match loc with
    | Some loc ->
        let loc = String.trim loc in
        Buffer.add_string b (spf "\\\n    INFO \"Location: %s\" " (escape_msg loc))
    | None -> ()

let add_description b desc =
  if not !Config.no_description then
    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 =
  if not !Config.no_conference_url then
    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;
  Buffer.add_string b "\\\n    "

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
  let alarm = render_alarm rem in
  Buffer.add_string b alarm.fset;
  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;
  Buffer.add_string b alarm.day_delta;
  add_skip b rem.exdate;
  add_at b alarm rem.time;
  add_duration b rem.duration;
  add_msg b ~alarm ~timed:(rem.time <> None) rem.summary;
  close_omit_context b rem.exdate;
  Buffer.contents b

let render_weekly rem (w : simple_weekly) =
  let b = Buffer.create 256 in
  let alarm = render_alarm rem in
  Buffer.add_string b alarm.fset;
  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;
      Buffer.add_string b alarm.day_delta;
      add_skip b rem.exdate;
      add_at b alarm rem.time;
      add_duration b rem.duration;
      add_msg b ~alarm ~timed:(rem.time <> None) 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
  let alarm = render_alarm rem in
  Buffer.add_string b alarm.fset;
  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;
  Buffer.add_string b alarm.day_delta;
  add_skip b rem.exdate;
  add_at b alarm rem.time;
  add_duration b rem.duration;
  add_msg b ~alarm ~timed:(rem.time <> None) rem.summary;
  close_omit_context b rem.exdate;
  Buffer.contents b

let render_single rem =
  let b = Buffer.create 256 in
  let alarm = render_alarm rem in
  Buffer.add_string b alarm.fset;
  add_common_part b rem;
  add_date b rem.date;
  Buffer.add_char b ' ';
  Buffer.add_string b alarm.day_delta;
  add_at b alarm rem.time;
  add_duration b rem.duration;
  add_through b rem.end_date;
  add_msg b ~alarm ~timed:(rem.time <> None) rem.summary;
  Buffer.contents b

let render_yearly rem month day =
  let b = Buffer.create 64 in
  let alarm = render_alarm rem in
  Buffer.add_string b alarm.fset;
  add_common_part b rem;
  Buffer.add_string b (spf "%s %d " (month_of_int month |> string_of_month) day);
  Buffer.add_string b alarm.day_delta;
  add_at b alarm rem.time;
  add_msg b ~alarm ~timed:(rem.time <> None) 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)