pdonadeo/ical2rem
1
0
Fork 0
Code Issues Pull Requests Actions Projects Releases 1 Activity

feat(remind): implement alarm rendering for triggers

Browse Source 
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.
This commit is contained in:
Paolo Donadeo
2026-05-23 19:20:22 +02:00
parent 16950fa208
commit 8594e9d16d
3 changed files with 119 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

132
bin/remind.ml
View File

@@ -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 (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 ───────────────────────────────────────────────── *)