type when_ = | Before | After | SameDay type alert_requestp = { date_offset: int; exact_time: int * int; when_: when_; } type alert_request = { date_offset: int; exact_time: int * int; due_date: Ptime.date; when_: when_; } let of_alert_request ar = let h, m = ar.exact_time in let d = ar.due_date |> Ptime.of_date |> Option.map Ptime.to_rfc3339 |> function | None -> "none" | Some d -> d in [%string "alert_request[date_offset=%{ar.date_offset#Int};exact_time=(%{h#Int}, %{m#Int});due_date=%{d}"] let to_exact_date offset ar = let src = ar.due_date |> Ptime.of_date in let secs_in_day = 24 * 60 * 60 in let span = ar.date_offset * secs_in_day |> Ptime.Span.of_int_s in let add_span = match ar.when_ with | Before -> Ptime.sub_span | _ -> Ptime.add_span in let date = Option.bind src (fun s -> add_span s span) |> Option.map (Ptime.to_date ~tz_offset_s:offset) in let h, m = ar.exact_time in let ptime_time = (h, m, 0), offset in Option.bind date (fun date -> Ptime.of_date_time (date, ptime_time)) let parse_body str = let prefix = "@alert: " in let idx = String.length prefix in let lines = String.split_on_char '\n' str in let rec find_alert acc = function | line::rest -> if line |> String.starts_with ~prefix:"@alert: " then let until = String.length line - idx in let alert_rest = String.sub line idx until |> String.split_on_char ' ' in find_alert (alert_rest@acc) rest else find_alert acc rest | [] -> acc in find_alert [] lines let to_alert_request str = let is_number str = Str.string_match (Str.regexp "[0-9]+") str 0 in let rec count n str = function | "-" -> if String.starts_with ~prefix:"-" str then let rest = (String.sub str 1 (String.length str-1)) in count (n+1) rest "-" else if String.starts_with ~prefix:"+" str then Error "Malformed alert string" else Ok (n, str) | "+" -> if String.starts_with ~prefix:"+" str then let rest = (String.sub str 1 (String.length str-1)) in count (n+1) rest "+" else if String.starts_with ~prefix:"-" str then Error "Malformed alert string" else Ok (n, str) | _ -> Ok (n, str) in let od, when_ = if String.starts_with ~prefix:"-" str then (count 0 str "-", Before) else if String.starts_with ~prefix:"+" str then (count 0 str "+", After) else (Ok (0, str), SameDay) in Result.bind od (fun (offset, date_str) -> match String.split_on_char ':' date_str with | h::m::[] when is_number h && is_number m -> Ok {date_offset=offset; exact_time=(int_of_string h, int_of_string m); when_=when_} | _ -> Error [%string "Malformed time: %{str}"]) let to_datetime: Datatypes.reminder -> (Ptime.t list option, string) result = function | {due_date=None; _} -> Ok None | {due_date=Some due_date; body=body; _} -> let rec all acc = function [] -> Ok acc | Ok x::xs -> all (x::acc) xs | Error e::_ -> Error e in let rec all' acc = function [] -> Some acc | Some x::xs -> all' (x::acc) xs | None::_ -> None in let alerts = body |> parse_body |> List.map to_alert_request |> all [] in let issue_due_date = Ptime.of_rfc3339 due_date |> Ptime.rfc3339_string_error |> Result.map (fun (timestamp, utc_offset, _) -> let offset = Option.value ~default:0 utc_offset in (Ptime.to_date timestamp ~tz_offset_s:offset, offset)) in match (issue_due_date, alerts) with | Error e, _ -> Error e | _, Error e -> Error e | Ok (date, offset), Ok alerts -> let convert = (fun (a: alert_requestp) -> {date_offset=a.date_offset; exact_time=a.exact_time; due_date=date; when_=a.when_}) in List.map (fun ap -> ap |> convert |> to_exact_date offset) alerts |> all' [] |> Result.ok