module Params = struct
  include Icalendar.Params

  let pp ppf _m = Format.pp_print_string ppf "<params>"
end

type params = Params.t [@@deriving show]

module Ptime = struct
  include Ptime_augmented
end

(* TODO: tag these with `Utc | `Local *)
type timestamp_utc = Ptime.t [@@deriving show]
type timestamp_local = Ptime.t [@@deriving show]
type utc_or_timestamp_local = [ `Utc of timestamp_utc | `Local of timestamp_local ] [@@deriving show]
type timestamp = [ utc_or_timestamp_local | `With_tzid of timestamp_local * (bool * string) ] [@@deriving show]
type date_or_datetime = [ `Datetime of timestamp | `Date of Ptime.date ] [@@deriving show]
type weekday = [ `Friday | `Monday | `Saturday | `Sunday | `Thursday | `Tuesday | `Wednesday ] [@@deriving show]

type recur =
  [ `Byminute of int list
  | `Byday of (int * weekday) list
  | `Byhour of int list
  | `Bymonth of int list
  | `Bymonthday of int list
  | `Bysecond of int list
  | `Bysetposday of int list
  | `Byweek of int list
  | `Byyearday of int list
  | `Weekday of weekday ]
[@@deriving show]

type freq = [ `Daily | `Hourly | `Minutely | `Monthly | `Secondly | `Weekly | `Yearly ] [@@deriving show]
type count_or_until = [ `Count of int | `Until of utc_or_timestamp_local (* TODO date or datetime *) ] [@@deriving show]
type interval = int [@@deriving show]
type recurrence = freq * count_or_until option * interval option * recur list [@@deriving show]

type valuetype =
  [ `Binary
  | `Boolean
  | `Caladdress
  | `Date
  | `Datetime
  | `Duration
  | `Float
  | `Integer
  | `Period
  | `Recur
  | `Text
  | `Time
  | `Uri
  | `Utcoffset
  | `Xname of string * string
  | `Ianatoken of string ]

type cutype = [ `Group | `Individual | `Resource | `Room | `Unknown | `Ianatoken of string | `Xname of string * string ]
[@@deriving show]

type partstat =
  [ `Accepted
  | `Completed
  | `Declined
  | `Delegated
  | `In_process
  | `Needs_action
  | `Tentative
  | `Ianatoken of string
  | `Xname of string * string ]
[@@deriving show]

type role =
  [ `Chair | `Nonparticipant | `Optparticipant | `Reqparticipant | `Ianatoken of string | `Xname of string * string ]
[@@deriving show]

type relationship = [ `Parent | `Child | `Sibling | `Ianatoken of string | `Xname of string * string ] [@@deriving show]

type fbtype = [ `Free | `Busy | `Busy_Unavailable | `Busy_Tentative | `Ianatoken of string | `Xname of string * string ]
[@@deriving show]

type param_value = [ `Quoted of string | `String of string ] [@@deriving show]

type _ icalparameter =
  | Altrep : Uri.t icalparameter
  | Cn : param_value icalparameter
  | Cutype : cutype icalparameter
  | Delegated_from : Uri.t list icalparameter
  | Delegated_to : Uri.t list icalparameter
  | Dir : Uri.t icalparameter
  | Encoding : [ `Base64 ] icalparameter
  | Media_type : (string * string) icalparameter
  | Fbtype : fbtype icalparameter
  | Language : string icalparameter
  | Member : Uri.t list icalparameter
  | Partstat : partstat icalparameter
  | Range : [ `Thisandfuture ] icalparameter
  | Related : [ `Start | `End ] icalparameter
  | Reltype : relationship icalparameter
  | Role : role icalparameter
  | Rsvp : bool icalparameter
  | Sentby : Uri.t icalparameter
  | Tzid : (bool * string) icalparameter
  | Valuetype : valuetype icalparameter
  | Iana_param : string -> param_value list icalparameter
  | Xparam : (string * string) -> param_value list icalparameter
[@@deriving show]

type other_prop = [ `Iana_prop of string * params * string | `Xprop of (string * string) * params * string ]
[@@deriving show]

type cal_prop =
  [ `Prodid of params * string
  | `Version of params * string
  | `Calscale of params * string
  | `Method of params * string
  | other_prop ]
[@@deriving show]

type class_ = [ `Public | `Private | `Confidential | `Ianatoken of string | `Xname of string * string ]
[@@deriving show]

type status =
  [ `Draft
  | `Final
  | `Cancelled
  | `Needs_action
  | `Completed
  | `In_process
  | (* `Cancelled *)
    `Tentative
  | `Confirmed (* | `Cancelled *) ]
[@@deriving show]

type period = timestamp * Ptime.Span.t * bool [@@deriving show]
type period_utc = timestamp_utc * Ptime.Span.t * bool [@@deriving show]
type dates_or_datetimes = [ `Datetimes of timestamp list | `Dates of Ptime.date list ] [@@deriving show]
type dates_or_datetimes_or_periods = [ dates_or_datetimes | `Periods of period list ] [@@deriving show]

type general_prop =
  [ `Dtstamp of params * timestamp_utc
  | `Uid of params * string
  | `Dtstart of params * date_or_datetime
  | `Class of params * class_
  | `Created of params * timestamp_utc
  | `Description of params * string
  | `Geo of params * (float * float)
  | `Lastmod of params * timestamp_utc
  | `Location of params * string
  | `Organizer of params * Uri.t
  | `Priority of params * int
  | `Seq of params * int
  | `Status of params * status
  | `Summary of params * string
  | `Url of params * Uri.t
  | `Recur_id of params * date_or_datetime
  | (* TODO: Furthermore, this property MUST be specified
      as a date with local time if and only if the "DTSTART" property
      contained within the recurring component is specified as a date
      with local time. *)
    `Rrule of params * recurrence
  | `Duration of params * Ptime.Span.t
  | `Attach of params * [ `Uri of Uri.t | `Binary of string ]
  | `Attendee of params * Uri.t
  | `Categories of params * string list
  | `Comment of params * string
  | `Contact of params * string
  | `Exdate of params * dates_or_datetimes
  | `Rstatus of params * ((int * int * int option) * string * string option)
  | `Related of params * string
  | `Resource of params * string list
  | `Rdate of params * dates_or_datetimes_or_periods ]
[@@deriving show]

type event_prop =
  [ general_prop
  | `Transparency of params * [ `Transparent | `Opaque ]
  | `Dtend of params * date_or_datetime
  | (* TODO: valuetype same as DTSTART *)
    other_prop ]
[@@deriving show]

type 'a alarm_struct = {
  trigger : params * [ `Duration of Ptime.Span.t | `Datetime of timestamp_utc ];
  duration_repeat : ((params * Ptime.Span.t) * (params * int)) option;
  summary : (params * string) option;
  other : other_prop list;
  special : 'a;
}
[@@deriving show]

type audio_struct = { attach : (params * [ `Uri of Uri.t | `Binary of string ]) option } [@@deriving show]
type display_struct = { description : (params * string) option } [@@deriving show]

type email_struct = {
  description : params * string;
  attendees : (params * Uri.t) list;
  attach : (params * [ `Uri of Uri.t | `Binary of string ]) option;
}
[@@deriving show]

type alarm =
  [ `Audio of audio_struct alarm_struct
  | `Display of display_struct alarm_struct
  | `Email of email_struct alarm_struct
  | `None of unit alarm_struct ]
[@@deriving show]

type tz_prop =
  [ `Dtstart_local of params * timestamp_local
  | `Tzoffset_to of params * Ptime.Span.t
  | `Tzoffset_from of params * Ptime.Span.t
  | `Rrule of params * recurrence
  | `Comment of params * string
  | `Rdate of params * dates_or_datetimes_or_periods
  | `Tzname of params * string
  | other_prop ]
[@@deriving show]

type timezone_prop =
  [ `Timezone_id of params * (bool * string)
  | `Lastmod of params * timestamp_utc
  | `Tzurl of params * Uri.t
  | `Standard of tz_prop list
  | `Daylight of tz_prop list
  | other_prop ]
[@@deriving show]

type todo_prop =
  [ general_prop
  | `Completed of params * timestamp_utc
  | `Percent of params * int
  | `Due of params * date_or_datetime
  | other_prop ]
[@@deriving show]

type journal_prop = [ general_prop | other_prop ] [@@deriving show]

type freebusy_prop =
  [ `Dtstamp of params * timestamp_utc
  | `Uid of params * string
  | `Contact of params * string
  | `Dtstart_utc of params * timestamp_utc
  | `Dtend_utc of params * timestamp_utc
  | `Organizer of params * Uri.t
  | `Url of params * Uri.t
  | `Attendee of params * Uri.t
  | `Comment of params * string
  | `Freebusy of params * period_utc list
  | `Rstatus of params * ((int * int * int option) * string * string option)
  | other_prop ]
[@@deriving show]

type event = {
  dtstamp : params * timestamp_utc;
  uid : params * string;
  dtstart : params * date_or_datetime; (* NOTE: optional if METHOD present according to RFC 5545 *)
  dtend_or_duration : [ `Duration of params * Ptime.Span.t | `Dtend of params * date_or_datetime ] option;
  rrule : (params * recurrence) option; (* NOTE: RFC says SHOULD NOT occur more than once *)
  props : event_prop list;
  alarms : alarm list;
}
[@@deriving show]

type timezone = timezone_prop list [@@deriving show]

type component =
  [ `Event of event
  | `Todo of todo_prop list * alarm list
  | `Journal of journal_prop list
  | `Freebusy of freebusy_prop list
  | `Timezone of timezone ]
[@@deriving show]

let conv_alarm_struct (f : 'a -> 'b) (s : 'a Icalendar.alarm_struct) : 'b alarm_struct =
  {
    trigger = s.trigger;
    duration_repeat = s.duration_repeat;
    summary = s.summary;
    other = s.other;
    special = f s.special;
  }

let conv_audio_struct (s : Icalendar.audio_struct) : audio_struct = { attach = s.attach }
let conv_display_struct (s : Icalendar.display_struct) : display_struct = { description = s.description }

let conv_email_struct (s : Icalendar.email_struct) : email_struct =
  { description = s.description; attendees = s.attendees; attach = s.attach }

let conv_alarm (a : Icalendar.alarm) : alarm =
  match a with
  | `Audio s -> `Audio (conv_alarm_struct conv_audio_struct s)
  | `Display s -> `Display (conv_alarm_struct conv_display_struct s)
  | `Email s -> `Email (conv_alarm_struct conv_email_struct s)
  | `None s -> `None (conv_alarm_struct Fun.id s)

let conv_event (e : Icalendar.event) : event =
  {
    dtstamp = e.dtstamp;
    uid = e.uid;
    dtstart = e.dtstart;
    dtend_or_duration = e.dtend_or_duration;
    rrule = e.rrule;
    props = e.props;
    alarms = List.map conv_alarm e.alarms;
  }

let conv_component (c : Icalendar.component) : component =
  match c with
  | `Event e -> `Event (conv_event e)
  | `Todo (props, alms) -> `Todo (props, List.map conv_alarm alms)
  | `Journal props -> `Journal props
  | `Freebusy props -> `Freebusy props
  | `Timezone tz -> `Timezone tz

let parse s =
  Result.map (fun (cal_props, components) -> (cal_props, List.map conv_component components)) (Icalendar.parse s)