From 3a554a82fe80b5b9da3f2331b194b389e5714748 Mon Sep 17 00:00:00 2001 From: Benedetta Date: Tue, 23 Apr 2024 09:52:53 +0200 Subject: [PATCH] burrodiarachidi --- .gitignore | 2 - pam/lib/datatypes.ml | 26 +++++++++++ pam/lib/dune | 6 +++ pam/lib/issue_parser.ml | 96 +++++++++++++++++++++++++++++++++++++++++ 4 files changed, 128 insertions(+), 2 deletions(-) create mode 100644 pam/lib/datatypes.ml create mode 100644 pam/lib/dune create mode 100644 pam/lib/issue_parser.ml diff --git a/.gitignore b/.gitignore index 9b3c87e..f987414 100644 --- a/.gitignore +++ b/.gitignore @@ -14,8 +14,6 @@ dist/ downloads/ eggs/ .eggs/ -lib/ -lib64/ parts/ sdist/ var/ diff --git a/pam/lib/datatypes.ml b/pam/lib/datatypes.ml new file mode 100644 index 0000000..86f4dc0 --- /dev/null +++ b/pam/lib/datatypes.ml @@ -0,0 +1,26 @@ + +type client_id = | MqClient | HttpClient + +module MatrixRoom = struct + type t = string + let make str = str +end + +type reminder = { (* from an issue in forgejo get a reminder *) + url: string; + title: string; + due_date: string option; + body: string; + matrix_target: MatrixRoom.t +} + +type Riot.Message.t += + | RegisterClient of (client_id * Riot.Pid.t) + | LookupClient of client_id + | ListIssues + | ForgejoIssues of reminder list + | ForgejoError of string + | InternalFailure of string + +let forgejo_issues lst = ForgejoIssues lst +let forgejo_error reason = ForgejoError reason diff --git a/pam/lib/dune b/pam/lib/dune new file mode 100644 index 0000000..91f6195 --- /dev/null +++ b/pam/lib/dune @@ -0,0 +1,6 @@ +(library + (name pam) + (libraries riot ptime str) + (preprocess + (pps lwt_ppx ppx_string )) + ) \ No newline at end of file diff --git a/pam/lib/issue_parser.ml b/pam/lib/issue_parser.ml new file mode 100644 index 0000000..d9e7279 --- /dev/null +++ b/pam/lib/issue_parser.ml @@ -0,0 +1,96 @@ +type alert_requestp = { + date_offset: int; + exact_time: int * int + } + +type alert_request = { + date_offset: int; + exact_time: int * int; + due_date: Ptime.date; + } +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 date = Option.bind src (fun s -> Ptime.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 _ = print_endline [%string "doing_sub: %{line}|%{until#Int}|%{idx#Int}"] in + let alert_rest = String.sub line idx until |> String.split_on_char ' ' in + let p = String.concat "; " alert_rest in + let _ = print_endline [%string "done_sub: %{p}|%{until#Int}|%{idx#Int}"] 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 = + if String.starts_with ~prefix:"-" str then count 0 str "-" + else if String.starts_with ~prefix:"+" str then count 0 str "+" + else Ok (0, str) + 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)} + | _ -> 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}) in + List.map (fun ap -> ap |> convert |> to_exact_date offset) alerts + |> all' [] + |> Result.ok