feat(remind): implement alarm rendering for triggers

Remove debug logging from `collect_triggers` and `separate_master_and_recurrence`, and add full alarm rendering support: convert `Timedesc.Span.t` triggers to `++n`/`WARN`/`+n`/`SCHED` remind syntax for both all-day and timed events, with dynamic `FSET` generation for multiple triggers and annotated `MSG` bodies showing advance notice.
2026-05-23 19:20:22 +02:00
parent 45ce27f72b
commit 33660db642
3 changed files with 119 additions and 20 deletions
--- a/bin/eventPredicates.ml
+++ b/bin/eventPredicates.ml
@@ -111,12 +111,6 @@ let collect_exdates rem ev : (Remind.rem, error) result =

 let collect_triggers rem ev : (Remind.rem, error) result =
  let triggers = Utils.get_triggers ev in
-  if List.length triggers > 0 then begin
-    Printf.eprintf "UID: %s\n" (Utils.get_uid ev);
-    ListLabels.iteri triggers ~f:(fun i trigger ->
-        Printf.eprintf "  Trigger %d: %s\n" (i + 1) (Timedesc.Span.to_string trigger));
-    Printf.eprintf "\n"
-  end;
  Ok { rem with Remind.triggers }

 let yearly_simple_date rem ev : (Remind.rem, error) result =
--- a/bin/remind.ml
+++ b/bin/remind.ml
@@ -78,6 +78,91 @@ let empty =
    triggers = [];
  }

+(* ── alarm rendering ─────────────────────────────────────────── *)
+
+(** Global counter for generating unique WARN/SCHED function names *)
+let alarm_id = ref 0
+
+let next_alarm_id () =
+  incr alarm_id;
+  !alarm_id
+
+(** 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 id = next_alarm_id () in
+            let name = spf "sched_%d" id 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 id = next_alarm_id () in
+            let name = spf "warn_%d" id 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 "
@@ -155,8 +240,8 @@ let add_until_monthly b rem (m : simple_monthly) =
      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))
+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
@@ -183,7 +268,11 @@ let escape_msg s =
    s;
  Buffer.contents buf

-let add_msg b summary = Buffer.add_string b (spf " MSG %s\n" (escape_msg summary))
+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%%\" (%%1)" body else spf "%%\"%s%%\" (%%b)" body else body in
+  Buffer.add_string b (spf " MSG %s\n" body)

 let add_location b loc =
  match loc with
@@ -240,21 +329,26 @@ let add_skip b exdates = if exdates <> [] then Buffer.add_string b "SKIP "

 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 rem.time;
+  add_at b alarm rem.time;
  add_duration b rem.duration;
-  add_msg b rem.summary;
+  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 ->
@@ -264,16 +358,19 @@ let render_weekly rem (w : simple_weekly) =
      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 rem.time;
+      add_at b alarm rem.time;
      add_duration b rem.duration;
-      add_msg b rem.summary)
+      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
@@ -288,28 +385,37 @@ let render_monthly rem (m : simple_monthly) =
      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 rem.time;
+  add_at b alarm rem.time;
  add_duration b rem.duration;
-  add_msg b rem.summary;
+  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;
-  add_at b rem.time;
+  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 rem.summary;
+  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);
-  add_msg b rem.summary;
+  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 ───────────────────────────────────────────────── *)
--- a/bin/utils.ml
+++ b/bin/utils.ml
@@ -258,7 +258,6 @@ let get_conference_url ev =
    ev.props

 let separate_master_and_recurrence (events : Icalendar.event list) : Icalendar.event * Icalendar.event list =
-  (* List.iteri (fun i e -> Printf.eprintf "%02d: %s\n" (i + 1) (Icalendar.show_component (`Event e))) events; *)
  let recur_ids = List.map (fun ev -> (ev, get_recurrence_id ev)) events in

  let master_and_recurrences =