blob: d3a84671067b886377d18ac674353b0e7dd799ce (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
;;; 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)
:export (make-timespec
timespec? timespec-time timespec-sign timespec-type)
:use-module ((hnh util) :select (set define*-public unless let*))
:use-module ((hnh util exceptions) :select (warning))
:use-module (datetime)
: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
(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*-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)])))
;; Note that string->time allows a longer format than the input
(cond [(string=? "-" string)
(make-timespec (time) '+ type)]
[(string-prefix? "-" string)
(make-timespec (string->time (string-drop string 1) "~H:~M:~S")
'- type)]
[else
(make-timespec (string->time string "~H:~M:~S")
'+ type)])))
|
