diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2023-10-16 19:39:12 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2023-10-16 19:40:24 +0200 |
commit | 22f28015981295660ff98b43789f8c4c99134f36 (patch) | |
tree | e6d43c74a23843212e0fc183a1e09ca2b5d2fa17 | |
parent | Add `not` case to type validators. (diff) | |
download | calp-22f28015981295660ff98b43789f8c4c99134f36.tar.gz calp-22f28015981295660ff98b43789f8c4c99134f36.tar.xz |
Move timespec and recur-rule to new object system.
-rw-r--r-- | doc/ref/general/util.texi | 12 | ||||
-rw-r--r-- | module/datetime/timespec.scm | 27 | ||||
-rw-r--r-- | module/datetime/zic.scm | 18 | ||||
-rw-r--r-- | module/hnh/util.scm | 22 | ||||
-rw-r--r-- | module/vcomponent/formats/xcal/parse.scm | 2 | ||||
-rw-r--r-- | module/vcomponent/recurrence.scm | 2 | ||||
-rw-r--r-- | module/vcomponent/recurrence/internal.scm | 147 | ||||
-rw-r--r-- | module/vcomponent/recurrence/parse.scm | 130 | ||||
-rw-r--r-- | tests/unit/coverage-supplement.scm | 8 | ||||
-rw-r--r-- | tests/unit/datetime/zic.scm | 16 | ||||
-rw-r--r-- | tests/unit/vcomponent/recurrence-advanced.scm | 100 | ||||
-rw-r--r-- | tests/unit/vcomponent/recurrence-simple.scm | 23 | ||||
-rw-r--r-- | tests/unit/vcomponent/rrule-serialization.scm | 9 |
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))))) |