lanonna/pam/lib/issuelib.ml

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