ical2rem/bin/remind.ml

(** Types for representing Remind events *)

(** Weekday names in Remind format *)
type weekday =
  | Monday
  | Tuesday
  | Wednesday
  | Thursday
  | Friday
  | Saturday
  | Sunday
[@@deriving show]

(** 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