aboutsummaryrefslogtreecommitdiff
path: root/tests/unit/vcomponent/recurrence-simple.scm
blob: 82573ee4641d414dff6fa8fad5e8c49dba0e3412 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
;;; Commentary:
;; Simples tests of recurrence system, ensuring that all parsers and
;; basic generators work. Some more fully-featured tests are here, but
;; most are instead in recurrence-advanced.scm.
;;; Code:

(define-module (test recurrence-simple)
  :use-module (srfi srfi-64)
  :use-module (srfi srfi-64 test-error)
  :use-module (srfi srfi-88)
  :use-module ((srfi srfi-41)
               :select (stream-take stream-map stream->list stream-car))
  :use-module ((datetime) :select (day-stream mon))
  :use-module ((vcomponent base) :select (extract prop))
  :use-module ((sxml namespaced) :select (sxml->namespaced-sxml))
  :use-module ((calp namespaces) :select (xcal))
  :use-module ((hnh util) :select (->))
  :use-module (datetime)
  :use-module ((vcomponent create) :select (vcalendar vevent with-parameters))
  :use-module ((hnh util exceptions)
               :select (warnings-are-errors warning-handler))
  :use-module ((vcomponent recurrence)
               :select (parse-recurrence-rule
                        recur-rule
                        generate-recurrence-set)))

;;; TODO many of these tests simply check that the procedures don't crash.
;;; Actually check outputs.


;;; Test that basic parsing or recurrence rules work.

(test-equal (recur-rule freq: 'HOURLY wkst: mon interval: 1)
  (parse-recurrence-rule "FREQ=HOURLY"))

(test-equal (recur-rule freq: 'HOURLY count: 3 interval: 1 wkst: mon)
  (parse-recurrence-rule "FREQ=HOURLY;COUNT=3"))

;;; Test that recurrence rule parsing fails where appropriate

(parameterize ((warnings-are-errors #t)
               (warning-handler (lambda _ "")))
  (test-error "Invalid FREQ"
    'wrong-type-arg
    (parse-recurrence-rule "FREQ=ERR;COUNT=3"))
  (test-error "Negative COUNT"
    'wrong-type-arg
    (parse-recurrence-rule "FREQ=HOURLY;COUNT=-1"))
  (test-error "Invalid COUNT"
    'wrong-type-arg
    (parse-recurrence-rule "FREQ=HOURLY;COUNT=err")))

;;; Test that basic recurrence works
;;; also see the neighbour test file recurrence.scm for more tests.

(let ((ev (vevent
           dtstart: (date year: 2029 month: mars day: 2)
           rrule: (recur-rule freq: 'DAILY))))

  (test-assert "Generate at all"
    (stream-car (generate-recurrence-set ev)))

  (test-assert "Generate some"
    (stream->list
     (stream-take 5 (generate-recurrence-set ev))))

  (test-equal "Generate First"
    (stream->list
     5
     (stream-map
      (extract 'DTSTART)
      (generate-recurrence-set ev)))
    (stream->list 5 (day-stream (prop ev 'DTSTART))))

  ;; We run the exact same thing a secound time, since I had an error with
  ;; that during development.

  (test-equal "Generate Again"
    (stream->list
     (stream-take
      5
      (stream-map
       (extract 'DTSTART)
       (generate-recurrence-set ev))))
    (stream->list
     (stream-take 5 (day-stream (prop ev 'DTSTART))))))

(let ((ev (vevent
           dtstart: (datetime year: 2019 month: mars day: 2 hour: 10)
           rrule: (recur-rule freq: 'DAILY))))
  (test-assert "daily 10:00"
    (stream-car (generate-recurrence-set ev))))

(let ((ev (vevent
           dtstart: (datetime year: 2019 month: mars day: 2 hour: 10)
           dtend: (datetime year: 2019 month: mars day: 2 hour: 12)
           rrule: (recur-rule freq: 'DAILY))))
  (test-assert "daily 10-12"
    (stream-car (generate-recurrence-set ev))))

(let ((ev (vevent
           dtstart: (datetime year: 2019 month: mars day: 2 hour: 10)
           dtend: (datetime year: 2019 month: mars day: 2 hour: 12)
           rrule: (recur-rule freq: 'WEEKLY))))
  (test-assert "weekly 10-12"
    (stream-car (generate-recurrence-set ev))))

(let ((ev (vevent
         dtstart: (with-parameters tzid: "Europe/Stockholm"
                                   (datetime year: 2019 month: mars day: 2 hour: 10))
         dtend:   (with-parameters tzid: "Europe/Stockholm"
                                   (datetime year: 2019 month: mars day: 2 hour: 12))
         rrule: (recur-rule freq: 'WEEKLY))))
  (test-assert "weekly TZ 10-12"
    (stream-car (generate-recurrence-set ev))))

(let ((ev (vevent
           dtstart: (with-parameters tzid: "Europe/Stockholm"
                                     (datetime year: 2019 month: mars day: 2 hour: 10))
           dtend:   (with-parameters tzid: "Europe/Stockholm"
                                     (datetime year: 2019 month: mars day: 2 hour: 12))
           rrule: (recur-rule freq: 'WEEKLY)
           sequence: 1)))
  (test-assert "weekly TZ SEQUENCE 10-12"
    (stream-car (generate-recurrence-set ev))))

(let ((ev (vevent
           dtstart: (with-parameters tzid: "Europe/Stockholm"
                                     (datetime year: 2019 month: mars day: 2 hour: 10))
           dtend:   (with-parameters tzid: "Europe/Stockholm"
                                     (datetime year: 2019 month: mars day: 2 hour: 12))
           rrule: (recur-rule freq: 'WEEKLY)
           location: "Here"
           sequence: 1)))
  (test-assert "weekly TZ SEQUENCE LOCATION 10-12"
    (stream-car (generate-recurrence-set ev))))

(let ((ev (vevent
           dtstart: (datetime year: 2018 month: jan day: 17 hour: 17)
           rrule: (recur-rule freq: 'WEEKLY)
           location: "~")))
  (test-assert "Just location"
    (stream-car (generate-recurrence-set ev))))

(let ((ev (vevent
           dtstart: (datetime year: 2018 month: jan day: 17 hour: 17)
           dtend: (datetime year: 2018 month: jan day: 17 hour: 20)
           rrule: (recur-rule freq: 'WEEKLY))))
  (test-assert "Same times"
    (stream-car (generate-recurrence-set ev))))

(let ((ev (vevent
           dtstart: (with-parameters tzid: "Europe/Stockholm"
                                     (datetime year: 2018 month: jan day: 17 hour: 17))
           dtend:   (with-parameters tzid: "Europe/Stockholm"
                                     (datetime year: 2018 month: jan day: 17 hour: 20))
           rrule: (recur-rule freq: 'WEEKLY))))

  ;; errer in dtend ?
  (test-assert "Full test"
    (stream-car (generate-recurrence-set ev))))

;;; Tests that exceptions (in the recurrence-id meaning)
;;; in recurrence sets are handled correctly.
;;; TODO Is however far from done.

(let* ((uid (symbol->string (gensym "areallyuniqueid")))
       (ev
        (vcalendar
         (list
          (vevent
           summary: "Changing type on Recurrence-id."
           uid: uid
           dtstart: (date year: 2009 month: jan day: 27))
          (vevent
           uid: uid
           summary: "Changing type on Recurrence-id."
           dtstart: (with-parameters tzid: "Europe/Stockholm"
                                     (datetime year: 2010 month: jan day: 12 hour: 12))
           summary: "This instance only has a time component)")))))
  (test-assert "Changing type on Recurrence id."
    (stream->list 10 (generate-recurrence-set ev))))

;;; Earlier I failed to actually parse the recurrence parts, in short, 1 ≠ "1".

;;; TODO this should be part of the xCal tests
;; (test-assert "Test that xcal recur rules are parseable"
;;   ((@@ (vcomponent formats xcal parse) handle-value)
;;    'recur
;;    'props-are-unused-for-recur
;;    '((freq "WEEKLY") (interval "1") (wkst "MO"))))

(let ((ev (vevent
           summary: "reptest"
           dtstart: (datetime year: 2021 month: jan day: 13 hour: 1)
           dtend: (datetime year: 2021 month: jan day: 13 hour: 2)
           uid: "RNW198S6QANQPV1C4FDNFH6ER1VZX6KXEYNB"
           rrule: (recur-rule freq: 'WEEKLY
                              interval: 1
                              wkst: monday)
           dtstamp: (datetime year: 2021 month: jan day: 13
                              hour: 1 minute: 42 second: 20
                              tz: "UTC")
           sequence: 0)))

  (test-assert
      "Check that recurrence rule commint from xcal also works"
    (generate-recurrence-set ev)))


;;; TODO test here, for byday parsing, and multiple byday instances in one recur element
;;; TODO which should also test serializing and deserializing to xcal.
;;; For example, the following rules specify every workday

;; BEGIN:VCALENDAR
;; PRODID:-//hugo//calp 0.6.1//EN
;; VERSION:2.0
;; CALSCALE:GREGORIAN
;; BEGIN:VEVENT
;; SUMMARY:Lunch
;; DTSTART:20211129T133000
;; DTEND:20211129T150000
;; LAST-MODIFIED:20211204T220944Z
;; UID:3d82c73c-6cdb-4799-beba-5f1d20d55347
;; RRULE:FREQ=DAILY;BYDAY=MO,TU,WE,TH,FR
;; END:VEVENT
;; END:VCALENDAR

;; TODO add remaining rules


'((vcomponent recurrence)
  (vcomponent formats ical parse)
  (vcomponent formats xcal parse))