lanonna/pam/lib/issue_parser.ml

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