ical2rem/bin/eventPredicates.ml

open Icalendar
open Utils

(* CASE ANALYSIS PREDICATES
  - id: P00 ✅
    pattern: Ha un SUMMARY?
    ics: "SUMMARY:…"
    remind_support: nativo
    strategia: "REM <data> MSG <summary>"
    snippet: 'REM 2025-12-25 MSG Natale'
    priorita: Subito

  - id: P01 ✅
    pattern: All-day singolo
    ics: "DTSTART;VALUE=DATE, opzionale DTEND=giorno+1"
    remind_support: nativo
    strategia: "REM <data> MSG <summary>"
    snippet: 'REM 2025-12-25 MSG Natale'
    priorita: Subito

  - id: P02 ✅
    pattern: All-day multi-giorno
    ics: "DTSTART;VALUE=DATE + DTEND;VALUE=DATE esclusivo"
    remind_support: nativo+accorgimenti
    strategia: "espandi in eventi giornalieri; stesso SUMMARY"
    snippet: 'REM 2025-08-10 THROUGH 2025-08-15 MSG Ferie  # oppure espansione per-giorno'
    priorita: Subito

  - id: P03 ✅
    pattern: Evento a orario locale
    ics: "DTSTART;TZID=… + DTEND oppure DURATION"
    remind_support: nativo
    strategia: "REM <data> AT <hh:mm> [DURATION] MSG …"
    snippet: 'REM 2025-10-05 AT 09:00 DURATION 1:00 MSG Riunione'
    priorita: Subito

  - id: P04 ✅
    pattern: Evento a orario in UTC
    ics: "DTSTART/DTEND con suffisso Z"
    remind_support: nativo+accorgimenti
    strategia: "converti a fuso locale prima di emettere AT"
    snippet: 'REM 2025-09-03 AT 06:45 MSG Treno'
    priorita: Subito

  - id: P05 ✅
    pattern: Ricorrenza settimanale semplice
    ics: "RRULE:FREQ=WEEKLY;BYDAY=…;[UNTIL|COUNT]"
    remind_support: nativo
    strategia: "REM <giorni> FROM <start> [UNTIL <end>] AT <hh:mm> MSG …"
    snippet: 'REM Mon Wed FROM 2025-09-01 UNTIL 2025-10-31 AT 09:00 MSG Standup'
    priorita: Subito

  - id: P06 ✅
    pattern: Ricorrenza giornaliera semplice
    ics: "RRULE:FREQ=DAILY;[UNTIL|COUNT]"
    remind_support: nativo
    strategia: "REM FROM <start> UNTIL <end> AT <hh:mm> EVERY 1 MSG …"
    snippet: 'REM FROM 2025-10-01 UNTIL 2025-10-10 AT 08:30 MSG Daily'
    priorita: Subito

  - id: P07 ✅
    pattern: Ricorrenza mensile per giorno fisso
    ics: "RRULE:FREQ=MONTHLY;BYMONTHDAY=…"
    remind_support: nativo
    strategia: "REM <giorno-num> AT <hh:mm> FROM/UNTIL"
    snippet: 'REM 15 AT 10:00 FROM 2025-01-01 MSG Fatture'
    priorita: Dopo

  - id: P08 ✅
    pattern: Ricorrenza “n-esimo weekday” del mese
    ics: "RRULE:FREQ=MONTHLY;BYDAY=MO;BYSETPOS=3"
    remind_support: espansione
    strategia: "materializza occorrenze in singoli REM o calcola in codice"
    snippet: '# genera REM per ciascuna data calcolata'
    priorita: Dopo

  - id: P09 ✅
    pattern: Ricorrenza annuale semplice
    ics: "RRULE:FREQ=YEARLY;[BYMONTH][BYMONTHDAY]"
    remind_support: nativo
    strategia: "REM <data ricorrente> MSG …"
    snippet: 'REM Jul 29 MSG Compleanno'
    priorita: Dopo

  - id: P10 ✅
    pattern: Eccezioni
    ics: "EXDATE (una o più), RDATE aggiuntive"
    remind_support: nativo+accorgimenti
    strategia: "usa OMIT per rimuovere date; aggiungi REM singoli per RDATE"
    snippet: 'REM Mon AT 09:00 FROM 2025-09-01 UNTIL 2025-10-31 MSG Standup\nOMIT 2025-10-13'
    priorita: Subito

  - id: P11 ✅
    pattern: Override/cancellazioni per istanza
    ics: "RECURRENCE-ID con contenuto modificato o STATUS:CANCELLED"
    remind_support: espansione
    strategia: "OMIT la data dalla serie; aggiungi REM singolo con i campi override"
    snippet: '# serie + REM specifico per l’istanza'
    priorita: Subito

  - id: P12 ✅
    pattern: DURATION al posto di DTEND
    ics: "DURATION:PT…"
    remind_support: nativo
    strategia: "mappa su DURATION <h:mm> in REM"
    snippet: 'REM 2025-10-05 AT 14:00 DURATION 2:30 MSG Workshop'
    priorita: Subito

  - id: P13
    pattern: Allarmi
    ics: "VALARM DISPLAY/AUDIO/EMAIL; TRIGGER relativo"
    remind_support: parziale
    strategia: "mappa 1 allarme principale su WARN; multipli opzionali come REM duplicati HIDE"
    snippet: 'REM 2025-10-05 AT 09:00 WARN 15 MSG Riunione'
    priorita: Dopo

  - id: P14 ✅
    pattern: Fusi orari dichiarati (VTIMEZONE, TZID diversi)
    ics: "VTIMEZONE + DTSTART;TZID=…"
    remind_support: nativo+accorgimenti
    strategia: "normalizza tutto al fuso locale del sistema prima dell’output"
    snippet: '# conversione in pre-processing'
    priorita: Subito

  - id: P15 ❌ WILL NOT SUPPORT
    pattern: Partecipanti/organizzatore
    ics: "ORGANIZER, ATTENDEE*, PARTSTAT…"
    remind_support: non previsto
    strategia: "appendi a DESCRIPTION/MSG come testo"
    snippet: '# nessuna semantica in Remind'
    priorita: Quando serve

  - id: P16 ❌ WILL NOT SUPPORT
    pattern: Allegati/URL esterni
    ics: "ATTACH, URL"
    remind_support: non previsto
    strategia: "conserva URL in coda al MSG"
    snippet: '# link nel testo'
    priorita: Quando serve

  - id: P17 ✅
    pattern: Meeting online (Google/Teams metadati)
    ics: "X-GOOGLE-CONFERENCE, X-MICROSOFT-*"
    remind_support: non previsto
    strategia: "estrai solo URL di join nel MSG"
    snippet: '# riduci al link'
    priorita: Quando serve
*)

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 _)) ->
              skip (* Start is a date, end is a datetime: invalid case for all-day event *)
          | 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) ->
              (* Start is a datetime, end is a date: invalid case for timed event *)
              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
  if List.length triggers > 0 then begin
    Printf.eprintf "UID: %s\n" (Utils.get_uid ev);
    ListLabels.iteri triggers ~f:(fun i trigger ->
        Printf.eprintf "  Trigger %d: %s\n" (i + 1) (Timedesc.Span.to_string trigger));
    Printf.eprintf "\n"
  end;
  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 debug_print_of_recurrence_and_skip ev recurs =
  let uid = Utils.get_uid ev in
  Printf.eprintf "RRULE: %s\t\t\tUID: %s\n" (Icalendar.show_recurrence recurs) uid;
  skip

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 if List.length rem.recurring > 0 then (
        Printf.eprintf "Warning: skipping complex recurrence with EXDATE/RDATE/overrides, not supported\t\t\tUID: %s\n"
          (Utils.get_uid ev);
        debug_print_of_recurrence_and_skip ev (freq, count_or_until, interval, recurs))
      else
        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 ->
          Printf.eprintf "Warning: MONTHLY INTERVAL=%d not supported\t\t\tUID: %s\n" n (Utils.get_uid ev);
          debug_print_of_recurrence_and_skip ev (`Monthly, count_or_until, interval, recurs)
      | _ -> (
          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 ->
              Printf.eprintf "Warning: MONTHLY with unsupported BYDAY\t\t\tUID: %s\n" (Utils.get_uid ev);
              debug_print_of_recurrence_and_skip ev (`Monthly, count_or_until, interval, recurs)
          | Some p -> Ok { rem with Remind.monthly = Some { count_or_until; interval; pattern = p } })
      end
  | Some (_, recurs) -> debug_print_of_recurrence_and_skip ev recurs
  | 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 ->
              Printf.eprintf "Warning: override event has no RECURRENCE-ID\t\t\tUID: %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 _ ->
                Printf.eprintf "Warning: could not build override REM\t\t\tUID: %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)