From 6f5c5409f583454523f23cad00a76b872a0ee896 Mon Sep 17 00:00:00 2001 From: Paolo Donadeo Date: Sun, 28 Dec 2025 16:17:41 +0100 Subject: [PATCH] Una versione del modulo Remind pensata da GitHub Copilot Claude Opus 4.5 --- bin/eventTransformer.ml | 2 +- bin/remind.ml | 626 ++++++++++++++++++++++++++++++++-------- 2 files changed, 512 insertions(+), 116 deletions(-) diff --git a/bin/eventTransformer.ml b/bin/eventTransformer.ml index 9645638..3edecfe 100644 --- a/bin/eventTransformer.ml +++ b/bin/eventTransformer.ml @@ -1,4 +1,4 @@ -let default_implementation = Remind.Omit (Ptime.epoch |> Ptime.to_date) +let default_implementation = Remind.make_default_event "TODO: implement conversion" let remind_of_event (ev : Icalendar.event) : Remind.event = let found = diff --git a/bin/remind.ml b/bin/remind.ml index 772d1cd..a624c29 100644 --- a/bin/remind.ml +++ b/bin/remind.ml @@ -1,119 +1,515 @@ -(* Alias esplicito per chiarezza *) -type date = Ptime.date - -let pp_date fmt (y, m, d) = Format.fprintf fmt "%04d-%02d-%02d" y m d - -let show_date (d : date) : string = - let y, m, day = d in - Printf.sprintf "%04d-%02d-%02d" y m day - -type tod = Ptime.Span.t (* secondi da mezzanotte locale *) - -let pp_tod = Ptime.Span.pp -let span_min (m : int) : tod = Ptime.Span.of_int_s (m * 60) -let span_hm ~(h : int) ~(m : int) : tod = Ptime.Span.of_int_s ((h * 3600) + (m * 60)) - -let hm_of_tod (t : tod) : int * int = - match Ptime.Span.to_int_s t with - | None -> invalid_arg "tod out of range" - | Some s -> (s / 3600, s mod 3600 / 60) +(** Types for representing Remind events *) +(** Weekday names in Remind format *) type weekday = - | Mon - | Tue - | Wed - | Thu - | Fri - | Sat - | Sun - -type time_spec = - | All_day - | Timed of { - at : tod; - duration : Ptime.Span.t option; - } - -type range = { - from_ : date; - until : date option; -} -(* UNTIL inclusivo *) - -type recurrence = - | No_recur - | Daily of { - interval : int; - span : range; - } - | Weekly of { - interval : int; - days : weekday list; - span : range; - } - | Monthly_dom of { - interval : int; - day : int; - span : range; - } - | Monthly_nth_weekday of { - interval : int; - n : int; - wday : weekday; - span : range; - } - | Yearly of { - month : int; - day : int; - } - -type alarm = { warn_before : Ptime.Span.t } - -type meta = { - location : string option; - url : string option; - categories : string list; - attendees : string list; -} - -type instance_override = { - on : date; - cancel : bool; - summary : string option; - time_spec : time_spec option; - notes : string option; - alarm : alarm option; - meta : meta option; -} - -type series = { - summary : string; - start : date; (* DTSTART locale *) - time_spec : time_spec; - recur : recurrence; - exdates : date list; - overrides : instance_override list; - alarm : alarm option; - notes : string option; - meta : meta; -} - -type info_header = string [@@deriving show] -type info_value = string [@@deriving show] - -type event = - | Rem of { - date_expr : string; - at : tod option; - duration : Ptime.Span.t option; - warn : Ptime.Span.t option; - msg : string; - exdates : date list; - infos : (info_header * info_value) list; - } - | Omit of date + | Monday + | Tuesday + | Wednesday + | Thursday + | Friday + | Saturday + | Sunday [@@deriving show] -let string_of_date (d : date) : string = - let y, m, day = d in - Printf.sprintf "%04d-%02d-%02d" y m day +(** Month names (Remind uses English month names) *) +type month = + | January + | February + | March + | April + | May + | June + | July + | August + | September + | October + | November + | December +[@@deriving show] + +type date_spec = { + day : int option; (** Day of month (1-31) *) + month : month option; (** Month *) + year : int option; (** Year (1990-2075) *) + weekdays : weekday list; (** List of weekdays for weekly recurrences *) +} +[@@deriving show] +(** Date specification in Remind *) + +type simple_date = { + year : int; + month : int; + day : int; +} +[@@deriving show] +(** Short-hand date format YYYY-MM-DD *) + +type time_spec = { + hour : int; (** 0-23 for 24h format, 1-12 for am/pm *) + minute : int; (** 0-59 *) +} +[@@deriving show] +(** Time specification (24-hour format or with AM/PM) *) + +(** Delta specification for advance warning *) +type delta = + | Plus of int (** +n - respects OMIT *) + | PlusPlus of int (** ++n - ignores OMIT *) +[@@deriving show] + +(** Back specification for backward scanning *) +type back = + | Minus of int (** -n - respects OMIT *) + | MinusMinus of int (** --n - ignores OMIT *) + | Tilde of int (** ~n - "lastworkday" style *) + | TildeTilde of int (** ~~n - "lastday" style *) +[@@deriving show] + +type repeat = int (* n - repeat every n days *) [@@deriving show] +(** Repeat specification for periodic reminders *) + +type tdelta = int [@@deriving show] +(** Time delta for timed reminders (in minutes) *) + +type trepeat = int [@@deriving show] +(** Time repeat for timed reminders (in minutes) *) + +(** Duration specification for timed events *) +type duration = + | Minutes of int (** Duration in minutes *) + | HoursMinutes of int * int (** Duration as hours:minutes *) +[@@deriving show] + +type priority = int [@@deriving show] +(** Priority (0-9999, default 5000) *) + +type omit = weekday list [@@deriving show] +(** OMIT specification - days to skip *) + +(** Special keywords *) +type modifier = + | Once (** ONCE - trigger only once per day *) + | Noqueue (** NOQUEUE - don't queue timed reminders *) +[@@deriving show] + +(** Action to take when reminder falls on an omitted day *) +type omit_action = + | Skip (** SKIP - skip the reminder completely *) + | Before (** BEFORE - move reminder to before omitted days *) + | After (** AFTER - move reminder to after omitted days *) +[@@deriving show] + +type trigger = { + date : date_spec option; (** Date specification *) + simple_date : simple_date option; (** Alternative: YYYY-MM-DD format *) + back : back option; (** Backward scanning *) + repeat : repeat option; (** Periodic repetition *) + delta : delta option; (** Advance warning *) + until : simple_date option; (** UNTIL expiry date *) + through : simple_date option; (** THROUGH (equivalent to *1 UNTIL) *) + from : simple_date option; (** FROM starting date *) + scanfrom : simple_date option; (** SCANFROM advanced starting date *) +} +[@@deriving show] +(** Trigger specification combining various time-related elements *) + +type timed = { + time : time_spec; + tdelta : tdelta option; + trepeat : trepeat option; +} +[@@deriving show] +(** Timed reminder specification *) + +type tag = string (* Up to 48 chars, no whitespace or comma *) [@@deriving show] +(** TAG specification for categorizing reminders *) + +type info = { + header : string; (** e.g., "Location", "Description", "Url" *) + value : string; +} +[@@deriving show] +(** INFO specification for metadata *) + +(** Body specification *) +type body = + | Msg of string (** MSG - simple message *) + | Msf of string (** MSF - formatted message *) + | Run of string (** RUN - execute command *) + | Cal of string (** CAL - calendar entry *) + | Satisfy of string (** SATISFY - conditional trigger expression *) + | Ps of string (** PS - PostScript *) + | Psfile of string (** PSFILE - PostScript file *) + | Special of string * string (** SPECIAL type body *) +[@@deriving show] + +type rem = { + trigger : trigger; + timed : timed option; (** AT specification *) + priority : priority option; (** PRIORITY *) + omit : omit option; (** OMIT weekdays *) + omitfunc : string option; (** OMITFUNC function_name *) + addomit : bool; (** ADDOMIT flag *) + omit_action : omit_action option; (** SKIP/BEFORE/AFTER *) + modifiers : modifier list; (** ONCE, NOQUEUE, etc. *) + tags : tag list; (** TAG specifications *) + infos : info list; (** INFO specifications *) + duration : duration option; (** DURATION for timed events *) + todo : bool; (** TODO flag *) + complete_through : simple_date option; (** COMPLETE-THROUGH date for TODOs *) + max_overdue : int option; (** MAX-OVERDUE days for TODOs *) + warn : string option; (** WARN function name for precise scheduling *) + sched : string option; (** SCHED function name for timed reminders *) + tz : string option; (** TZ timezone *) + maybe_uncomputable : bool; (** MAYBE-UNCOMPUTABLE flag *) + body : body; (** MSG/RUN/etc. *) +} +[@@deriving show] +(** A complete REM command *) + +type event = rem +(** Type alias for compatibility - a Remind event is a REM command *) + +(** Convenience constructors *) + +let make_simple_date year month day = { year; month; day } +let make_time hour minute = { hour; minute } +let make_date_spec ?day ?month ?year ?(weekdays = []) () = { day; month; year; weekdays } + +let make_trigger ?date ?simple_date ?back ?repeat ?delta ?until ?through ?from ?scanfrom () = + { date; simple_date; back; repeat; delta; until; through; from; scanfrom } + +let make_timed ?tdelta ?trepeat time = { time; tdelta; trepeat } +let make_info header value = { header; value } + +let make_rem ?(timed = None) ?(priority = None) ?(omit = None) ?(omitfunc = None) ?(addomit = false) + ?(omit_action = None) ?(modifiers = []) ?(tags = []) ?(infos = []) ?(duration = None) ?(todo = false) + ?(complete_through = None) ?(max_overdue = None) ?(warn = None) ?(sched = None) ?(tz = None) + ?(maybe_uncomputable = false) trigger body = + { + trigger; + timed; + priority; + omit; + omitfunc; + addomit; + omit_action; + modifiers; + tags; + infos; + duration; + todo; + complete_through; + max_overdue; + warn; + sched; + tz; + maybe_uncomputable; + body; + } + +(** Create a minimal default event - useful as a placeholder *) +let make_default_event msg = + let trigger = make_trigger () in + make_rem trigger (Msg msg) + +(** Helper to escape quotes in strings for INFO values *) +let escape_quotes s = + let buf = Buffer.create (String.length s) in + String.iter (fun c -> if c = '"' then Buffer.add_string buf "\\\"" else Buffer.add_char buf c) s; + Buffer.contents buf + +(** Convert types to Remind syntax strings *) + +let weekday_to_string = function + | Monday -> "Mon" + | Tuesday -> "Tue" + | Wednesday -> "Wed" + | Thursday -> "Thu" + | Friday -> "Fri" + | Saturday -> "Sat" + | Sunday -> "Sun" + +let month_to_string = function + | January -> "Jan" + | February -> "Feb" + | March -> "Mar" + | April -> "Apr" + | May -> "May" + | June -> "Jun" + | July -> "Jul" + | August -> "Aug" + | September -> "Sep" + | October -> "Oct" + | November -> "Nov" + | December -> "Dec" + +let simple_date_to_string d = Printf.sprintf "%04d-%02d-%02d" d.year d.month d.day +let time_to_string t = Printf.sprintf "%02d:%02d" t.hour t.minute + +let duration_to_string = function + | Minutes m -> string_of_int m + | HoursMinutes (h, m) -> Printf.sprintf "%d:%02d" h m + +let delta_to_string = function + | Plus n -> Printf.sprintf "+%d" n + | PlusPlus n -> Printf.sprintf "++%d" n + +let back_to_string = function + | Minus n -> Printf.sprintf "-%d" n + | MinusMinus n -> Printf.sprintf "--%d" n + | Tilde n -> Printf.sprintf "~%d" n + | TildeTilde n -> Printf.sprintf "~~%d" n + +let repeat_to_string r = Printf.sprintf "*%d" r + +let omit_action_to_string = function + | Skip -> "SKIP" + | Before -> "BEFORE" + | After -> "AFTER" + +(** Convert a REM to a string suitable for a .rem file *) +let rem_to_string rem = + let buf = Buffer.create 256 in + Buffer.add_string buf "REM"; + + (* MAYBE-UNCOMPUTABLE *) + if rem.maybe_uncomputable then Buffer.add_string buf " MAYBE-UNCOMPUTABLE"; + + (* TODO *) + if rem.todo then Buffer.add_string buf " TODO"; + + (* Date/trigger specification *) + (match rem.trigger.simple_date with + | Some sd -> + Buffer.add_char buf ' '; + Buffer.add_string buf (simple_date_to_string sd) + | None -> ( + match rem.trigger.date with + | Some ds -> ( + (* Weekdays *) + List.iter + (fun wd -> + Buffer.add_char buf ' '; + Buffer.add_string buf (weekday_to_string wd)) + ds.weekdays; + (* Day *) + (match ds.day with + | Some d -> + Buffer.add_char buf ' '; + Buffer.add_string buf (string_of_int d) + | None -> ()); + (* Month *) + (match ds.month with + | Some m -> + Buffer.add_char buf ' '; + Buffer.add_string buf (month_to_string m) + | None -> ()); + (* Year *) + match ds.year with + | Some y -> + Buffer.add_char buf ' '; + Buffer.add_string buf (string_of_int y) + | None -> ()) + | None -> ())); + + (* Back *) + (match rem.trigger.back with + | Some b -> + Buffer.add_char buf ' '; + Buffer.add_string buf (back_to_string b) + | None -> ()); + + (* Repeat *) + (match rem.trigger.repeat with + | Some r -> + Buffer.add_char buf ' '; + Buffer.add_string buf (repeat_to_string r) + | None -> ()); + + (* Delta *) + (match rem.trigger.delta with + | Some d -> + Buffer.add_char buf ' '; + Buffer.add_string buf (delta_to_string d) + | None -> ()); + + (* FROM *) + (match rem.trigger.from with + | Some f -> + Buffer.add_string buf " FROM "; + Buffer.add_string buf (simple_date_to_string f) + | None -> ()); + + (* UNTIL *) + (match rem.trigger.until with + | Some u -> + Buffer.add_string buf " UNTIL "; + Buffer.add_string buf (simple_date_to_string u) + | None -> ()); + + (* THROUGH *) + (match rem.trigger.through with + | Some t -> + Buffer.add_string buf " THROUGH "; + Buffer.add_string buf (simple_date_to_string t) + | None -> ()); + + (* SCANFROM *) + (match rem.trigger.scanfrom with + | Some sf -> + Buffer.add_string buf " SCANFROM "; + Buffer.add_string buf (simple_date_to_string sf) + | None -> ()); + + (* AT (timed) *) + (match rem.timed with + | Some t -> ( + Buffer.add_string buf " AT "; + Buffer.add_string buf (time_to_string t.time); + (match t.tdelta with + | Some td -> + Buffer.add_char buf ' '; + Buffer.add_char buf '+'; + Buffer.add_string buf (string_of_int td) + | None -> ()); + match t.trepeat with + | Some tr -> + Buffer.add_string buf " *"; + Buffer.add_string buf (string_of_int tr) + | None -> ()) + | None -> ()); + + (* SCHED *) + (match rem.sched with + | Some s -> + Buffer.add_string buf " SCHED "; + Buffer.add_string buf s + | None -> ()); + + (* WARN *) + (match rem.warn with + | Some w -> + Buffer.add_string buf " WARN "; + Buffer.add_string buf w + | None -> ()); + + (* OMIT *) + (match rem.omit with + | Some weekdays when weekdays <> [] -> + Buffer.add_string buf " OMIT"; + List.iter + (fun wd -> + Buffer.add_char buf ' '; + Buffer.add_string buf (weekday_to_string wd)) + weekdays + | _ -> ()); + + (* OMITFUNC *) + (match rem.omitfunc with + | Some func -> + Buffer.add_string buf " OMITFUNC "; + Buffer.add_string buf func + | None -> ()); + + (* SKIP/BEFORE/AFTER *) + (match rem.omit_action with + | Some action -> + Buffer.add_char buf ' '; + Buffer.add_string buf (omit_action_to_string action) + | None -> ()); + + (* ADDOMIT *) + if rem.addomit then Buffer.add_string buf " ADDOMIT"; + + (* PRIORITY *) + (match rem.priority with + | Some p -> + Buffer.add_string buf " PRIORITY "; + Buffer.add_string buf (string_of_int p) + | None -> ()); + + (* Modifiers (ONCE, NOQUEUE) *) + List.iter + (fun modifier -> + match modifier with + | Once -> Buffer.add_string buf " ONCE" + | Noqueue -> Buffer.add_string buf " NOQUEUE") + rem.modifiers; + + (* DURATION *) + (match rem.duration with + | Some d -> + Buffer.add_string buf " DURATION "; + Buffer.add_string buf (duration_to_string d) + | None -> ()); + + (* COMPLETE-THROUGH *) + (match rem.complete_through with + | Some ct -> + Buffer.add_string buf " COMPLETE-THROUGH "; + Buffer.add_string buf (simple_date_to_string ct) + | None -> ()); + + (* MAX-OVERDUE *) + (match rem.max_overdue with + | Some mo -> + Buffer.add_string buf " MAX-OVERDUE "; + Buffer.add_string buf (string_of_int mo) + | None -> ()); + + (* TZ *) + (match rem.tz with + | Some tz -> + Buffer.add_string buf " TZ "; + Buffer.add_string buf tz + | None -> ()); + + (* TAGs *) + List.iter + (fun tag -> + Buffer.add_string buf " TAG "; + Buffer.add_string buf tag) + rem.tags; + + (* INFOs - with proper escaping *) + List.iter + (fun info -> + Buffer.add_string buf " INFO \""; + Buffer.add_string buf (escape_quotes info.header); + Buffer.add_string buf ": "; + Buffer.add_string buf (escape_quotes info.value); + Buffer.add_char buf '"') + rem.infos; + + (* Body *) + Buffer.add_char buf ' '; + (match rem.body with + | Msg msg -> + Buffer.add_string buf "MSG "; + Buffer.add_string buf msg + | Msf msf -> + Buffer.add_string buf "MSF "; + Buffer.add_string buf msf + | Run cmd -> + Buffer.add_string buf "RUN "; + Buffer.add_string buf cmd + | Cal cal -> + Buffer.add_string buf "CAL "; + Buffer.add_string buf cal + | Satisfy expr -> + Buffer.add_string buf "SATISFY "; + Buffer.add_string buf expr + | Ps ps -> + Buffer.add_string buf "PS "; + Buffer.add_string buf ps + | Psfile file -> + Buffer.add_string buf "PSFILE "; + Buffer.add_string buf file + | Special (typ, body) -> + Buffer.add_string buf "SPECIAL "; + Buffer.add_string buf typ; + Buffer.add_char buf ' '; + Buffer.add_string buf body); + + Buffer.contents buf