From c7880093faceb0eb662907a97ad67cf9d2c23dd3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Mon, 27 Apr 2020 03:02:19 +0200
Subject: Filter to only relevant timezones in ics output.

---
 module/output/ical.scm         | 11 +++++-
 module/vcomponent/datetime.scm | 87 +++++++++++++++++++++++++++++++++---------
 2 files changed, 78 insertions(+), 20 deletions(-)

diff --git a/module/output/ical.scm b/module/output/ical.scm
index 66fa1e40..822d929d 100644
--- a/module/output/ical.scm
+++ b/module/output/ical.scm
@@ -194,13 +194,22 @@ CALSCALE:GREGORIAN\r
    '("dummy" "local")))
 
 (define-public (print-components-with-fake-parent events)
+
+  ;; The events are probably sorted before, but until I can guarantee
+  ;; that we sort them again here. We need them sorted from earliest
+  ;; and up to send the earliest to zoneinfo->vtimezone
+  (set! events (sort* events date/-time<=? (extract 'DTSTART)))
+
   (print-header)
 
   (let ((tz-names (get-tz-names events)))
     (for-each component->ical-string
-              (map (lambda (name) (zoneinfo->vtimezone *zoneinfo* name))
+              ;; TODO we realy should send the earliest event from each timezone here.
+              (map (lambda (name) (zoneinfo->vtimezone *zoneinfo* name (car events)))
                    tz-names)))
+
   (for-each component->ical-string events)
+
   (print-footer))
 
 
diff --git a/module/vcomponent/datetime.scm b/module/vcomponent/datetime.scm
index d693782c..745bf551 100644
--- a/module/vcomponent/datetime.scm
+++ b/module/vcomponent/datetime.scm
@@ -6,6 +6,8 @@
   #:use-module (datetime zic)
   #:use-module (util)
 
+  :use-module (ice-9 curried-definitions)
+
   #:export (#;parse-datetime
             event-overlaps?
             overlapping?
@@ -108,16 +110,73 @@ Event must have the DTSTART and DTEND attribute set."
                   (datetime-difference (attr ev 'DTEND)
                                        (attr ev 'DTSTART)))))
 
+
+;; DTEND of the last instance of this event.
+;; event → (or datetime #f)
+(define (final-spanned-time event)
+  (if (not ((@ (vcomponent recurrence) repeating?) event))
+      (or (attr event 'DTEND) (attr event 'DTSTART))
+      (let ((final ((@ (vcomponent recurrence generate-alt) final-event-occurence)
+                    event)))
+        (if final
+            (aif (attr event 'DTEND)
+                 (datetime+ (as-datetime final) (as-datetime it))
+                 (as-datetime final))
+            #f))))
+
 
 
 
 
-(define-public (zoneinfo->vtimezone zoneinfo zone-name)
+;; Checks if the given zone-entry is relevant for this event
+;; by checking if zone-entry-until isn't before our DTSTART.
+(define ((relevant-zone-entry? event) zone-entry)
+  (aif (zone-entry-until zone-entry)
+       (datetime<? (as-datetime (attr event 'DTSTART)) it)
+       #t))
+
+(define ((relevant-zone-rule? event) rule)
+  (define start (attr event 'DTSTART))
+  ;; end := datetime | #f
+  (define end (final-spanned-time event))
+
+  (define start-y (year (as-date start)))
+
+  (if end
+      (let ((end-y (and end (year (as-date end)))))
+        (cond [(and (eq? 'minimum (rule-from rule))
+                    (eq? 'maximum (rule-to rule)))
+               #t]
+              [(eq? 'minimum (rule-from rule))
+               (< start-y (rule-to rule))]
+              [(eq? 'maximum (rule-to rule))
+               (< (rule-from rule) end-y)]
+              [(eq? 'only (rule-to rule))
+               (<= start-y (rule-from rule) end-y)]
+              [else
+               (timespan-overlaps? start end
+                                   (date year: (rule-from rule))
+                                   (date year: (1+ (rule-to rule))))]))
+      (cond [(and (eq? 'minimum (rule-from rule))
+                  (eq? 'maximum (rule-to rule)))
+             #t]
+            [(eq? 'minimum (rule-from rule))
+             (< start-y (rule-to rule))]
+            [(eq? 'maximum (rule-to rule))
+             #t]
+            [(eq? 'only (rule-to rule))
+             (<= start-y (rule-from rule))]
+            [else
+             (<= (rule-from rule) start-y (rule-to rule))])))
+
+;; event is for limiter
+(define-public (zoneinfo->vtimezone zoneinfo zone-name event)
   (define vtimezone (make-vcomponent 'VTIMEZONE))
   (define last-until (datetime date: #1000-01-01))
   (define last-offset (timespec-zero))
   (set! (attr vtimezone 'TZID) zone-name)
-  (for zone-entry in (get-zone zoneinfo zone-name)
+
+  (for zone-entry in (filter (relevant-zone-entry? event) (get-zone zoneinfo zone-name))
        (cond [(zone-entry-rule zone-entry) timespec?
               => (lambda (inline-rule)
                    (let ((component (make-vcomponent 'DAYLIGHT))
@@ -164,23 +223,13 @@ Event must have the DTSTART and DTEND attribute set."
                                    (set! (attr component 'RRULE) it))
 
                             (add-child! vtimezone component)))
-                        (drop-while
-                         ;; TODO
-                         ;; some of the rules might not apply to us since we only
-                         ;; started using that rule set later. It's also possible
-                         ;; that we stopped using a ruleset which continues existing.
-                         ;;
-                         ;; Both these cases should be filtered here.
-                         (const #f)
-                         #;
-                         (lambda (rule)
-                           (rule-from rule) ; 1970
-                           (rule-in rule)   ; 4 (apr)
-                           (rule-on rule)   ; 5 | (last sat)
-
-                           (rule-to rule)
-
-                           last-until)
+                        ;; some of the rules might not apply to us since we only
+                        ;; started using that rule set later. It's also possible
+                        ;; that we stopped using a ruleset which continues existing.
+                        ;;
+                        ;; Both these are filtered here.
+                        (filter
+                         (relevant-zone-rule? event)
                          (get-rule zoneinfo rule-name))))]
 
              [else                      ; no rule
-- 
cgit v1.2.3