diff --git a/bin/eventPredicates.ml b/bin/eventPredicates.ml index a98b075..d82c520 100644 --- 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 = diff --git a/bin/remind.ml b/bin/remind.ml index 00b5ad1..ccc2f30 100644 --- 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 (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 ───────────────────────────────────────────────── *) diff --git a/bin/utils.ml b/bin/utils.ml index 512f3cf..4a7207c 100644 --- 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 =