aboutsummaryrefslogtreecommitdiff
path: root/module/datetime/zic.scm
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-06-25 18:07:42 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-06-25 18:25:33 +0200
commit3527bb143b6a6740a9f51b0eaf87c883060c86bc (patch)
treecffd80ff75b3ee0d2c030e3e067403d4dbcf3a3b /module/datetime/zic.scm
parentFix minor spelling error. (diff)
downloadcalp-3527bb143b6a6740a9f51b0eaf87c883060c86bc.tar.gz
calp-3527bb143b6a6740a9f51b0eaf87c883060c86bc.tar.xz
Merge UTC-OFFSET and TIMESPEC into one.
Diffstat (limited to 'module/datetime/zic.scm')
-rw-r--r--module/datetime/zic.scm75
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)))