aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2023-10-16 19:39:12 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2023-10-16 19:40:24 +0200
commit22f28015981295660ff98b43789f8c4c99134f36 (patch)
treee6d43c74a23843212e0fc183a1e09ca2b5d2fa17
parentAdd `not` case to type validators. (diff)
downloadcalp-22f28015981295660ff98b43789f8c4c99134f36.tar.gz
calp-22f28015981295660ff98b43789f8c4c99134f36.tar.xz
Move timespec and recur-rule to new object system.
-rw-r--r--doc/ref/general/util.texi12
-rw-r--r--module/datetime/timespec.scm27
-rw-r--r--module/datetime/zic.scm18
-rw-r--r--module/hnh/util.scm22
-rw-r--r--module/vcomponent/formats/xcal/parse.scm2
-rw-r--r--module/vcomponent/recurrence.scm2
-rw-r--r--module/vcomponent/recurrence/internal.scm147
-rw-r--r--module/vcomponent/recurrence/parse.scm130
-rw-r--r--tests/unit/coverage-supplement.scm8
-rw-r--r--tests/unit/datetime/zic.scm16
-rw-r--r--tests/unit/vcomponent/recurrence-advanced.scm100
-rw-r--r--tests/unit/vcomponent/recurrence-simple.scm23
-rw-r--r--tests/unit/vcomponent/rrule-serialization.scm9
13 files changed, 241 insertions, 275 deletions
diff --git a/doc/ref/general/util.texi b/doc/ref/general/util.texi
index ced5c27a..caf67c47 100644
--- a/doc/ref/general/util.texi
+++ b/doc/ref/general/util.texi
@@ -265,18 +265,6 @@ list, in which case @var{->} inserts item as the second argument
@end defmac
-@defmac set (accessor object) value
-@defmacx set (accessor object) = (operation args ...)
-See @xref{SRFI-9 Records,,,guile}
-@end defmac
-
-@defmac set-> object (accessor value) rest ...
-@defmacx set-> object (accessor = (operator args)) rest ...
-Wrapper around @var{set}, but applies transformations from left to
-right, similar to @var{->}.
-@end defmac
-
-
@defmac and=>> value procedures ...
Chained application of @code{and=>}, so applies each procedure from
left to right, stopping when one return @code{#f}.
diff --git a/module/datetime/timespec.scm b/module/datetime/timespec.scm
index 53eba014..7ea448a0 100644
--- a/module/datetime/timespec.scm
+++ b/module/datetime/timespec.scm
@@ -4,12 +4,14 @@
;;; Code:
(define-module (datetime timespec)
- :use-module ((hnh util) :select (set unless))
+ :use-module ((hnh util) :select (unless))
:use-module ((hnh util exceptions) :select (warning))
+ :use-module (hnh util object)
+ :use-module (hnh util lens)
:use-module (datetime)
:use-module (srfi srfi-1)
:use-module (srfi srfi-71)
- :use-module (srfi srfi-9 gnu)
+ :use-module (srfi srfi-88)
:use-module (calp translation)
:export (make-timespec
timespec?
@@ -26,16 +28,22 @@
;; timespec as defined by the TZ-database
;; also used UTC-OFFSET defined by RFC5545. Then type should equal #\z
;; and be ignored.
-(define-immutable-record-type <timespec> ; EXPORTED
- (make-timespec timespec-time sign type)
- timespec?
- (timespec-time timespec-time) ; <time>
- (sign timespec-sign) ; '+ | '-
+
+(define-type (timespec)
+ (timespec-time type: time?)
+ (timespec-sign type: (memv '(+ -)))
;; types:
;; w - wall clock time (local time)
;; s - standard time without daylight savings adjustments
;; u, g, z - Universal time
- (type timespec-type)) ; char
+ (timespec-type type: char?))
+
+;;; TODO remove make-timespec
+;;; It's a transient procedure while changing object system
+(define (make-timespec time sign type)
+ (timespec timespec-time: time
+ timespec-sign: sign
+ timespec-type: type))
(define (timespec-zero)
(make-timespec (time) '+ #\w))
@@ -50,7 +58,8 @@
;; + +
[(eq? (timespec-sign done)
(timespec-sign spec))
- (set (timespec-time done) = (time+ (timespec-time spec)))]
+ (modify done timespec-time
+ time+ (timespec-time spec))]
;; - +
[(and (eq? '- (timespec-sign done))
(eq? '+ (timespec-sign spec)))
diff --git a/module/datetime/zic.scm b/module/datetime/zic.scm
index acfb17a8..ad02cae0 100644
--- a/module/datetime/zic.scm
+++ b/module/datetime/zic.scm
@@ -12,7 +12,7 @@
;;; Code:
(define-module (datetime zic)
:use-module ((hnh util)
- :select (awhen group set when sort* iterate group-by))
+ :select (awhen group when sort* iterate group-by))
:use-module ((hnh util exceptions) :select (warning))
:use-module (datetime)
:use-module (datetime timespec)
@@ -23,7 +23,7 @@
:use-module (srfi srfi-9 gnu)
:use-module (srfi srfi-71)
:use-module ((vcomponent recurrence internal)
- :select (byday make-recur-rule bymonthday))
+ :select (byday recur-rule bymonthday))
:use-module (calp translation)
:export (read-zoneinfo
@@ -369,7 +369,7 @@
(define (rule->rrule rule)
(if (eq? 'only (rule-to rule))
#f
- (let ((base (make-recur-rule
+ (let ((base (recur-rule
freq: 'YEARLY
interval: 1
bymonth: (list (rule-in rule))
@@ -388,8 +388,8 @@
(match (rule-on rule)
- ((? number? d) (set (bymonthday base) (list d)))
- (('last d) (set (byday base) (list (cons -1 d))))
+ ((? number? d) (bymonthday base (list d)))
+ (('last d) (byday base (list (cons -1 d))))
(('< wday base-day) (scm-error 'misc-error "rule->rrule" (G_ "Counting backward for RRULES unsupported") #f #f))
(('> wday base-day)
;; Sun<=25
@@ -398,10 +398,10 @@
;; something like Sun>=5 is hard to fix, since we can only
;; say which sunday in the month we want (first sunday,
;; second sunday, ...).
- (set (byday base)
- (list
- (cons (ceiling-quotient base-day 7)
- wday))))))))
+ (byday base
+ (list
+ (cons (ceiling-quotient base-day 7)
+ wday))))))))
;; special case of format which works with %s and %z
(define (zone-format fmt-string arg)
diff --git a/module/hnh/util.scm b/module/hnh/util.scm
index d888bea6..2ae5d2c4 100644
--- a/module/hnh/util.scm
+++ b/module/hnh/util.scm
@@ -3,7 +3,6 @@
:use-module (srfi srfi-71)
:use-module (srfi srfi-88) ; postfix keywords
:use-module ((sxml fold) :select (fold-values))
- :use-module ((srfi srfi-9 gnu) :select (set-fields))
:use-module ((ice-9 copy-tree) :select (copy-tree))
:use-module ((ice-9 control) :select (call/ec))
:export (aif
@@ -45,7 +44,6 @@
insert-ordered
-> ->>
- set set->
and=>>
downcase-symbol
@@ -487,26 +485,6 @@
((->> obj func rest ...)
(->> (func obj) rest ...))))
-;; Non-destructive set, syntax extension from set-fields from (srfi
-;; srfi-9 gnu).
-;;; TODO remove this, it's replaced by the true lens version
-(define-syntax set
- (syntax-rules (=)
- [(set (acc obj) value)
- (set-fields
- obj ((acc) value))]
- [(set (acc obj) = (op rest ...))
- (set-fields
- obj ((acc) (op (acc obj) rest ...)))]))
-
-(define-syntax set->
- (syntax-rules (=)
- [(_ obj) obj]
- [(_ obj (func = (op args ...)) rest ...)
- (set-> (set (func obj) (op (func obj) args ...)) rest ...)]
- [(_ obj (func args ...) rest ...)
- (set-> (set (func obj) args ...) rest ...)]))
-
(define-syntax and=>>
(syntax-rules ()
[(_ value) value]
diff --git a/module/vcomponent/formats/xcal/parse.scm b/module/vcomponent/formats/xcal/parse.scm
index 5ae1b928..d108b11c 100644
--- a/module/vcomponent/formats/xcal/parse.scm
+++ b/module/vcomponent/formats/xcal/parse.scm
@@ -96,7 +96,7 @@
;; freq until count interval wkst
- (apply (@ (vcomponent recurrence internal) make-recur-rule)
+ (apply (@ (vcomponent recurrence internal) recur-rule)
(concatenate
(filter identity
(for key in '(bysecond byminute byhour byday bymonthday
diff --git a/module/vcomponent/recurrence.scm b/module/vcomponent/recurrence.scm
index ffda0e7f..f7e82a1e 100644
--- a/module/vcomponent/recurrence.scm
+++ b/module/vcomponent/recurrence.scm
@@ -4,4 +4,4 @@
:use-module (vcomponent recurrence internal)
:re-export (generate-recurrence-set
parse-recurrence-rule
- repeating? make-recur-rule))
+ repeating? recur-rule))
diff --git a/module/vcomponent/recurrence/internal.scm b/module/vcomponent/recurrence/internal.scm
index 9bf425ac..4b4cd336 100644
--- a/module/vcomponent/recurrence/internal.scm
+++ b/module/vcomponent/recurrence/internal.scm
@@ -4,20 +4,23 @@
:use-module (srfi srfi-88) ; better keywords
:use-module ((vcomponent base) :select (prop))
:use-module (ice-9 i18n)
- :use-module (srfi srfi-9)
- :use-module (srfi srfi-9 gnu)
:use-module (ice-9 format)
+ :use-module (ice-9 pretty-print)
:use-module (hnh util)
+ :use-module (hnh util object)
+ :use-module ((hnh util type) :select (list-of pair-of false?))
:use-module (datetime)
:replace (count)
:export (repeating?
- make-recur-rule
+ recur-rule
freq until interval bysecond byminute byhour
byday bymonthday byyearday byweekno bymonth bysetpos
wkst
+ freq-placeholder
+
recur-rule->rrule-string
recur-rule->rrule-sxml
@@ -28,8 +31,11 @@
(define weekdays
(weekday-list sun))
+(define freq-placeholder (gensym))
+
(define intervals
- '(SECONDLY MINUTELY HOURLY DAILY WEEKLY MONTHLY YEARLY))
+ `(SECONDLY MINUTELY HOURLY DAILY WEEKLY MONTHLY YEARLY
+ ,freq-placeholder))
;; EXDATE is also a property linked to recurense rules
@@ -40,71 +46,74 @@
(prop ev 'RDATE)
(prop ev '-X-HNH-ALTERNATIVES)))
-;; weekday := [0, 7)
-
-;; Immutable, since I easily want to be able to generate the recurence set for
-;; the same event multiple times.
-(define-immutable-record-type <recur-rule>
- (make-recur-rule% freq until count interval bysecond byminute byhour
- byday bymonthday byyearday byweekno bymonth bysetpos
- wkst)
- recur-rule?
- (freq freq) ; 'SECONDLY | 'MINUTELY | 'HOURLY | 'DAILY | 'WEEKLY | 'MONTHLY | 'YEARLY
- (until until) ; <date> | <datetime>
- (count count) ; 𝐙₊
- (interval interval) ; 𝐙₊
- (bysecond bysecond) ; (list [0, 60])
- (byminute byminute) ; (list [0, 59])
- (byhour byhour) ; (list [0, 23])
- (byday byday) ; (list (cons [#f | 𝐙] weekday)
- (bymonthday bymonthday) ; (list [-31, 31] \ { 0 })
- (byyearday byyearday) ; (list [-366, 366] \ { 0 })
- (byweekno byweekno) ; (list [-53, 53] \ { 0 })
- (bymonth bymonth) ; (list [-12, 12] \ { 0 })
- (bysetpos bysetpos) ; (list [-366, 366] \ { 0 })
- (wkst wkst) ; weekday
- )
-
-
-
-;; Interval and wkst have default values, since those are assumed
-;; anyways, and having them set frees us from having to check them at
-;; the use site.
-(define* (make-recur-rule
- key:
- freq until count (interval 1) bysecond byminute byhour
- byday bymonthday byyearday byweekno bymonth bysetpos
- (wkst monday))
- ;; TODO possibly validate fields here
- ;; to prevent creation of invalid rules.
- ;; This was made apparent when wkst was (incorrectly) set to MO,
- ;; which later crashed generate-recurrence-set.
-
- ;; Allow `(cons #f day)' to be written as just `day'.
- (let ((byday* (if byday
- (map (lambda (day)
- (if (number? day)
- (cons #f day)
- day))
- byday)
- #f)))
- (make-recur-rule% freq until count interval bysecond byminute byhour
- byday* bymonthday byyearday byweekno bymonth bysetpos
- wkst)))
-
-;; only print fields with actual values.
-(set-record-type-printer!
- <recur-rule>
- (lambda (r port)
- (define (get f)
- ((record-accessor <recur-rule> f) r))
- (with-output-to-string
- (lambda ()
- (display "#<<recur-rule>" port)
- (for field in (record-type-fields <recur-rule>)
- (awhen (get field)
- (format port " ~a=~a" field it)))
- (display ">" port)))))
+(define-syntax-rule (in-range? x start end)
+ (<= start x end))
+
+(define (recur-rule-constructor-factory primitive-constructor type-checker)
+ ;; Interval and wkst have default values, since those are assumed
+ ;; anyways, and having them set frees us from having to check them at
+ ;; the use site.
+ (lambda* (key: freq until count (interval 1) bysecond byminute
+ byhour byday bymonthday byyearday byweekno bymonth
+ bysetpos (wkst monday))
+ ;; Allow `(cons #f day)' to be written as just `day'.
+ (let ((byday* (if byday
+ (map (lambda (day)
+ (if (number? day)
+ (cons #f day)
+ day))
+ byday)
+ #f)))
+ ;; TODO possibly check that until and count are mutually exclusive
+ (type-checker
+ freq until count interval bysecond byminute byhour
+ byday* bymonthday byyearday byweekno bymonth bysetpos
+ wkst)
+ (primitive-constructor
+ freq until count interval bysecond byminute byhour
+ byday* bymonthday byyearday byweekno bymonth bysetpos
+ wkst))))
+
+(define (serialize-recur-rule record)
+ `(recur-rule
+ ,@(when (freq record) `(freq: ,(freq record)))
+ ,@(when (until record) `(until: ,(until record)))
+ ,@(when (count record) `(count: ,(count record)))
+ ,@(when (interval record) `(interval: ,(interval record)))
+ ,@(when (bysecond record) `(bysecond: ,(bysecond record)))
+ ,@(when (byminute record) `(byminute: ,(byminute record)))
+ ,@(when (byhour record) `(byhour: ,(byhour record)))
+ ,@(when (byday record) `(byday: ,(byday record)))
+ ,@(when (bymonthday record) `(bymonthday: ,(bymonthday record)))
+ ,@(when (byyearday record) `(byyearday: ,(byyearday record)))
+ ,@(when (byweekno record) `(byweekno: ,(byweekno record)))
+ ,@(when (bymonth record) `(bymonth: ,(bymonth record)))
+ ,@(when (bysetpos record) `(bysetpos: ,(bysetpos record)))
+ ,@(when (wkst record) `(wkst: ,(wkst record)))))
+
+;;; Both interval and wkst are optional by the standard.
+;;; We however default those to 1 and monday in the constructor
+;;; saving us from checking at the use site.
+(define-type (recur-rule
+ constructor: recur-rule-constructor-factory
+ printer: (lambda (record port)
+ (pretty-print (serialize-recur-rule record)
+ port display?: #f)))
+ (freq type: (memv intervals))
+ (until type: (or false? date? datetime?))
+ (count type: (or false? (and integer? positive?)))
+ (interval type: (and integer? positive?))
+ (bysecond type: (or false? (list-of (in-range? 0 60))))
+ (byminute type: (or false? (list-of (in-range? 0 59))))
+ (byhour type: (or false? (list-of (in-range? 0 23))))
+ (byday type: (or false? (list-of (pair-of (or false? integer?)
+ (memv weekdays)))))
+ (bymonthday type: (or false? (list-of (and (not zero?) (in-range? -31 31)))))
+ (byyearday type: (or false? (list-of (and (not zero?) (in-range? -366 366)))))
+ (byweekno type: (or false? (list-of (and (not zero?) (in-range? -53 53)))))
+ (bymonth type: (or false? (list-of (and (not zero?) (in-range? -12 12)))))
+ (bysetpos type: (or false? (list-of (and (not zero?) (in-range? -366 366)))))
+ (wkst type: (memv weekdays)))
(define (byday->string pair)
diff --git a/module/vcomponent/recurrence/parse.scm b/module/vcomponent/recurrence/parse.scm
index 12b6a622..ebe8b022 100644
--- a/module/vcomponent/recurrence/parse.scm
+++ b/module/vcomponent/recurrence/parse.scm
@@ -51,31 +51,6 @@
(cons (string->number (list->string numbers))
(rfc->datetime-weekday (apply symbol letters)))))
-(define-macro (quick-case key . cases)
- (let ((else-clause (or (assoc-ref cases 'else)
- '(scm-error 'misc-error "quick-case"
- "Guard failed"
- #f #f))))
- `(case ,key
- ,@(map (match-lambda
- ((key guard '=> body ...)
- `((,key) (if (not ,guard)
- (begin (warning
- "RRULE guard failed for key ~a~% guard: ~a : ~s"
- (quote ,key)
- (quote ,guard)
- (map (lambda (o) (if (procedure? o)
- (procedure-name o)
- o))
- (list ,@guard)))
- ,@else-clause)
- (begin ,@body))))
- ((key body ...)
- `((,key) (begin ,@body)))
- (('else body ...)
- `(else ,@body)))
- cases))))
-
(define* (string->number/throw string optional: (radix 10))
(or (string->number string radix)
(scm-error 'wrong-type-arg
@@ -87,55 +62,56 @@
;; the same type as the DTSTART of the event (date or datetime). I have seen events
;; in the wild which didn't follow this. I consider that an user error.
(define* (parse-recurrence-rule str optional: (datetime-parser parse-ics-datetime))
- (fold
- (lambda (kv o)
- (let ((key (car kv))
- (val (cadr kv)))
- (let-lazy
- ((symb (string->symbol val))
- ;; NOTE until MUST have the same value type as DTSTART
- ;; on the object. Idealy we would save that type and
- ;; check it here. That however is impractical since we
- ;; might encounter the RRULE field before the DTSTART
- ;; field.
- (date (if (= 8 (string-length val))
- (parse-ics-date val)
- (parse-ics-datetime val)))
- (day (rfc->datetime-weekday (string->symbol val)))
- (days (map parse-day-spec (string-split val #\,)))
- (num (string->number/throw val))
- (nums (map string->number/throw (string-split val #\,))))
-
- ;; It's an error to give BYHOUR and smaller for pure dates.
- ;; 3.3.10. p 41
- (quick-case (string->symbol key)
- (UNTIL (set (until o) date))
-
- (COUNT (<= 0 num) => (set (count o) num))
- (INTERVAL (<= 0 num) => (set (interval o) num))
-
- (FREQ (memv symb intervals) => (set (freq o) symb))
- (WKST (memv day weekdays) => (set (wkst o) day))
-
- ;; Always positive
- (BYSECOND (every (lambda (n) (<= 0 n 60)) nums) => (set (bysecond o) nums))
- (BYMINUTE (every (lambda (n) (<= 0 n 59)) nums) => (set (byminute o) nums))
- (BYHOUR (every (lambda (n) (<= 0 n 23)) nums) => (set (byhour o) nums))
- (BYMONTH (every (lambda (n) (<= 1 n 12)) nums) => (set (bymonth o) nums))
-
- ;; May be negative
- (BYDAY (every (lambda (p) (memv (cdr p) weekdays)) days) => (set (byday o) days))
-
- (BYMONTHDAY (every (lambda (n) (and (!= n 0) (<= -31 n 31))) nums) => (set (bymonthday o) nums))
- (BYYEARDAY (every (lambda (n) (and (!= n 0) (<= -366 n 366))) nums) => (set (byyearday o) nums))
- (BYSETPOS (every (lambda (n) (and (!= n 0) (<= -366 n 366))) nums) => (set (bysetpos o) nums))
- (BYWEEKNO (every (lambda (n) (and (!= n 0) (<= -53 n 53))) nums) => (set (byweekno o) nums))
-
- (else o)))))
-
- ;; obj
- (make-recur-rule)
-
- ;; ((key val) ...)
- (map (cut string-split <> #\=)
- (string-split str #\;))))
+ (define result
+ (fold
+ (lambda (kv o)
+ (let ((key (car kv))
+ (val (cadr kv)))
+ (let-lazy
+ ((symb (string->symbol val))
+ ;; NOTE until MUST have the same value type as DTSTART
+ ;; on the object. Idealy we would save that type and
+ ;; check it here. That however is impractical since we
+ ;; might encounter the RRULE field before the DTSTART
+ ;; field.
+ (date (if (= 8 (string-length val))
+ (parse-ics-date val)
+ (parse-ics-datetime val)))
+ (day (rfc->datetime-weekday (string->symbol val)))
+ (days (map parse-day-spec (string-split val #\,)))
+ (num (string->number/throw val))
+ (nums (map string->number/throw (string-split val #\,))))
+
+ ;; It's an error to give BYHOUR and smaller for pure dates.
+ ;; 3.3.10. p 41
+ (case (string->symbol key)
+ ((UNTIL) (until o date))
+ ((COUNT) (count o num))
+ ((INTERVAL) (interval o num))
+ ((FREQ) (freq o symb))
+ ((WKST) (wkst o day))
+ ((BYSECOND) (bysecond o nums))
+ ((BYMINUTE) (byminute o nums))
+ ((BYHOUR) (byhour o nums))
+ ((BYMONH) (bymonth o nums))
+ ((BYDAY) (byday o days))
+ ((BYMONTHDAY) (bymonthday o nums))
+ ((BYYEARDAY) (byyearday o nums))
+ ((BYSETPOS) (bysetpos o nums))
+ ((BYWEEKNO) (byweekno o nums))
+ (else o)))))
+
+ ;; obj
+ (recur-rule freq: (@ (vcomponent recurrence internal) freq-placeholder))
+
+ ;; ((key val) ...)
+ (map (cut string-split <> #\=)
+ (string-split str #\;))))
+
+ (when (eq? (@ (vcomponent recurrence internal) freq-placeholder)
+ (freq result))
+ (scm-error 'wrong-type-arg
+ "parse-recurrence-rule"
+ "A valid for `freq' is required, but none supplied"
+ '() #f))
+ result)
diff --git a/tests/unit/coverage-supplement.scm b/tests/unit/coverage-supplement.scm
index bd8a9717..09a04312 100644
--- a/tests/unit/coverage-supplement.scm
+++ b/tests/unit/coverage-supplement.scm
@@ -15,4 +15,10 @@
1 18)
("module/hnh/util/atomic-stack.scm"
"147b45d2216c378c35d5c3ed0228be393b6c287f2a5515802928040f2087378e"
- 1 13 29))
+ 1 13 29)
+ ("module/hnh/util/type.scm"
+ "f670542b9b404125224fd4c702be99e2c1c3fd55d862b18228e8772264ef3189"
+ 1 ; Module declaration
+ 12 34 44 46 ; Macros
+ 53) ; false? == not
+ )
diff --git a/tests/unit/datetime/zic.scm b/tests/unit/datetime/zic.scm
index 19af169c..f9fd6531 100644
--- a/tests/unit/datetime/zic.scm
+++ b/tests/unit/datetime/zic.scm
@@ -37,8 +37,8 @@ Link Europe/Zurich Europe/Vaduz
(test-equal "Basic Rule"
(list ((@@ (datetime zic) make-rule)
'US 1967 1973 4 '(last 0)
- ((@ (datetime zic) make-timespec) (time hour: 02 minute: 00 second: 00) '+ #\w)
- ((@ (datetime zic) make-timespec) (time hour: 01 minute: 00 second: 00) '+ #\d)
+ (make-timespec (time hour: 02 minute: 00 second: 00) '+ #\w)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\d)
"D"))
(call-with-input-string "Rule US 1967 1973 - Apr lastSun 2:00w 1:00d D"
parse-zic-file))
@@ -171,8 +171,8 @@ Zone America/Menominee -5:00 - EST 1973 Apr 29 2:00
(rule->dtstart
((@@ (datetime zic) make-rule)
'US 1967 1973 4 '(last 0)
- ((@ (datetime zic) make-timespec) (time hour: 02 minute: 00 second: 00) '+ #\w)
- ((@ (datetime zic) make-timespec) (time hour: 01 minute: 00 second: 00) '+ #\d)
+ (make-timespec (time hour: 02 minute: 00 second: 00) '+ #\w)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\d)
"D")))
(test-equal "sunday >= 1"
@@ -240,7 +240,7 @@ Zone America/Menominee -5:00 - EST 1973 Apr 29 2:00
(test-group "rule->rrule"
(test-equal "Basic example, and to = maximum"
- ((@ (vcomponent recurrence internal) make-recur-rule)
+ ((@ (vcomponent recurrence internal) recur-rule)
freq: 'YEARLY interval: 1 wkst: mon
byday: (list (cons -1 sun))
bymonth: (list oct))
@@ -260,7 +260,7 @@ Zone America/Menominee -5:00 - EST 1973 Apr 29 2:00
"")))
(test-equal "with definitive to year"
- ((@ (vcomponent recurrence internal) make-recur-rule)
+ ((@ (vcomponent recurrence internal) recur-rule)
freq: 'YEARLY interval: 1 wkst: mon
byday: (list (cons -1 tue))
bymonth: (list oct)
@@ -272,7 +272,7 @@ Zone America/Menominee -5:00 - EST 1973 Apr 29 2:00
"")))
(test-equal "on being a month day"
- ((@ (vcomponent recurrence internal) make-recur-rule)
+ ((@ (vcomponent recurrence internal) recur-rule)
freq: 'YEARLY interval: 1 wkst: mon
bymonthday: (list 2)
bymonth: (list oct))
@@ -283,7 +283,7 @@ Zone America/Menominee -5:00 - EST 1973 Apr 29 2:00
"")))
(test-equal "on being first day after date"
- ((@ (vcomponent recurrence internal) make-recur-rule)
+ ((@ (vcomponent recurrence internal) recur-rule)
freq: 'YEARLY interval: 1 wkst: mon
byday: (list (cons 1 mon))
bymonth: (list oct))
diff --git a/tests/unit/vcomponent/recurrence-advanced.scm b/tests/unit/vcomponent/recurrence-advanced.scm
index 1bd4311a..41e4770e 100644
--- a/tests/unit/vcomponent/recurrence-advanced.scm
+++ b/tests/unit/vcomponent/recurrence-advanced.scm
@@ -15,7 +15,7 @@
:use-module (srfi srfi-64)
:use-module (srfi srfi-88)
:use-module ((vcomponent recurrence)
- :select (make-recur-rule))
+ :select (recur-rule))
:use-module ((vcomponent recurrence generate)
:select (generate-recurrence-set))
:use-module ((vcomponent recurrence display)
@@ -74,7 +74,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'DAILY
count: 10)
x-summary:
@@ -96,7 +96,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'DAILY
until: (datetime year: 1997 month: 12 day: 24 hour: 00 minute: 00 second: 00 tz: "UTC"))
x-summary:
@@ -221,7 +221,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'DAILY
interval: 2)
x-summary:
@@ -253,7 +253,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'DAILY
interval: 10
count: 5)
@@ -271,7 +271,7 @@
dtstart:
(datetime year: 1998 month: 01 day: 01 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'YEARLY
until: (datetime year: 2000 month: 01 day: 31 hour: 14 minute: 00 second: 00 tz: "UTC")
bymonth: (list jan)
@@ -378,10 +378,10 @@
dtstart:
(datetime year: 1998 month: 01 day: 01 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'DAILY
until: (datetime year: 2000 month: 01 day: 31 hour: 14 minute: 00 second: 00 tz: "UTC")
- bymonth: 1)
+ bymonth: (list jan))
x-summary:
"dagligen, till och med den 31 januari, 2000 kl. 14:00"
x-set:
@@ -484,7 +484,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'WEEKLY
count: 10)
x-summary:
@@ -506,7 +506,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'WEEKLY
until: (datetime year: 1997 month: 12 day: 24 hour: 00 minute: 00 second: 00 tz: "UTC"))
x-summary:
@@ -535,7 +535,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'WEEKLY
interval: 2
wkst: sun)
@@ -568,7 +568,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'WEEKLY
until: (datetime year: 1997 month: 10 day: 07 hour: 00 minute: 00 second: 00 tz: "UTC")
wkst: sun
@@ -592,7 +592,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'WEEKLY
count: 10
wkst: sun
@@ -616,7 +616,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 01 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'WEEKLY
interval: 2
until: (datetime year: 1997 month: 12 day: 24 hour: 00 minute: 00 second: 00 tz: "UTC")
@@ -656,7 +656,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'WEEKLY
interval: 2
count: 8
@@ -679,7 +679,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 05 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'MONTHLY
count: 10
byday: (list (cons 1 fri)))
@@ -702,7 +702,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 05 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'MONTHLY
until: (datetime year: 1997 month: 12 day: 24 hour: 00 minute: 00 second: 00 tz: "UTC")
byday: (list (cons 1 fri)))
@@ -719,7 +719,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 07 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'MONTHLY
interval: 2
count: 10
@@ -744,7 +744,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 22 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'MONTHLY
count: 6
byday: (list (cons -2 mon)))
@@ -763,7 +763,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 28 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'MONTHLY
bymonthday: (list -3))
x-summary:
@@ -795,7 +795,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'MONTHLY
count: 10
bymonthday: (list 2 15))
@@ -818,7 +818,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 30 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'MONTHLY
count: 10
bymonthday: (list 1 -1))
@@ -841,7 +841,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 10 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'MONTHLY
interval: 18
count: 10
@@ -865,7 +865,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'MONTHLY
interval: 2
byday: (list tue))
@@ -898,7 +898,7 @@
dtstart:
(datetime year: 1997 month: 06 day: 10 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'YEARLY
count: 10
bymonth: (list 6 7))
@@ -921,7 +921,7 @@
dtstart:
(datetime year: 1997 month: 03 day: 10 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'YEARLY
interval: 2
count: 10
@@ -945,7 +945,7 @@
dtstart:
(datetime year: 1997 month: 01 day: 01 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'YEARLY
interval: 3
count: 10
@@ -969,7 +969,7 @@
dtstart:
(datetime year: 1997 month: 05 day: 19 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'YEARLY
byday: (list (cons 20 mon)))
x-summary:
@@ -1001,7 +1001,7 @@
dtstart:
(datetime year: 1997 month: 05 day: 12 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'YEARLY
byweekno: (list 20)
byday: (list mon))
@@ -1034,7 +1034,7 @@
dtstart:
(datetime year: 1997 month: 03 day: 13 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'YEARLY
bymonth: (list mar)
byday: (list thu))
@@ -1067,7 +1067,7 @@
dtstart:
(datetime year: 1997 month: 06 day: 05 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'YEARLY
byday: (list thu)
bymonth: (list 6 7 8))
@@ -1103,7 +1103,7 @@
(as-list
(list (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00)))
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'MONTHLY
byday: (list fri)
bymonthday: (list 13))
@@ -1136,7 +1136,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 13 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'MONTHLY
byday: (list sat)
bymonthday: (list 7 8 9 10 11 12 13))
@@ -1169,7 +1169,7 @@
dtstart:
(datetime year: 1996 month: 11 day: 05 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'YEARLY
interval: 4
bymonth: (list nov)
@@ -1204,7 +1204,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 04 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'MONTHLY
count: 3
byday: (list tue wed thu)
@@ -1221,7 +1221,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 29 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'MONTHLY
byday: (list mon tue wed thu fri)
bysetpos: (list -2))
@@ -1239,7 +1239,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'HOURLY
interval: 3
until: (datetime year: 1997 month: 09 day: 02 hour: 17 minute: 00 second: 00 tz: "UTC"))
@@ -1255,7 +1255,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'MINUTELY
interval: 15
count: 6)
@@ -1274,7 +1274,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'MINUTELY
interval: 90
count: 4)
@@ -1291,7 +1291,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'DAILY
byhour: (list 9 10 11 12 13 14 15 16)
byminute: (list 0 20 40))
@@ -1324,7 +1324,7 @@
dtstart:
(datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'MINUTELY
interval: 20
byhour: (list 9 10 11 12 13 14 15 16))
@@ -1357,7 +1357,7 @@
dtstart:
(datetime year: 1997 month: 08 day: 05 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'WEEKLY
interval: 2
count: 4
@@ -1376,7 +1376,7 @@
dtstart:
(datetime year: 1997 month: 08 day: 05 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'WEEKLY
interval: 2
count: 4
@@ -1395,7 +1395,7 @@
dtstart:
(datetime year: 2007 month: 01 day: 15 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'MONTHLY
bymonthday: (list 15 30)
count: 5)
@@ -1416,7 +1416,7 @@
(as-list
(list (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00)))
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'MONTHLY
byday: (list fri wed)
bymonthday: (list 13))
@@ -1449,7 +1449,7 @@
dtstart:
(datetime year: 1997 month: 05 day: 12 hour: 09 minute: 00 second: 00)
rrule:
- (make-recur-rule
+ (recur-rule
freq: 'YEARLY
byweekno: (list 20)
byday: (list mon wed))
@@ -1479,7 +1479,7 @@
(vevent
summary: "Each second, for ever"
dtstart: (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 00)
- rrule: (make-recur-rule freq: 'SECONDLY)
+ rrule: (recur-rule freq: 'SECONDLY)
x-summary: "varje sekund"
x-set: (list (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 00)
(datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 01)
@@ -1506,7 +1506,7 @@
(vevent
summary: "Exdates are applied AFTER rrule's"
dtstart: (datetime year: 2022 month: 06 day: 10 hour: 10 minute: 00 second: 00)
- rrule: (make-recur-rule freq: 'DAILY count: 5)
+ rrule: (recur-rule freq: 'DAILY count: 5)
exdate: (as-list (list (datetime year: 2022 month: 06 day: 12 hour: 10 minute: 00 second: 00)))
x-summary: "dagligen, totalt 5 gånger"
x-set: (list (datetime year: 2022 month: 06 day: 10 hour: 10 minute: 00 second: 00)
@@ -1518,7 +1518,7 @@
(vevent
summary: "RDATE:s add to the recurrence rule"
dtstart: (datetime year: 2022 month: 06 day: 10 hour: 10 minute: 00 second: 00)
- rrule: (make-recur-rule freq: 'DAILY count: 5)
+ rrule: (recur-rule freq: 'DAILY count: 5)
rdate: (as-list (list (datetime year: 2022 month: 06 day: 20 hour: 10 minute: 00 second: 00)))
x-summary: "dagligen, totalt 5 gånger"
x-set: (list (datetime year: 2022 month: 06 day: 10 hour: 10 minute: 00 second: 00)
@@ -1532,7 +1532,7 @@
(vevent
summary: "RDATE:s add to the recurrence rule"
dtstart: (datetime year: 2022 month: 06 day: 10 hour: 10 minute: 00 second: 00)
- rrule: (make-recur-rule freq: 'DAILY count: 5)
+ rrule: (recur-rule freq: 'DAILY count: 5)
exdate: (as-list (list (datetime year: 2022 month: 06 day: 20 hour: 10 minute: 00 second: 00)))
rdate: (as-list (list (datetime year: 2022 month: 06 day: 20 hour: 10 minute: 00 second: 00)))
x-summary: "dagligen, totalt 5 gånger"
diff --git a/tests/unit/vcomponent/recurrence-simple.scm b/tests/unit/vcomponent/recurrence-simple.scm
index dff57346..1c778223 100644
--- a/tests/unit/vcomponent/recurrence-simple.scm
+++ b/tests/unit/vcomponent/recurrence-simple.scm
@@ -21,17 +21,15 @@
:select (warnings-are-errors warning-handler))
:use-module ((vcomponent recurrence)
:select (parse-recurrence-rule
- make-recur-rule
+ recur-rule
generate-recurrence-set)))
-(define recur-rule make-recur-rule)
-
;;; Test that basic parsing or recurrence rules work.
-(test-equal (make-recur-rule freq: 'HOURLY wkst: mon interval: 1)
+(test-equal (recur-rule freq: 'HOURLY wkst: mon interval: 1)
(parse-recurrence-rule "FREQ=HOURLY"))
-(test-equal (make-recur-rule freq: 'HOURLY count: 3 interval: 1 wkst: mon)
+(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
@@ -39,10 +37,10 @@
(parameterize ((warnings-are-errors #t)
(warning-handler (lambda _ "")))
(test-error "Invalid FREQ"
- 'warning
+ 'wrong-type-arg
(parse-recurrence-rule "FREQ=ERR;COUNT=3"))
(test-error "Negative COUNT"
- 'warning
+ 'wrong-type-arg
(parse-recurrence-rule "FREQ=HOURLY;COUNT=-1"))
(test-error "Invalid COUNT"
'wrong-type-arg
@@ -228,11 +226,12 @@
;;; Earlier I failed to actually parse the recurrence parts, in short, 1 ≠ "1".
-(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"))))
+;;; 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"))))
(define ev
(vevent
diff --git a/tests/unit/vcomponent/rrule-serialization.scm b/tests/unit/vcomponent/rrule-serialization.scm
index 540c5bd2..fe990e0b 100644
--- a/tests/unit/vcomponent/rrule-serialization.scm
+++ b/tests/unit/vcomponent/rrule-serialization.scm
@@ -44,7 +44,7 @@
(@@ (vcomponent recurrence internal)
field->string))
-(let ((rule (parse-recurrence-rule "BYDAY=MO,TU,WE")))
+(let ((rule (parse-recurrence-rule "FREQ=WEEKLY;BYDAY=MO,TU,WE")))
(test-equal
"Direct return of parsed value"
"MO,TU,WE"
@@ -55,10 +55,10 @@
(filter
(lambda (pair) (eq? 'byday (car pair)))
(keyword-flatten
- '(interval byday wkst)
+ '(interval byday wkst freq)
(recur-rule->rrule-sxml rule)))))
-(let ((rule (parse-recurrence-rule "BYDAY=+1MO,1TU,-2FR")))
+(let ((rule (parse-recurrence-rule "FREQ=WEEKLY;BYDAY=+1MO,1TU,-2FR")))
(test-equal
"Direct return of parsed value"
"1MO,1TU,-2FR"
@@ -68,8 +68,9 @@
'((byday "1MO") (byday "1TU") (byday "-2FR"))
(filter
(lambda (pair) (eq? 'byday (car pair)))
+ ;; TODO why is keyword-flatten used here?
(keyword-flatten
- '(interval byday wkst)
+ '(interval byday wkst freq)
(recur-rule->rrule-sxml rule)))))