ical2rem/bin/eventPredicates.ml

open Icalendar
open Utils

type error = Invalid_date of string | Skip

let invalid_date s e = Error (Invalid_date (spf "Invalid date: %s, error: %s" s (show_error e)))
let skip = Error Skip

type collector = Remind.rem -> event -> (Remind.rem, error) result

let collect_uuid rem ev : (Remind.rem, error) result =
  let uid = Utils.get_uid ev in
  Ok { rem with Remind.original_uuid = uid }

let collect_summary rem ev : (Remind.rem, error) result =
  let summary_opt =
    List.find_map
      (function
        | `Summary (_, s) -> Some s
        | _ -> None)
      ev.props
  in
  match summary_opt with
  | Some s -> Ok { rem with Remind.summary = s }
  | None -> Ok { rem with Remind.summary = "" }

let collect_location rem ev : (Remind.rem, error) result =
  let location_opt = Utils.get_location ev in
  match location_opt with
  | Some loc -> Ok { rem with Remind.location = Some loc }
  | None -> Ok rem

let collect_description rem ev : (Remind.rem, error) result =
  let description_opt = Utils.get_description ev in
  match description_opt with
  | Some desc -> Ok { rem with Remind.description = Some desc }
  | None -> Ok rem

let collect_conference_url rem ev : (Remind.rem, error) result =
  let conference_url_opt = Utils.get_conference_url ev in
  match conference_url_opt with
  | Some url -> Ok { rem with Remind.conference_url = Some url }
  | None -> Ok rem

let collect_start_end_duration rem ev : (Remind.rem, error) result =
  let _, dtstart = ev.dtstart in
  match dtstart with
  | `Date (year, month, day) -> (
      match Timedesc.Date.Ymd.make ~year ~month ~day with
      | Error e -> invalid_date "DTSTART" e
      | Ok day_start ->
          begin match ev.dtend_or_duration with
          | None -> { rem with Remind.date = day_start } |> Result.ok
          | Some (`Dtend (_, `Datetime _)) ->
              Utils.warn "Warning: DTSTART is DATE but DTEND is DATETIME, skipping (UID: %s)\n" rem.Remind.original_uuid;
              skip
          | Some (`Dtend (_, `Date (year, month, day))) ->
              begin match Timedesc.Date.Ymd.make ~year ~month ~day with
              | Error e -> invalid_date "DTEND" e
              | Ok day_end ->
                  let day_end =
                    if Timedesc.Date.lt day_start day_end then Timedesc.Date.add ~days:(-1) day_end else day_end
                  in
                  if Timedesc.Date.diff_days day_end day_start = 0 then
                    Ok { rem with Remind.date = day_start; Remind.end_date = None }
                  else Ok { rem with Remind.date = day_start; Remind.end_date = Some day_end }
              end
          | Some (`Duration (_, duration)) ->
              (* DATE + DURATION: compute end_date as start + duration_in_days - 1 *)
              let days, _ = Ptime.Span.to_d_ps duration in
              if days <= 1 then Ok { rem with Remind.date = day_start; Remind.end_date = None }
              else
                let day_end = Timedesc.Date.add ~days:(days - 1) day_start in
                Ok { rem with Remind.date = day_start; Remind.end_date = Some day_end }
          end)
  | `Datetime datetime -> begin
      let start_td = Utils.timedesc_of_timestamp datetime in
      let rem =
        {
          rem with
          Remind.date = Timedesc.date start_td;
          Remind.time = Some (Timedesc.time start_td);
          Remind.tz = Some (Timedesc.tz start_td);
        }
      in

      match ev.dtend_or_duration with
      | None -> Ok rem
      | Some (`Dtend (_, date_or_datetime)) ->
          begin match date_or_datetime with
          | `Datetime datetime -> begin
              let end_td = Utils.timedesc_of_timestamp datetime in
              let duration =
                Timedesc.Span.sub (Timedesc.to_timestamp_single end_td) (Timedesc.to_timestamp_single start_td)
              in
              let rem = { rem with Remind.duration = Some duration } in
              Ok rem
            end
          | `Date (_year, _month, _day) ->
              Utils.warn "Warning: DTSTART is DATETIME but DTEND is DATE, skipping (UID: %s)\n" rem.Remind.original_uuid;
              skip
          end
      | Some (`Duration (_, duration)) ->
          let span = Timedesc.Utils.span_of_ptime_span duration in
          let rem = { rem with Remind.duration = Some span } in
          Ok rem
    end

let collect_exdates rem ev : (Remind.rem, error) result =
  let exdates = Utils.get_exdates ev in
  Ok { rem with Remind.exdate = exdates }

let collect_triggers rem ev : (Remind.rem, error) result =
  let triggers = Utils.get_triggers ev in
  Ok { rem with Remind.triggers }

let yearly_simple_date rem ev : (Remind.rem, error) result =
  match ev.rrule with
  | Some (_, (`Yearly, None, None, [])) ->
      let month, day = (Timedesc.Date.month rem.Remind.date, Timedesc.Date.day rem.Remind.date) in
      Ok { rem with Remind.yearly = Some (month, day) }
  | Some _ -> Ok rem
  | None -> Ok rem

let simple_recurrence rem ev : (Remind.rem, error) result =
  match ev.rrule with
  | Some (_, (`Yearly, None, None, [])) -> Ok rem (* handled in yearly_simple_date *)
  | Some (_, ((`Weekly as freq), count_or_until, interval, recurs))
  | Some (_, ((`Daily as freq), count_or_until, interval, recurs)) -> begin
      let days =
        ListLabels.filter_map recurs ~f:(function
          | `Byday days -> begin List.map (fun (_n, weekday) -> weekday) days |> Option.some end
          | _ -> None)
        |> List.flatten
      in
      let week_start =
        ListLabels.find_map recurs ~f:(function
          | `Weekday `Sunday -> Some `Sunday
          | `Weekday `Monday -> Some `Monday
          | _ -> None)
      in
      match freq with
      | `Daily -> Ok { rem with Remind.weekly = None; Remind.daily = Some { count_or_until; interval; week_start } }
      | `Weekly ->
          let days = if days = [] then [ timedesc_wd_to_ical (Timedesc.Date.weekday rem.date) ] else days in
          Ok
            {
              rem with
              Remind.daily = None;
              Remind.weekly = Some { count_or_until; interval; byday = days; week_start };
            }
    end
  | Some (_, (`Monthly, count_or_until, interval, recurs)) ->
      begin match interval with
      | Some n when n > 1 ->
          Utils.warn "Warning: MONTHLY INTERVAL=%d not supported, skipping (UID: %s)\n" n (Utils.get_uid ev);
          skip
      | _ -> (
          let bymonthday =
            List.find_map
              (function
                | `Bymonthday (d :: _) -> Some d
                | _ -> None)
              recurs
          in
          let byday =
            List.find_map
              (function
                | `Byday pairs -> List.find_map (fun (n, wd) -> if n <> 0 then Some (n, wd) else None) pairs
                | _ -> None)
              recurs
          in
          let pattern =
            match (bymonthday, byday) with
            | _, Some (n, wd) -> Some (Remind.By_nth_weekday (n, wd)) (* BYDAY takes precedence *)
            | Some day, None -> Some (Remind.By_month_day day)
            | None, None -> Some (Remind.By_month_day (Timedesc.Date.day rem.Remind.date))
          in
          match pattern with
          | None ->
              Utils.warn "Warning: MONTHLY with unsupported BYDAY, skipping (UID: %s)\n" (Utils.get_uid ev);
              skip
          | Some p -> Ok { rem with Remind.monthly = Some { count_or_until; interval; pattern = p } })
      end
  | Some (_, recurs) ->
      Utils.warn "Warning: unsupported recurrence rule, skipping (UID: %s)\n" (Utils.get_uid ev);
      skip
  | None -> Ok rem

let is_cancelled (ev : Icalendar.event) : bool =
  List.exists
    (function
      | `Status (_, `Cancelled) -> true
      | _ -> false)
    ev.props

let build_override_rem (source : string) (override_ev : Icalendar.event) : (Remind.rem, error) result =
  let rem = { Remind.empty with Remind.source } in
  let collectors = [ collect_uuid; collect_summary; collect_start_end_duration ] in
  ListLabels.fold_left ~init:(Ok rem) collectors ~f:(fun rem_or_error pred ->
      match rem_or_error with
      | Error e -> Error e
      | Ok rem -> pred rem override_ev)

let collect_overrides rem _ev : (Remind.rem, error) result =
  (* Process each RECURRENCE-ID override event stored in rem.recurring:
     - add its RECURRENCE-ID date to rem.exdate (feeds the OMIT mechanism)
     - for non-cancelled overrides, build a single REM and add to rem.overrides *)
  let new_exdates, new_overrides =
    ListLabels.fold_left ~init:([], []) rem.Remind.recurring ~f:(fun (exdates, overrides) override_ev ->
        let recur_id_opt = Utils.get_recurrence_id override_ev in
        let exdates =
          match recur_id_opt with
          | None ->
              Utils.warn "Warning: override event has no RECURRENCE-ID, skipping (UID: %s)\n"
                (Utils.get_uid override_ev);
              exdates
          | Some date_or_dt -> date_or_dt :: exdates
        in
        let overrides =
          if is_cancelled override_ev then overrides
          else
            match build_override_rem rem.Remind.source override_ev with
            | Error _ ->
                Utils.warn "Warning: could not build override REM, skipping (UID: %s)\n" (Utils.get_uid override_ev);
                overrides
            | Ok override_rem -> override_rem :: overrides
        in
        (exdates, overrides))
  in
  Ok
    {
      rem with
      Remind.exdate = rem.Remind.exdate @ List.rev new_exdates;
      Remind.overrides = List.rev new_overrides;
      Remind.recurring = [];
    }

let all_collectors : collector list =
  [
    collect_uuid;
    collect_summary;
    collect_location;
    collect_description;
    collect_conference_url;
    collect_start_end_duration;
    collect_exdates;
    collect_triggers;
    collect_overrides;
    yearly_simple_date;
    simple_recurrence;
  ]

let remind_of_event (source : string) (ev : Icalendar.event list) : (Remind.rem, error) result =
  let () = if List.length ev = 0 then failwith "No events provided" in

  let master, recurrence =
    if List.length ev > 1 then begin
      separate_master_and_recurrence ev
    end
    else begin
      let ev = List.hd ev in
      (ev, [])
    end
  in

  let rem = { Remind.empty with Remind.source; Remind.original_event = Some master; Remind.recurring = recurrence } in

  ListLabels.fold_left ~init:(Ok rem) all_collectors ~f:(fun rem_or_error pred ->
      match rem_or_error with
      | Error e -> Error e
      | Ok rem -> pred rem master)