diff options
Diffstat (limited to '')
-rw-r--r-- | module/datetime/zic.scm | 75 |
1 files changed, 1 insertions, 74 deletions
diff --git a/module/datetime/zic.scm b/module/datetime/zic.scm index 1f599ca6..8035570a 100644 --- a/module/datetime/zic.scm +++ b/module/datetime/zic.scm @@ -13,6 +13,7 @@ :use-module (util exceptions) :use-module (datetime) :use-module (datetime util) + :use-module (datetime timespec) :use-module (ice-9 rdelim) :use-module (srfi srfi-1) :use-module (srfi srfi-9) @@ -30,53 +31,6 @@ -(define-immutable-record-type <timespec> ; EXPORTED - (make-timespec timespec-time sign type) - timespec? - (timespec-time timespec-time) ; <time> - (sign timespec-sign) ; '+ | '- - ;; types: - ;; w - wall clock time (local time) - ;; s - standard time without daylight savings adjustments - ;; u, g, z - Universal time - (type timespec-type)) ; char - -(export timespec? timespec-time timespec-sign timespec-type) - -(define-public (timespec-zero) - (make-timespec (time) '+ #\w)) - -(define-public (timespec-add . specs) - (unless (apply eqv? (map timespec-type specs)) - (warning "Adding timespecs of differing types")) - - (reduce (lambda (spec done) - (cond - ;; - - - ;; + + - [(eq? (timespec-sign done) - (timespec-sign spec)) - (set (timespec-time done) = (time+ (timespec-time spec)))] - ;; - + - [(and (eq? '- (timespec-sign done)) - (eq? '+ (timespec-sign spec))) - (let ((time-a (timespec-time done)) - (time-b (timespec-time spec))) - (if (time< time-a time-b) - (make-timespec (time- time-b time-a) - '+ (timespec-type done)) - (set (timespec-time done) (time- time-b))))] - ;; + - - [(and (eq? '+ (timespec-sign done)) - (eq? '- (timespec-sign spec))) - (let ((time-a (timespec-time done)) - (time-b (timespec-time spec))) - (if (time< time-a time-b) - (make-timespec (time- time-b time-a) - '- (timespec-type done)) - (set (timespec-time done) (time+ time-b))))])) - (timespec-zero) - specs)) ;; <day-name> := 'mon | 'tue | 'wed | 'thu | 'sat | 'sun @@ -195,33 +149,6 @@ ))])) -(define (parse-time string) - (apply (lambda* (hour optional: (minute "0") (second "0")) - (time hour: (string->number hour) - minute: (string->number minute) - ;; discard sub-seconds - second: (string->number (car (string-split second #\.))))) - (string-split string #\:))) - - - -(define* (parse-time-spec string optional: (suffixes '(#\s #\w #\u #\g #\z))) - (let* ((type string - (cond [(string-rindex string (list->char-set suffixes)) - => (lambda (idx) - (values (string-ref string idx) - (substring string 0 idx)))] - [else (values #\w string)]))) - (cond [(string=? "-" string) - (make-timespec (time) '+ type)] - [(string-prefix? "-" string) - (make-timespec (parse-time (string-drop string 1)) - '- type)] - [else - (make-timespec (parse-time string) - '+ type)]))) - - (define* (parse-until year optional: (month "Jan") (day "1") (tm "-")) ;; I'm pretty sure that the until rule never has a negative time component (let ((timespec (parse-time-spec tm))) |