Browse Source

Initial commit.

master
linse 3 years ago
commit
9e33986a49
  1. 7
      CHANGES.md
  2. 3
      LICENSE.md
  3. 8
      Makefile
  4. 6
      README.md
  5. 2
      dune-project
  6. 5
      src/dune
  7. 458
      src/recurrence.ml
  8. 2176
      src/vcard.ml
  9. 288
      src/vcard.mli
  10. 5
      test/dune
  11. 2602
      test/test.ml
  12. 619
      test/test_recur.ml
  13. 42
      vcard.opam

7
CHANGES.md

@ -0,0 +1,7 @@
### v0.1.1 (2019-05-27)
* Adapt to gmap 0.3.0 API changes.
### v0.1.0 (2018-11-12)
* initial release.

3
LICENSE.md

@ -0,0 +1,3 @@
Permission to use, copy, modify, and distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies.
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

8
Makefile

@ -0,0 +1,8 @@
all: clean
dune build -p vcard
test: all
dune runtest --no-buffer -j 1
clean:
dune clean
utop:
dune utop src --profile=release

6
README.md

@ -0,0 +1,6 @@
# iCalendar library
A library to parse and print the iCalendar (.ics) format as specified in RFC5545.
Supports recurrent events, but only to the day level of detail.
Does not support vJournal components.
![travis build status icon](https://api.travis-ci.org/roburio/vcard.svg)

2
dune-project

@ -0,0 +1,2 @@
(lang dune 1.3)
(name icalendar)

5
src/dune

@ -0,0 +1,5 @@
(library
(name vcard)
(public_name vcard)
(preprocess (pps ppx_deriving.std))
(libraries re fmt angstrom uri astring rresult ptime gmap))

458
src/recurrence.ml

@ -0,0 +1,458 @@
(* date arithmetic *)
let leap_year y =
(* defined as dividible by 4, but not dividable by 100, but those by 400 *)
match y mod 4 = 0, y mod 100 = 0, y mod 400 = 0 with
| false, _, _ -> false
| true, false, _ -> true
| true, true, false -> false
| true, true, true -> true
let days_in_month year = function
| 1 -> 31
| 2 when leap_year year -> 29
| 2 -> 28
| 3 -> 31
| 4 -> 30
| 5 -> 31
| 6 -> 30
| 7 -> 31
| 8 -> 31
| 9 -> 30
| 10 -> 31
| 11 -> 30
| 12 -> 31
| _ -> assert false
let add_years amount (y, m, d) = (y + amount, m, d)
let sub_years amount (y, m, d) = (y - amount, m, d)
(* TODO encapsulate in data structure? *)
let add_months amount (y, m, d) =
let rec inc_y (ny, nm, nd) month =
if month > 12
then inc_y (add_years 1 (ny, nm, nd)) (month - 12)
else (ny, month, nd)
in
let m' = m + amount in
inc_y (y, m, d) m'
let sub_months amount (y, m, d) =
let rec dec_y (ny, nm, nd) month =
if month < 1
then dec_y (sub_years 1 (ny, nm, nd)) (month + 12)
else (ny, month, nd)
in
let m' = m - amount in
dec_y (y, m, d) m'
let add_days amount (y, m, d) =
let rec inc_m (ny, nm, nd) days =
let md = days_in_month ny nm in
if days > md
then inc_m (add_months 1 (ny, nm, nd)) (days - md)
else (ny, nm, days)
in
let d' = d + amount in
inc_m (y, m, d) d'
let sub_days amount (y, m, d) =
let rec dec_m (ny, nm, nd) days =
if days < 1
then
let (ny', nm', nd') = sub_months 1 (ny, nm, nd) in
let md = days_in_month ny' nm' in
dec_m (ny', nm', nd') (days + md)
else (ny, nm, days)
in
let d' = d - amount in
dec_m (y, m, d) d'
let add_weeks amount date = add_days (7 * amount) date
(* find opt on lists *)
let find_opt f xs =
match
List.filter (function None -> false | Some _ -> true)
(List.map f xs)
with
| [] -> None
| [ Some x ] -> Some x
| _ -> invalid_arg "wrong"
(* TODO remove ` from type *)
let wd_is_weekday wd wd' = match wd, wd' with
| `Monday, `Monday | `Tuesday, `Tuesday | `Wednesday, `Wednesday
| `Thursday, `Thursday | `Friday, `Friday | `Saturday, `Saturday
| `Sunday, `Sunday -> true
| _ -> false
let days_in_year y = if leap_year y then 366 else 365
let days_since_start_of_year (y, m, d) =
let rec md = function
| 0 -> 0
| n -> days_in_month y n + md (pred n)
in
md (pred m) + d
let days_until_end_of_year (y, m, d) =
let rec md = function
| 12 -> 31 - d
| n -> days_in_month y m + md (succ n)
in
md m
let weekday (y, m, d) =
let d1_to_date = pred @@ days_since_start_of_year (y, m, d) in
let epoch_to_d1 =
let rec go = function
| 1969 -> 0
| x -> days_in_year x + go (pred x)
in
go (pred y)
in
(* 1970/01/01 was a thursday! *)
match (epoch_to_d1 + d1_to_date) mod 7 with
| 0 -> `Thursday
| 1 -> `Friday
| 2 -> `Saturday
| 3 -> `Sunday
| 4 -> `Monday
| 5 -> `Tuesday
| 6 -> `Wednesday
| _ -> invalid_arg "bad input for weekday"
let wd = function
| `Sunday -> 0
| `Monday -> 1
| `Tuesday -> 2
| `Wednesday -> 3
| `Thursday -> 4
| `Friday -> 5
| `Saturday -> 6
let w1d1_offset year =
let wd = wd (weekday (year, 01, 01)) in
(11 - wd) mod 7 - 3
(* TODO needs to be parametrised by wkst! *)
(* day 1 of week 1 in a given year *)
let w1d1 year =
let off = w1d1_offset year
and date = (year, 01, 01)
in
if off < 0
then sub_days (abs off) date
else add_days off date
(* returns (year * weeknumber), year can be last year, this year or next year *)
(* (date - d1w1) / 7 + 1 *)
let rec week_number (y, m, d) =
let days = pred @@ days_since_start_of_year (y, m, d)
and off = w1d1_offset y
in
let ndays = days - off in
if ndays < 0
then week_number (pred y, 12, 31)
else
let next_off = w1d1_offset (succ y) in
if next_off < 0 && days_until_end_of_year (y, m, d) + next_off <= 0
then (succ y, 1)
else (y, ndays / 7 + 1)
let weeks y =
let off = w1d1_offset (succ y) in
let last_day = (y, 12, 31) in
let last =
if off >= 0
then add_days off last_day
else sub_days (abs (pred off)) last_day
in
snd (week_number last)
(* for matches: if n is negative, index from end, which is defined as -1 *)
let monthday_matches (y, m, d) n =
if d = n
then true
else if n < 0
then d = days_in_month y m + succ n
else false
let weekno_matches date wn =
let y, week = week_number date in
if week = wn
then true
else if wn < 0
then week = weeks y + succ wn
else false
let yearday_matches (y, m, d) n =
let count = days_since_start_of_year (y, m, d) in
if count = n
then true
else if n < 0
then count = days_in_year y + succ n
else false
(* x: 0 => every $wd
x: pos => the xth $wd in month,
x: neg => the xth $wd in month, from end *)
let weekday_matches (y, m, d) (x, wd) =
let weekday = weekday (y, m, d) in
if wd_is_weekday weekday wd
then
let n = succ (pred d / 7) in
match x with
| 0 -> true
| x ->
if x > 0
then n = x
else
let total = n + (days_in_month y m - d) / 7 in
n = total + succ x
else false
let yearly_weekday_matches (y, m, d) (x, wd) =
let weekday = weekday (y, m, d) in
if wd_is_weekday weekday wd
then
let n =
let d = days_since_start_of_year (y, m, d) in
succ (d / 7)
in
match x with
| 0 -> true
| x ->
if x > 0
then n = x
else
let total = n + (days_in_year y - n) / 7 in
n = total + succ x
else false
let opt f default = function
| None -> default
| Some x -> f x
let is_occurence s_date freq (bymonth, byweekno, byyearday, bymonthday, byday) =
match freq with
| `Daily ->
let (y, m, d) = s_date in
let is_bymonth = match bymonth with
| None -> true
| Some ms -> List.mem m ms
in
let is_bymonthday = match bymonthday with
| None -> true
| Some ds -> List.exists (monthday_matches (y, m, d)) ds
in
let is_byday = match byday with
| None -> true
| Some ds ->
let weekday = weekday (y, m, d) in
List.exists (fun (_, wk') -> wd_is_weekday weekday wk') ds
in
is_bymonth && is_bymonthday && is_byday
| `Weekly ->
let (y, m, d) = s_date in
let is_bymonth = match bymonth with
| None -> true
| Some ms -> List.mem m ms
in
let is_byday = match byday with
| None -> true
| Some ds ->
let weekday = weekday (y, m, d) in
List.exists (fun (_, wk') -> wd_is_weekday weekday wk') ds
in
is_bymonth && is_byday
| `Monthly ->
let (y, m, d) = s_date in
let is_bymonth = match bymonth with
| None -> true
| Some ms -> List.mem m ms
in
let is_bymonthday = match bymonthday with
| None -> true
| Some md -> List.exists (monthday_matches (y, m, d)) md
in
let is_byday = match byday with
| None -> true
| Some wd -> List.exists (weekday_matches (y, m, d)) wd
in
is_bymonth && is_bymonthday && is_byday
| `Yearly ->
let (y, m, d) = s_date in
let is_bymonth = match bymonth with
| None -> true
| Some ms -> List.mem m ms
in
let is_byweekno = match byweekno with
| None -> true
| Some wn -> List.exists (weekno_matches (y, m, d)) wn
in
let is_byyearday = match byyearday with
| None -> true
| Some yd -> List.exists (yearday_matches (y, m, d)) yd
in
let is_bymonthday = match bymonthday with
| None -> true
| Some md -> List.exists (monthday_matches (y, m, d)) md
in
let is_byday = match byday, bymonth with
| None, _ -> true
| Some wd, None -> List.exists (yearly_weekday_matches (y, m, d)) wd
| Some wd, Some _ -> List.exists (weekday_matches (y, m, d)) wd
in
is_bymonth && is_byweekno && is_byyearday && is_bymonthday && is_byday
| `Hourly | `Minutely | `Secondly -> invalid_arg "We don't support hourly, minutely or secondly for event frequencies."
let filter_bysetpos bysetpos set =
match bysetpos with
| None -> set
| Some p ->
let l = List.length set in
let positions = List.map (fun i -> if i < 0 then l + i else pred i) p |>
List.sort_uniq compare in
List.map (List.nth set) positions
let compare_dates (y, m, d) (y', m', d') = match compare y y' with
| 0 -> begin match compare m m' with
| 0 -> compare d d'
| x -> x
end
| x -> x
let after_start start set =
List.filter (fun d -> compare_dates d start >= 0) set
type gen_state = {
mutable next_interval : Ptime.t ;
mutable set : Ptime.t list ;
next_recurrence_set : Ptime.t -> Ptime.t * Ptime.t list
}
let init_rr next_interval freq interval filters bysetpos wkst =
(* needs to be computed completely, because bysetpos may index from back *)
let next_recurrence_set start =
let s_date, s_time = Ptime.to_date_time start in
(* start_set = beginning of recurrence set, e.g. start of month for monthly *)
let start_set, end_set, start_next_set =
let start_set, advance_by_freq = match freq with
| `Daily -> s_date, add_days
| `Weekly -> let rec weekstart d = if wd_is_weekday wkst (weekday d) then d, add_weeks else weekstart (sub_days 1 d) in weekstart s_date
| `Monthly -> let (y, m, _) = s_date in (y, m, 1), add_months
| `Yearly -> let (y, _, _) = s_date in (y, 1, 1), add_years
| _ -> assert false
in
let interval' = match interval with None -> 1 | Some x -> x in
start_set, advance_by_freq 1 start_set, advance_by_freq interval' start_set
in
let in_set x = compare_dates start_set x <= 0 && compare_dates x end_set < 0 in
let rec next_elem d =
if in_set d
then let d' = add_days 1 d in
if is_occurence d freq filters
then d :: next_elem d'
else next_elem d'
else []
in
let set = next_elem start_set in
let set' = filter_bysetpos bysetpos set in
let set'' = after_start s_date set' in
let to_ptime t = match Ptime.of_date_time (t, s_time) with
| None -> assert false (*TODO*)
| Some x -> x in
to_ptime start_next_set, List.map to_ptime set''
in
{ next_interval ; set = [] ; next_recurrence_set }
let rec next_rr g =
match g.set with
| [] ->
let next_interval', rr_set = g.next_recurrence_set g.next_interval in
g.next_interval <- next_interval' ;
g.set <- rr_set ;
next_rr g
| hd :: tl ->
g.set <- tl ;
hd
type count = {
mutable count : int ;
f : gen_state ;
}
let init_count count f = { count ; f }
let next_count g =
if g.count = 0
then None
else begin
g.count <- pred g.count ;
Some (next_rr g.f)
end
type until = {
until : Ptime.t ;
f : gen_state
}
let init_until until f = { until ; f }
let next_until g =
let candidate = next_rr g.f in
(* desired behaviour if Ptime.equal? need to check *)
if Ptime.is_earlier ~than:g.until candidate
then Some candidate
else None
let add_missing_filters recurs freq start =
let s_date, _s_time = Ptime.to_date_time start in
let bymonth = find_opt (function `Bymonth x -> Some x | _ -> None) recurs
and byweekno = find_opt (function `Byweek x -> Some x | _ -> None) recurs
and byyearday = find_opt (function `Byyearday x -> Some x | _ -> None) recurs
and bymonthday = find_opt (function `Bymonthday x -> Some x | _ -> None) recurs
and byday = find_opt (function `Byday x -> Some x | _ -> None) recurs
in
(* as freq we implement yearly, monthly, weekly and daily;
intervals between occurrences vary based on
- leap year and month lengths
- different recurrence rules combined with frequency;
because of variable intervals, we advance day by day and apply a filter.
If no filter (byday, bymonthday or byyearday) is defined, we build one from the start day.
For `Daily or `Weekly freq, we don't need to filter bymonthday. *)
let bymonthday = match freq, byday, bymonthday, byyearday with
| `Yearly, None, None, None
| `Monthly, None, None, None -> let (_, _, d) = s_date in Some [ d ]
| _ -> bymonthday
in
let byday = match freq, byday with
| `Weekly, None -> Some [ (0, weekday s_date) ]
| _ -> byday
in
(bymonth, byweekno, byyearday, bymonthday, byday)
(* create correct main generator *)
(* TODO timezone is not applied yet *)
let new_gen start recurrence =
let (freq, count_or_until, interval, recurs) = recurrence in
let filters = add_missing_filters recurs freq start
and bysetpos = find_opt (function `Bysetposday x -> Some x | _ -> None) recurs
and wkst = find_opt (function `Weekday x -> Some x | _ -> None) recurs in
let wkst = match wkst with None -> `Monday | Some x -> x in
let gen_event = init_rr start freq interval filters bysetpos wkst in
match count_or_until with
| Some (`Count n) ->
let gen_count = init_count n gen_event in
(fun () -> next_count gen_count)
| Some (`Until (`Utc ts)) -> (* TODO `Until (`Local ts)! *)
let gen_until = init_until ts gen_event in
(fun () -> next_until gen_until)
| _ ->
(fun () -> Some (next_rr gen_event))

2176
src/vcard.ml

File diff suppressed because it is too large

288
src/vcard.mli

@ -0,0 +1,288 @@
(* TODO: tag these with `Utc | `Local *)
type timestamp_utc = Ptime.t [@@deriving eq, show]
type timestamp_local = Ptime.t [@@deriving eq, show]
type utc_or_timestamp_local = [
| `Utc of timestamp_utc
| `Local of timestamp_local
] [@@deriving eq, show]
type timestamp = [
utc_or_timestamp_local
| `With_tzid of timestamp_local * (bool * string)
] [@@deriving eq, show]
type date_or_datetime = [ `Datetime of timestamp | `Date of Ptime.date ]
type weekday = [ `Friday | `Monday | `Saturday | `Sunday | `Thursday | `Tuesday | `Wednesday ] [@@deriving eq, 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 eq, show]
type freq = [ `Daily | `Hourly | `Minutely | `Monthly | `Secondly | `Weekly | `Yearly ] [@@deriving eq, show]
type count_or_until = [
| `Count of int
| `Until of utc_or_timestamp_local (* TODO date or datetime *)
] [@@deriving eq, show]
type interval = int
type recurrence = freq * count_or_until option * interval option * recur list [@@deriving eq, 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 ]
type partstat = [ `Accepted | `Completed | `Declined | `Delegated
| `In_process | `Needs_action | `Tentative
| `Ianatoken of string | `Xname of string * string ]
type role = [ `Chair | `Nonparticipant | `Optparticipant | `Reqparticipant
| `Ianatoken of string | `Xname of string * string ]
type relationship =
[ `Parent | `Child | `Sibling |
`Ianatoken of string | `Xname of string * string ]
type fbtype = [ `Free | `Busy | `Busy_Unavailable | `Busy_Tentative | `Ianatoken of string | `Xname of string * string ] [@@deriving eq, show]
type param_value = [ `Quoted of string | `String of string ]
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 (* TODO need to allow Iana_param "foo" and Iana_param "bar" in the same map! *)
| Xparam : ((string * string) * param_value list) icalparameter
module Params : sig include Gmap.S with type 'a key = 'a icalparameter end
type params = Params.t
type other_prop =
[ `Iana_prop of string * params * string
| `Xprop of (string * string) * params * string ] [@@deriving eq, show]
type cal_prop =
[ `Prodid of params * string
| `Version of params * string
| `Calscale of params * string
| `Method of params * string
| other_prop
]
type class_ = [ `Public | `Private | `Confidential | `Ianatoken of string | `Xname of string * string ]
type status = [ `Draft | `Final | `Cancelled |
`Needs_action | `Completed | `In_process | (* `Cancelled *)
`Tentative | `Confirmed (* | `Cancelled *) ]
type period = timestamp * Ptime.Span.t * bool
type period_utc = timestamp_utc * Ptime.Span.t * bool
type dates_or_datetimes = [ `Datetimes of timestamp list | `Dates of Ptime.date list ]
type dates_or_datetimes_or_periods = [ dates_or_datetimes | `Periods of period list ]
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
]
type event_prop = [
| general_prop
| `Transparency of params * [ `Transparent | `Opaque ]
| `Dtend of params * date_or_datetime
(* TODO: valuetype same as DTSTART *)
| other_prop
]
type 'a alarm_struct = {
trigger : params * [ `Duration of Ptime.Span.t | `Datetime of timestamp_utc ] ;
duration_repeat: ((params * Ptime.Span.t) * (params * int )) option ;
other: other_prop list ;
special: 'a ;
}
type audio_struct = {
attach: (params * [ `Uri of Uri.t | `Binary of string ]) option ;
}
type display_struct = {
description : params * string ;
}
type email_struct = {
description : params * string ;
summary : params * string ;
attendees : (params * Uri.t) list ;
attach: (params * [ `Uri of Uri.t | `Binary of string ]) option ;
}
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
]
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
]
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
]
type todo_prop = [
| general_prop
| `Completed of params * timestamp_utc
| `Percent of params * int
| `Due of params * date_or_datetime
| other_prop
]
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
]
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 ;
}
type timezone = timezone_prop list
type component = [
| `Event of event
| `Todo of todo_prop list * alarm list
| `Freebusy of freebusy_prop list
| `Timezone of timezone
] [@@deriving show]
(*
val in_timerange : component -> (Ptime.t * bool) * (Ptime.t * bool) -> bool
*)
val component_to_ics_key : component -> string
type calendar = cal_prop list * component list
val parse_datetime: string -> (timestamp, string) result
val parse : string -> (calendar, string) result
val pp : calendar Fmt.t
(* TODO this actually belongs to CalDAV! this is Webdav_xml module! *)
type comp = [ `Allcomp | `Comp of component_transform list ]
and prop = [ `Allprop | `Prop of (string * bool) list ]
and component_transform = string * prop * comp [@@deriving show, eq]
val to_ics : ?cr:bool -> ?filter:component_transform option -> calendar -> string
module Writer : sig
val duration_to_ics : Ptime.Span.t -> Buffer.t -> unit
val cal_prop_to_ics_key : cal_prop -> string
end
val recur_dates : Ptime.t -> recurrence -> (unit -> Ptime.t option)
val recur_events : event -> (unit -> event option)
val normalize_timezone : Ptime.t -> bool * String.t ->
timezone_prop list list ->
Ptime.t option
(*
val add_tzid_offset : timestamp_local -> string -> timezone list -> timestamp_utc
val remove_tzid_offset : timestamp_utc -> string -> timezone list -> timestamp_local
*)

5
test/dune

@ -0,0 +1,5 @@
(test
(name test)
(modules test test_recur)
(libraries alcotest vcard)
(package vcard))

2602
test/test.ml

File diff suppressed because it is too large

619
test/test_recur.ml

@ -0,0 +1,619 @@
let to_ptime date time =
match Ptime.of_date_time (date, (time, 0)) with
| None -> Alcotest.fail "invalid date time"
| Some p -> p
let p =
let module M = struct
type t = Ptime.t
let pp = Ptime.pp_human ()
let equal = Ptime.equal
end in (module M : Alcotest.TESTABLE with type t = M.t)
module Recurrence = Vcard__Recurrence
let first_n n start recurrence =
let next_event = Recurrence.new_gen start recurrence in
let rec compute_next_event = function
| 0 -> []
| n -> match next_event () with
| None -> []
| Some event -> event :: compute_next_event (pred n)
in
compute_next_event n
let all_events date time recurrence =
let start = to_ptime date time in
first_n 2000 start recurrence
(* from RFC 5545 section 3.8.5.3, but using UTC as timezone *)
let ex_1 () =
let date = (1997, 09, 02)
and time = (09, 00, 00)
and rrule = (`Daily, Some (`Count 10), None, [])
and res_dates = [
(1997, 09, 02) ; (1997, 09, 03) ; (1997, 09, 04) ; (1997, 09, 05) ;
(1997, 09, 06) ; (1997, 09, 07) ; (1997, 09, 08) ; (1997, 09, 09) ;
(1997, 09, 10) ; (1997, 09, 11)
]
in
Alcotest.(check (list p) "compute occurences example 1"
(List.map (fun d -> to_ptime d time) res_dates)
(all_events date time rrule))
let ex_2 () =
(* modified end: october instead of december *)
let date = (1997, 09, 02)
and time = (09, 00, 00)
and rrule = (`Daily, Some (`Until (`Utc (to_ptime (1997, 10, 24) (00, 00, 00)))), None, [])
and res = [
(1997, 09, 02) ; (1997, 09, 03) ; (1997, 09, 04) ; (1997, 09, 05) ;
(1997, 09, 06) ; (1997, 09, 07) ; (1997, 09, 08) ; (1997, 09, 09) ;
(1997, 09, 10) ; (1997, 09, 11) ; (1997, 09, 12) ; (1997, 09, 13) ;
(1997, 09, 14) ; (1997, 09, 15) ; (1997, 09, 16) ; (1997, 09, 17) ;
(1997, 09, 18) ; (1997, 09, 19) ; (1997, 09, 20) ; (1997, 09, 21) ;
(1997, 09, 22) ; (1997, 09, 23) ; (1997, 09, 24) ; (1997, 09, 25) ;
(1997, 09, 26) ; (1997, 09, 27) ; (1997, 09, 28) ; (1997, 09, 29) ;
(1997, 09, 30) ; (1997, 10, 01) ; (1997, 10, 02) ; (1997, 10, 03) ;
(1997, 10, 04) ; (1997, 10, 05) ; (1997, 10, 06) ; (1997, 10, 07) ;
(1997, 10, 08) ; (1997, 10, 09) ; (1997, 10, 10) ; (1997, 10, 11) ;
(1997, 10, 12) ; (1997, 10, 13) ; (1997, 10, 14) ; (1997, 10, 15) ;
(1997, 10, 16) ; (1997, 10, 17) ; (1997, 10, 18) ; (1997, 10, 19) ;
(1997, 10, 20) ; (1997, 10, 21) ; (1997, 10, 22) ; (1997, 10, 23) ;
]
in
Alcotest.(check (list p) "compute occurences example 2"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_3 () =
(* "every other day - forever" <- won't terminate atm, introduced a count *)
let date = (1997, 09, 02)
and time = (09, 00, 00)
and rrule = (`Daily, Some (`Count 10), Some 2, [])
and res = [
(1997, 09, 02) ; (1997, 09, 04) ; (1997, 09, 06) ; (1997, 09, 08) ;
(1997, 09, 10) ; (1997, 09, 12) ; (1997, 09, 14) ; (1997, 09, 16) ;
(1997, 09, 18) ; (1997, 09, 20)
]
in
Alcotest.(check (list p) "compute occurences example 3"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule)) ;
(* same with until *)
let rrule' =
(`Daily, Some (`Until (`Utc (to_ptime (1997, 09, 20) (10, 00, 00)))), Some 2, [])
in
Alcotest.(check (list p) "compute occurences example 3"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule'))
let ex_4 () =
let date = (1997, 09, 02)
and time = (09, 00, 00)
and rrule = (`Daily, Some (`Count 5), Some 10, [])
and res = [
(1997, 09, 02) ; (1997, 09, 12) ; (1997, 09, 22) ; (1997, 10, 02) ;
(1997, 10, 12)
]
in
Alcotest.(check (list p) "compute occurences example 4"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_5 () =
let date = (1998, 01, 01)
and time = (09, 00, 00)
and rrule = (`Daily, Some (`Until (`Utc (to_ptime (2000, 01, 31) (14, 00, 00)))), None, [ `Bymonth [ 1 ]])
and res = [
(1998, 01, 01) ; (1998, 01, 02) ; (1998, 01, 03) ; (1998, 01, 04) ;
(1998, 01, 05) ; (1998, 01, 06) ; (1998, 01, 07) ; (1998, 01, 08) ;
(1998, 01, 09) ; (1998, 01, 10) ; (1998, 01, 11) ; (1998, 01, 12) ;
(1998, 01, 13) ; (1998, 01, 14) ; (1998, 01, 15) ; (1998, 01, 16) ;
(1998, 01, 17) ; (1998, 01, 18) ; (1998, 01, 19) ; (1998, 01, 20) ;
(1998, 01, 21) ; (1998, 01, 22) ; (1998, 01, 23) ; (1998, 01, 24) ;
(1998, 01, 25) ; (1998, 01, 26) ; (1998, 01, 27) ; (1998, 01, 28) ;
(1998, 01, 29) ; (1998, 01, 30) ; (1998, 01, 31) ;
(1999, 01, 01) ; (1999, 01, 02) ; (1999, 01, 03) ; (1999, 01, 04) ;
(1999, 01, 05) ; (1999, 01, 06) ; (1999, 01, 07) ; (1999, 01, 08) ;
(1999, 01, 09) ; (1999, 01, 10) ; (1999, 01, 11) ; (1999, 01, 12) ;
(1999, 01, 13) ; (1999, 01, 14) ; (1999, 01, 15) ; (1999, 01, 16) ;
(1999, 01, 17) ; (1999, 01, 18) ; (1999, 01, 19) ; (1999, 01, 20) ;
(1999, 01, 21) ; (1999, 01, 22) ; (1999, 01, 23) ; (1999, 01, 24) ;
(1999, 01, 25) ; (1999, 01, 26) ; (1999, 01, 27) ; (1999, 01, 28) ;
(1999, 01, 29) ; (1999, 01, 30) ; (1999, 01, 31) ;
(2000, 01, 01) ; (2000, 01, 02) ; (2000, 01, 03) ; (2000, 01, 04) ;
(2000, 01, 05) ; (2000, 01, 06) ; (2000, 01, 07) ; (2000, 01, 08) ;
(2000, 01, 09) ; (2000, 01, 10) ; (2000, 01, 11) ; (2000, 01, 12) ;
(2000, 01, 13) ; (2000, 01, 14) ; (2000, 01, 15) ; (2000, 01, 16) ;
(2000, 01, 17) ; (2000, 01, 18) ; (2000, 01, 19) ; (2000, 01, 20) ;
(2000, 01, 21) ; (2000, 01, 22) ; (2000, 01, 23) ; (2000, 01, 24) ;
(2000, 01, 25) ; (2000, 01, 26) ; (2000, 01, 27) ; (2000, 01, 28) ;
(2000, 01, 29) ; (2000, 01, 30) ; (2000, 01, 31) ;
]
in
Alcotest.(check (list p) "compute occurences example 5"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule)) ;
let all_days = [
(0, `Sunday) ; (0, `Monday) ; (0, `Tuesday) ; (0, `Wednesday) ;
(0, `Thursday) ; (0, `Friday) ; (0, `Saturday)
] in
let rrule' =
(`Yearly,
Some (`Until (`Utc (to_ptime (2000, 01, 31) (14, 00, 00)))),
None, [ `Bymonth [ 1 ] ; `Byday all_days ])
in
Alcotest.(check (list p) "compute occurences example 5"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule'))
let ex_6 () =
let date = (1997, 09, 02)
and time = (09, 00, 00)
and rrule = (`Weekly, Some (`Count 10), None, [])
and res = [
(1997, 09, 02) ; (1997, 09, 09) ; (1997, 09, 16) ; (1997, 09, 23) ;
(1997, 09, 30) ; (1997, 10, 07) ; (1997, 10, 14) ; (1997, 10, 21) ;
(1997, 10, 28) ; (1997, 11, 04)
]
in
Alcotest.(check (list p) "compute occurences example 6"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_7 () =
let date = (1997, 09, 02)
and time = (09, 00, 00)
and rrule = (`Weekly, Some (`Until (`Utc (to_ptime (1997, 12, 24) (0, 0, 0)))), None, [])
and res = [
(1997, 09, 02) ; (1997, 09, 09) ; (1997, 09, 16) ; (1997, 09, 23) ;
(1997, 09, 30) ; (1997, 10, 07) ; (1997, 10, 14) ; (1997, 10, 21) ;
(1997, 10, 28) ; (1997, 11, 04) ; (1997, 11, 11) ; (1997, 11, 18) ;
(1997, 11, 25) ; (1997, 12, 02) ; (1997, 12, 09) ; (1997, 12, 16) ;
(1997, 12, 23)
]
in
Alcotest.(check (list p) "compute occurences example 7"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_8 () =
(* every other week - forever <- limited by 10 *)
let date = (1997, 09, 02)
and time = (09, 00, 00)
and rrule = (`Weekly, Some (`Count 10), Some 2, [`Weekday `Sunday])
and res = [
(1997, 09, 02) ; (1997, 09, 16) ; (1997, 09, 30) ; (1997, 10, 14) ;
(1997, 10, 28) ; (1997, 11, 11) ; (1997, 11, 25) ; (1997, 12, 09) ;
(1997, 12, 23) ; (1998, 01, 06)
]
in
Alcotest.(check (list p) "compute occurences example 8"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_9 () =
let date = (1997, 09, 02)
and time = (09, 00, 00)
and rrule = (`Weekly, Some (`Until (`Utc (to_ptime (1997, 10, 07) (00, 00, 00)))), None, [`Weekday `Sunday ; `Byday [ (0, `Tuesday) ; (0, `Thursday) ]])
and res = [
(1997, 09, 02) ; (1997, 09, 04) ; (1997, 09, 09) ; (1997, 09, 11) ;
(1997, 09, 16) ; (1997, 09, 18) ; (1997, 09, 23) ; (1997, 09, 25) ;
(1997, 09, 30) ; (1997, 10, 02)
]
in
Alcotest.(check (list p) "compute occurences example 9"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule)) ;
let rrule' = (`Weekly, Some (`Count 10), None, [`Weekday `Sunday ; `Byday [ (0, `Tuesday) ; (0, `Thursday) ]]) in
Alcotest.(check (list p) "compute occurences example 9"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule'))
let ex_10 () =
let date = (1997, 09, 01)
and time = (09, 00, 00)
and rrule = (`Weekly, Some (`Until (`Utc (to_ptime (1997, 12, 24) (00, 00, 00)))), Some 2, [`Weekday `Sunday ; `Byday [ (0, `Monday) ; (0, `Wednesday) ; (0, `Friday) ]])
and res = [
(1997, 09, 01) ; (1997, 09, 03) ; (1997, 09, 05) ; (1997, 09, 15) ;
(1997, 09, 17) ; (1997, 09, 19) ; (1997, 09, 29) ; (1997, 10, 01) ;
(1997, 10, 03) ; (1997, 10, 13) ; (1997, 10, 15) ; (1997, 10, 17) ;
(1997, 10, 27) ; (1997, 10, 29) ; (1997, 10, 31) ; (1997, 11, 10) ;
(1997, 11, 12) ; (1997, 11, 14) ; (1997, 11, 24) ; (1997, 11, 26) ;
(1997, 11, 28) ; (1997, 12, 08) ; (1997, 12, 10) ; (1997, 12, 12) ;
(1997, 12, 22)
]
in
Alcotest.(check (list p) "compute occurences example 10"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_11 () =
let date = (1997, 09, 02)
and time = (09, 00, 00)
and rrule = (`Weekly, Some (`Count 8), Some 2, [`Weekday `Sunday ; `Byday [ (0, `Tuesday) ; (0, `Thursday) ]])
and res = [
(1997, 09, 02) ; (1997, 09, 04) ; (1997, 09, 16) ; (1997, 09, 18) ;
(1997, 09, 30) ; (1997, 10, 02) ; (1997, 10, 14) ; (1997, 10, 16)
]
in
Alcotest.(check (list p) "compute occurences example 11"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_12 () =
let date = (1997, 09, 05)
and time = (09, 00, 00)
and rrule = (`Monthly, Some (`Count 10), None, [`Byday [ (1, `Friday) ]])
and res = [
(1997, 09, 05) ; (1997, 10, 03) ; (1997, 11, 07) ; (1997, 12, 05) ;
(1998, 01, 02) ; (1998, 02, 06) ; (1998, 03, 06) ; (1998, 04, 03) ;
(1998, 05, 01) ; (1998, 06, 05)
]
in
Alcotest.(check (list p) "compute occurences example 12"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_13 () =
let date = (1997, 09, 05)
and time = (09, 00, 00)
and rrule = (`Monthly, Some (`Until (`Utc (to_ptime (1997, 12, 24) (0, 0, 0)))), None, [`Byday [ (1, `Friday) ]])
and res = [
(1997, 09, 05) ; (1997, 10, 03) ; (1997, 11, 07) ; (1997, 12, 05)
]
in
Alcotest.(check (list p) "compute occurences example 13"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_14 () =
let date = (1997, 09, 07)
and time = (09, 00, 00)
and rrule = (`Monthly, Some (`Count 10), Some 2, [`Byday [ (1, `Sunday) ; (-1, `Sunday) ]])
and res = [
(1997, 09, 07) ; (1997, 09, 28) ; (1997, 11, 02) ; (1997, 11, 30) ;
(1998, 01, 04) ; (1998, 01, 25) ; (1998, 03, 01) ; (1998, 03, 29) ;
(1998, 05, 03) ; (1998, 05, 31)
]
in
Alcotest.(check (list p) "compute occurences example 14"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_15 () =
let date = (1997, 09, 22)
and time = (09, 00, 00)
and rrule = (`Monthly, Some (`Count 6), None, [`Byday [ (-2, `Monday) ]])
and res = [
(1997, 09, 22) ; (1997, 10, 20) ; (1997, 11, 17) ; (1997, 12, 22) ;
(1998, 01, 19) ; (1998, 02, 16)
]
in
Alcotest.(check (list p) "compute occurences example 15"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_16 () =
(* forever - again limiting with count 6 instead *)
let date = (1997, 09, 28)
and time = (09, 00, 00)
and rrule = (`Monthly, Some (`Count 6), None, [`Bymonthday [ -3 ]])
and res = [
(1997, 09, 28) ; (1997, 10, 29) ; (1997, 11, 28) ; (1997, 12, 29) ;
(1998, 01, 29) ; (1998, 02, 26)
]
in
Alcotest.(check (list p) "compute occurences example 16"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_17 () =
let date = (1997, 09, 02)
and time = (09, 00, 00)
and rrule = (`Monthly, Some (`Count 10), None, [`Bymonthday [ 2 ; 15 ]])
and res = [
(1997, 09, 02) ; (1997, 09, 15) ; (1997, 10, 02) ; (1997, 10, 15) ;
(1997, 11, 02) ; (1997, 11, 15) ; (1997, 12, 02) ; (1997, 12, 15) ;
(1998, 01, 02) ; (1998, 01, 15)
]
in
Alcotest.(check (list p) "compute occurences example 17"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_18 () =
(* to include last day of feb, increased count to 11 *)
let date = (1997, 09, 30)
and time = (09, 00, 00)
and rrule = (`Monthly, Some (`Count 11), None, [`Bymonthday [ 1 ; -1 ]])
and res = [
(1997, 09, 30) ; (1997, 10, 01) ; (1997, 10, 31) ; (1997, 11, 01) ;
(1997, 11, 30) ; (1997, 12, 01) ; (1997, 12, 31) ; (1998, 01, 01) ;
(1998, 01, 31) ; (1998, 02, 01) ; (1998, 02, 28)
]
in
Alcotest.(check (list p) "compute occurences example 18"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_19 () =
let date = (1997, 09, 10)
and time = (09, 00, 00)
and rrule = (`Monthly, Some (`Count 10), Some 18, [`Bymonthday [ 10 ; 11 ; 12 ; 13 ; 14 ; 15 ]])
and res = [
(1997, 09, 10) ; (1997, 09, 11) ; (1997, 09, 12) ; (1997, 09, 13) ;
(1997, 09, 14) ; (1997, 09, 15) ; (1999, 03, 10) ; (1999, 03, 11) ;
(1999, 03, 12) ; (1999, 03, 13)
]
in
Alcotest.(check (list p) "compute occurences example 19"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_20 () =
(* limited to 10 again *)
let date = (1997, 09, 02)
and time = (09, 00, 00)
and rrule = (`Monthly, Some (`Count 10), Some 2, [`Byday [ (0, `Tuesday) ]])
and res = [
(1997, 09, 02) ; (1997, 09, 09) ; (1997, 09, 16) ; (1997, 09, 23) ;
(1997, 09, 30) ; (1997, 11, 04) ; (1997, 11, 11) ; (1997, 11, 18) ;
(1997, 11, 25) ; (1998, 01, 06)
]
in
Alcotest.(check (list p) "compute occurences example 20"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_21 () =
let date = (1997, 06, 10)
and time = (09, 00, 00)
and rrule = (`Yearly, Some (`Count 10), None, [`Bymonth [ 6 ; 7 ]])
and res = [
(1997, 06, 10) ; (1997, 07, 10) ; (1998, 06, 10) ; (1998, 07, 10) ;
(1999, 06, 10) ; (1999, 07, 10) ; (2000, 06, 10) ; (2000, 07, 10) ;
(2001, 06, 10) ; (2001, 07, 10)
]
in
Alcotest.(check (list p) "compute occurences example 21"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_22 () =
let date = (1997, 03, 10)
and time = (09, 00, 00)
and rrule = (`Yearly, Some (`Count 10), Some 2, [`Bymonth [ 1 ; 2 ; 3 ]])
and res = [
(1997, 03, 10) ; (1999, 01, 10) ; (1999, 02, 10) ; (1999, 03, 10) ;
(2001, 01, 10) ; (2001, 02, 10) ; (2001, 03, 10) ; (2003, 01, 10) ;
(2003, 02, 10) ; (2003, 03, 10)
]
in
Alcotest.(check (list p) "compute occurences example 22"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_23 () =
let date = (1997, 01, 01)
and time = (09, 00, 00)
and rrule = (`Yearly, Some (`Count 10), Some 3, [`Byyearday [ 1 ; 100 ; 200 ]])
and res = [
(1997, 01, 01) ; (1997, 04, 10) ; (1997, 07, 19) ; (2000, 01, 01) ;
(2000, 04, 09) ; (2000, 07, 18) ; (2003, 01, 01) ; (2003, 04, 10) ;
(2003, 07, 19) ; (2006, 01, 01)
]
in
Alcotest.(check (list p) "compute occurences example 23"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_24 () =
(* forever - limiting to count 3 *)
let date = (1997, 05, 19)
and time = (09, 00, 00)
and rrule = (`Yearly, Some (`Count 3), None, [`Byday [ (20, `Monday) ]])
and res = [
(1997, 05, 19) ; (1998, 05, 18) ; (1999, 05, 17)
]
in
Alcotest.(check (list p) "compute occurences example 24"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_25 () =
(* forever - limiting to count 3 *)
let date = (1997, 05, 12)
and time = (09, 00, 00)
and rrule = (`Yearly, Some (`Count 3), None, [`Byweek [ 20 ] ; `Byday [ (0, `Monday) ]])
and res = [
(1997, 05, 12) ; (1998, 05, 11) ; (1999, 05, 17)
]
in
Alcotest.(check (list p) "compute occurences example 25"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_26 () =
(* forever - limiting to count 11 *)
let date = (1997, 03, 13)
and time = (09, 00, 00)
and rrule = (`Yearly, Some (`Count 11), None, [`Bymonth [ 3 ] ; `Byday [ (0, `Thursday) ]])
and res = [
(1997, 03, 13) ; (1997, 03, 20) ; (1997, 03, 27) ; (1998, 03, 05) ;
(1998, 03, 12) ; (1998, 03, 19) ; (1998, 03, 26) ; (1999, 03, 04) ;
(1999, 03, 11) ; (1999, 03, 18) ; (1999, 03, 25)
]
in
Alcotest.(check (list p) "compute occurences example 26"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_27 () =
(* forever - limiting to count 39 *)
let date = (1997, 06, 05)
and time = (09, 00, 00)
and rrule = (`Yearly, Some (`Count 39), None, [`Bymonth [ 6 ; 7 ; 8 ] ; `Byday [ (0, `Thursday) ]])
and res = [
(1997, 06, 05) ; (1997, 06, 12) ; (1997, 06, 19) ; (1997, 06, 26) ;
(1997, 07, 03) ; (1997, 07, 10) ; (1997, 07, 17) ; (1997, 07, 24) ;
(1997, 07, 31) ; (1997, 08, 07) ; (1997, 08, 14) ; (1997, 08, 21) ;
(1997, 08, 28) ; (1998, 06, 04) ; (1998, 06, 11) ; (1998, 06, 18) ;
(1998, 06, 25) ; (1998, 07, 02) ; (1998, 07, 09) ; (1998, 07, 16) ;
(1998, 07, 23) ; (1998, 07, 30) ; (1998, 08, 06) ; (1998, 08, 13) ;
(1998, 08, 20) ; (1998, 08, 27) ; (1999, 06, 03) ; (1999, 06, 10) ;
(1999, 06, 17) ; (1999, 06, 24) ; (1999, 07, 01) ; (1999, 07, 08) ;
(1999, 07, 15) ; (1999, 07, 22) ; (1999, 07, 29) ; (1999, 08, 05) ;
(1999, 08, 12) ; (1999, 08, 19) ; (1999, 08, 26)
]
in
Alcotest.(check (list p) "compute occurences example 27"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_28 () =
(* forever - limiting to count 5 *)
(* EXDATE for first thingy, adjusting to first real occurence *)
let date = (1998, 02, 13)
and time = (09, 00, 00)
and rrule = (`Monthly, Some (`Count 5), None, [`Bymonthday [ 13 ] ; `Byday [ (0, `Friday) ]])
and res = [
(1998, 02, 13) ; (1998, 03, 13) ; (1998, 11, 13) ; (1999, 08, 13) ;
(2000, 10, 13)
]
in
Alcotest.(check (list p) "compute occurences example 28"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_29 () =
(* forever - limiting to count 10 *)
let date = (1997, 09, 13)
and time = (09, 00, 00)
and rrule = (`Monthly, Some (`Count 10), None, [`Bymonthday [ 7 ; 8 ; 9 ; 10 ; 11 ; 12 ; 13 ] ; `Byday [ (0, `Saturday) ]])
and res = [
(1997, 09, 13) ; (1997, 10, 11) ; (1997, 11, 08) ; (1997, 12, 13) ;
(1998, 01, 10) ; (1998, 02, 07) ; (1998, 03, 07) ; (1998, 04, 11) ;
(1998, 05, 09) ; (1998, 06, 13)
]
in
Alcotest.(check (list p) "compute occurences example 29"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_30 () =
(* forever - limiting to count 3 *)
let date = (1996, 11, 05)
and time = (09, 00, 00)
and rrule = (`Yearly, Some (`Count 3), Some 4, [`Bymonth [ 11 ] ; `Byday [ (0, `Tuesday) ] ; `Bymonthday [ 2 ; 3 ; 4 ; 5 ; 6 ; 7 ; 8 ]])
and res = [
(1996, 11, 05) ; (2000, 11, 07) ; (2004, 11, 02)
]
in
Alcotest.(check (list p) "compute occurences example 30"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_31 () =
(* forever - limiting to count 3 *)
let date = (1996, 11, 29)
and time = (09, 00, 00)
and rrule = (`Monthly, Some (`Count 3), None, [`Byday [ (0, `Monday) ; (0, `Tuesday) ; (0, `Wednesday) ; (0, `Thursday) ; (0, `Friday) ] ; `Bysetposday [ -1 ]])
and res = [
(1996, 11, 29) ; (1996, 12, 31) ; (1997, 01, 31)
]
in
Alcotest.(check (list p) "compute occurences example 31: Bysetpos; last workday in month"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_32 () =
let date = (1997, 09, 04)
and time = (09, 00, 00)
and rrule = (`Monthly, Some (`Count 3), None, [`Byday [(0, `Tuesday); (0, `Wednesday); (0, `Thursday)] ; `Bysetposday [ 3 ]])
and res = [ (1997, 09, 04) ; (1997, 10, 07) ; (1997, 11, 06) ]
in
Alcotest.(check (list p) "The third instance into the month of one of Tuesday, Wednesday, or Thursday, for the next 3 months"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_33 () =
let date = (1997, 09, 29)
and time = (09, 00, 00)
and rrule = (`Monthly, Some (`Count 7), None, [`Byday [(0, `Monday); (0, `Tuesday); (0, `Wednesday); (0, `Thursday); (0, `Friday)] ; `Bysetposday [ -2 ]])
and res = [ (1997, 09, 29) ; (1997, 10, 30) ; (1997, 11, 27) ; (1997, 12, 30);
(1998, 01, 29) ; (1998, 02, 26) ; (1998, 03, 30) ]
in
Alcotest.(check (list p) "The second-to-last weekday of the month"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_34 () =
let date = (1997, 08, 05)
and time = (09, 00, 00)
and rrule = (`Weekly, Some (`Count 4), Some 2, [`Byday [(0,`Tuesday);(0, `Sunday)]; `Weekday `Monday])
and res = [ (1997, 08, 05) ; (1997, 08, 10) ; (1997, 08, 19) ; (1997, 08, 24) ]
in
Alcotest.(check (list p) "An example where the days generated makes a difference because of WKST"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_35 () =
let date = (1997, 08, 05)
and time = (09, 00, 00)
and rrule = (`Weekly, Some (`Count 4), Some 2, [`Byday [(0,`Tuesday);(0, `Sunday)]; `Weekday `Sunday])
and res = [ (1997, 08, 05) ; (1997, 08, 17) ; (1997, 08, 19) ; (1997, 08, 31) ]
in
Alcotest.(check (list p) "An example where the days generated makes a difference because of WKST"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let ex_36 () =
let date = (2007, 01, 15)
and time = (09, 00, 00)
and rrule = (`Monthly, Some (`Count 5), None, [`Bymonthday [15;30]])
and res = [(2007, 01, 15);(2007,01,30);(2007,02,15);(2007,03,15);(2007,03,30)]
in
Alcotest.(check (list p) "An example where an invalid date (i.e., February 30) is ignored"
(List.map (fun d -> to_ptime d time) res)
(all_events date time rrule))
let tests = [
"example 1", `Quick, ex_1 ;
"example 2", `Quick, ex_2 ;
"example 3", `Quick, ex_3 ;
"example 4", `Quick, ex_4 ;
"example 5", `Quick, ex_5 ;
"example 6", `Quick, ex_6 ;
"example 7", `Quick, ex_7 ;
"example 8", `Quick, ex_8 ;