Merge UTC-OFFSET and TIMESPEC into one.

2 files changed, 93 insertions, 74 deletions

diff --git a/module/datetime/timespec.scm b/module/datetime/timespec.scm
new file mode 100644
index 00000000..ae8b3d9b
--- /dev/null
+++ b/module/datetime/timespec.scm
@@ -0,0 +1,92 @@
+;;; Commentary:
+;; Datatype for holding timechanges and time offesets.
+;; Used both for timespecs from the TZ-database, and for UTC-OFFSET from RFC5545.
+;;; Code:
+
+(define-module (datetime timespec)
+  :use-module (util)
+  :use-module (util exceptions)
+  :use-module (datetime)
+  :use-module (datetime util)
+  :use-module (srfi srfi-1)
+  :use-module (srfi srfi-9 gnu)
+  )
+
+
+;; 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)                  ; '+ | '-
+  ;; types:
+  ;; w - wall clock time (local time)
+  ;; s - standard time without daylight savings adjustments
+  ;; u, g, z - Universal time
+  (type timespec-type))                 ; char
+
+(export make-timespec 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))
+
+
+(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*-public (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)])))
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)))