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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
(define-module (vcomponent timezone)
:use-module (vcomponent base)
:use-module ((srfi srfi-1) :select (find))
:use-module (srfi srfi-19)
:use-module (srfi srfi-19 util)
:use-module (srfi srfi-41)
:use-module (srfi srfi-41 util)
:use-module (util)
:use-module ((vcomponent recurrence generate) :select (generate-recurrence-set))
:use-module ((vcomponent datetime) :select (ev-time<?))
)
;;@begin example
;; <VTIMEZONE> :: "#<vcomponent 558c5da80fc0>"
;; TZID: Europe/Stockholm
;; X-LIC-LOCATION: Europe/Stockholm
;; : <DAYLIGHT> :: "#<vcomponent 558c5e11e7c0>"
;; : RRULE: FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU
;; : DTSTART: 19700329T020000
;; : TZNAME: CEST
;; : TZOFFSETTO: +0200
;; : TZOFFSETFROM: +0100
;; : <STANDARD> :: "#<vcomponent 558c5e11e7e0>"
;; : RRULE: FREQ=YEARLY;BYMONTH=10;BYDAY=-1SU
;; : DTSTART: 19701025T030000
;; : TZNAME: CET
;; : TZOFFSETTO: +0100
;; : TZOFFSETFROM: +0200
;; @end example
;;; GENERAL INFINITE EXTRAPOLATION OF TIMEZONE DATA IS IMPOSSIBLE, SINCE TIMEZONES
;;; DON'T CHANGE THAT PREDICTABLY
;; @begin example
;; BEGIN:VTIMEZONE
;; TZID:Europe/Stockholm
;; BEGIN:STANDARD
;; DTSTART;VALUE=DATE-TIME:20181028T020000
;; TZNAME:CET
;; TZOFFSETFROM:+0200
;; TZOFFSETTO:+0100
;; END:STANDARD
;; BEGIN:DAYLIGHT
;; DTSTART;VALUE=DATE-TIME:20190331T030000
;; TZNAME:CEST
;; TZOFFSETFROM:+0100
;; TZOFFSETTO:+0200
;; END:DAYLIGHT
;; END:VTIMEZONE
;; @end example
;; This should really be parsed as:
;; STANDARD : [2018-10-28 02:00, 2019-03-31 03:00)
;; DAYLIGHT : [2019-03-21 03:00, ∞)
;; Given a tz stream of length 2, takes the time difference between the DTSTART
;; of those two. And creates a new VTIMEZONE with that end time.
;; TODO set remaining properties, and type of the newly created component.
(define (extrapolate-tz-stream strm)
(let ((nevent (copy-vcomponent (stream-car strm))))
(set! (attr nevent 'DTSTART)
))
;; old code fails since (length standard) ≠ (length summer)
;; Also, it copies the summmer time, making the alternation
;; break (but that wasn't the primary problem)
#;
(let ((nevent (copy-vcomponent (stream-ref strm 1))))
(mod! (attr nevent 'DTSTART)
= (add-duration (time-difference
(attr (stream-ref strm 1) 'DTSTART)
(attr (stream-ref strm 0) 'DTSTART))))
(stream-append strm (stream nevent))))
;; The RFC requires that at least one DAYLIGHT or STANDARD component is present.
;; Any number of both can be present. This should handle all these cases well,
;; as long as noone has multiple overlapping timezones, which depend on some
;; further condition. That feels like something that should be impossible, but
;; this is (human) time we are talking about.
(define-public (make-tz-set tz)
(let* ((repeating regular (partition repeating? events)))
(set! repeating (sort*! repeating time<? (extract 'DTSTART))
regular (sort*! regular time<? (extract 'DTSTART)))
(interleave-streams
ev-time<?
(cons (list->stream regular)
(map generate-recurrence-set repeating))))
(let ((strm (interleave-streams
ev-time<?
;; { DAYLIGHT, STANDARD }
(map generate-recurrence-set (children tz)))))
(cond [(stream-null? strm) stream-null]
[(stream-null? (stream-drop 2 strm))
(let ((strm (extrapolate-tz-stream strm)))
(stream-zip strm (stream-cdr strm)))]
[else (stream-zip strm (stream-cdr strm))])))
;; str ::= ±[0-9]{4}
;; str → int seconds
(define (parse-offset str)
(let* (((± h1 h0 m1 m0) (string->list str)))
((primitive-eval (symbol ±))
(+ (* 60 (string->number (string m1 m0)))
(* 60 60 (string->number (string h1 h0)))))))
;; Finds the VTIMEZONE with id @var{tzid} in calendar.
;; Crashes on error.
(define (find-tz cal tzid)
(let ((ret (find (lambda (tz) (string=? tzid (attr tz 'TZID)))
(filter (lambda (o) (eq? 'VTIMEZONE (type o)))
(children cal)))))
ret))
;; Takes a VEVENT.
;; Assumes that DTSTART has a TZID property, and that that TZID is available as
;; a direct child of the parent of @var{ev}.
(define-public (get-tz-offset ev)
(let ((ret (stream-find
(lambda (z)
(let* (((start end) (map (extract 'DTSTART) z)))
(and (time<=? start (attr ev 'DTSTART))
(time<? (attr ev 'DTSTART) end))))
(attr (find-tz (parent ev)
(car (prop (attr* ev 'DTSTART) 'TZID)))
'X-HNH-TZSET))))
(if (not ret)
0 (parse-offset (attr (car ret) 'TZOFFSETTO)))))
|
