burrodiarachidi

.gitignore

@@ -14,8 +14,6 @@ dist/
 downloads/
 eggs/
 .eggs/
-lib/
-lib64/
 parts/
 sdist/
 var/

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

pam/lib/dune

@@ -0,0 +1,6 @@
+(library
+ (name pam)
+    (libraries riot ptime str)
+ (preprocess
+  (pps lwt_ppx ppx_string  ))
+    )

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