module Private = struct 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 option_bind f opt = Option.bind opt f let to_exact_date offset alert_data = let alert_time = (alert_data.exact_time |> fst, alert_data.exact_time |> snd, 0), offset in let seconds_in_a_day = 24 * 60 * 60 in let span = alert_data.date_offset * seconds_in_a_day |> Ptime.Span.of_int_s in let add_span = match alert_data.when_ with | Before -> Ptime.sub_span | _ -> Ptime.add_span in alert_data.due_date |> Ptime.of_date |> option_bind (fun s -> add_span s span) |> Option.map (Ptime.to_date ~tz_offset_s:offset) |> option_bind (fun due_date -> Ptime.of_date_time (due_date, alert_time)) let parse_body str = let prefix = "@alert: " in let has_alert = String.starts_with ~prefix:prefix in let idx = String.length prefix in let rec find_alert acc = function | line::rest -> if line |> has_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 String.split_on_char '\n' str |> find_alert [] 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 -> let (h, m) = (h, m) |> BatTuple.Tuple2.map1 BatString.trim in begin match int_of_string_opt h, int_of_string_opt m with | Some h, Some m -> Ok {date_offset=offset; exact_time=(h, m); when_=when_} | None, _ -> Error [%string "Can't parse numbers from string hour: h=%{h}|m=%{m}|"] | _, None -> Error [%string "Can't parse numbers from string minute: h=%{h}|m=%{m}|"] end | _ -> Error [%string "Malformed time: %{str}"]) end open Private let to_datetime: Datatypes.forgejo_issue_data -> (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 let should_alert now alerts = let is_noon_in_seconds hour tz_offset minute = let h = hour * 60 * 60 in let m = minute * 60 in let total = tz_offset + h + m in (12 * 60 * 60) = total in let remove_seconds (t: Ptime.t) = let (date, ((h, m, _), offset)) = Ptime.to_date_time t in let time' = ((h, m, 0), offset) in Ptime.of_date_time (date, time') |> Option.get in let equal a b = Ptime.equal (remove_seconds a) (remove_seconds b) in let is_noon t = Ptime.to_date_time t |> function (_date, ((h, m, _s), tz_offset)) -> is_noon_in_seconds h tz_offset m in (List.exists (equal now) alerts) || (List.for_all (Ptime.is_earlier ~than:now) alerts && is_noon now) let issue_data_to_json (issue: Datatypes.forgejo_issue_data) = let open Yojson.Basic in let due_date = Option.value ~default:"" issue.due_date in let room_id = issue.matrix_target in let content = [%string {|[%{issue.title}](%{issue.url}) - %{due_date}\n%{issue.body}|} ] in let d = `Assoc [ ("content", `String content); ("source_message_id", `Null); ("room_id", `String room_id); ("as_reply", `Bool false); ("as_markdown", `Bool true) ] in to_string d