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 /module/datetime | |
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.
Diffstat (limited to '')
-rw-r--r-- | module/datetime/timespec.scm | 27 | ||||
-rw-r--r-- | module/datetime/zic.scm | 18 |
2 files changed, 27 insertions, 18 deletions
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) |