From 88b181ade43211d7d391cc3e1680070d03954cd5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Sun, 26 Apr 2020 21:56:23 +0200
Subject: Ical output more modular.

---
 module/entry-points/server.scm |  4 ++-
 module/output/ical.scm         | 65 +++++++++++++++++++++---------------------
 2 files changed, 36 insertions(+), 33 deletions(-)

diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm
index 55bfc770..8553da50 100644
--- a/module/entry-points/server.scm
+++ b/module/entry-points/server.scm
@@ -91,7 +91,9 @@
                  (find (lambda (ev) (equal? uid (attr ev 'UID)))
                        repeating))
              (return '((content-type text/calendar))
-                     (with-output-to-string (lambda () ((@ (output ical) component->ical-string) it))))
+                     (with-output-to-string
+                       (lambda () ((@ (output ical) print-components-with-fake-parent)
+                              (list it)))))
              (return (build-response code: 404)
                      (format #f "No component with UID=~a found." uid))))
 
diff --git a/module/output/ical.scm b/module/output/ical.scm
index 1dcd8544..66fa1e40 100644
--- a/module/output/ical.scm
+++ b/module/output/ical.scm
@@ -11,6 +11,7 @@
   :use-module (srfi srfi-41 util)
   :use-module (datetime zic)
   :use-module (glob)
+  :use-module (vcomponent recurrence)
   )
 
 ;; Format value depending on key type.
@@ -181,38 +182,38 @@ CALSCALE:GREGORIAN\r
 (define (print-footer)
   (format #t "END:VCALENDAR\r\n"))
 
-;; list x list x list x time x time → 
-(define-public (ical-main calendars regular-events repeating-events start end)
-  (print-header)
 
-  (let ((tz-names
-         (lset-difference
-          equal? (lset-union
-                  equal? '("dummy")
-                  (concatenate
-                   (map (lambda (cal)
-                          (filter-map
-                           (lambda (vline)
-                             (and=> (prop vline 'TZID) car))
-                           (filter-map (extract* 'DTSTART)
-                                       (children cal))))
-                        calendars)))
-          '("dummy" "local"))))
-    (for-each
-     component->ical-string
-     (map (lambda (name) (zoneinfo->vtimezone *zoneinfo* name))
-          tz-names)))
-
-  ;; TODO add support for running without a range limiter, emiting all objects.
-  (for-each
-   component->ical-string
-   (filter-sorted (lambda (ev) ((in-date-range? start end)
-                           (as-date (attr ev 'DTSTART))))
-                  regular-events))
-
-  ;; TODO RECCURENCE-ID exceptions
-  ;; We just dump all repeating objects, since it's much cheaper to do it this way than
-  ;; to actually figure out which are applicable for the given date range.
-  (for-each component->ical-string repeating-events)
+(define (get-tz-names events)
+  (lset-difference
+   equal? (lset-union
+           equal? '("dummy")
+           (filter-map
+            (lambda (vline) (and=> (prop vline 'TZID) car))
+            (filter-map (extract* 'DTSTART)
+                        events)))
+   '("dummy" "local")))
+
+(define-public (print-components-with-fake-parent events)
+  (print-header)
 
+  (let ((tz-names (get-tz-names events)))
+    (for-each component->ical-string
+              (map (lambda (name) (zoneinfo->vtimezone *zoneinfo* name))
+                   tz-names)))
+  (for-each component->ical-string events)
   (print-footer))
+
+
+;; TODO add support for running without a range limiter, emiting all objects.
+;; list x list x list x time x time → 
+(define-public (ical-main calendars regular-events repeating-events start end)
+
+  (print-components-with-fake-parent
+   (append (filter-sorted (lambda (ev) ((in-date-range? start end)
+                                   (as-date (attr ev 'DTSTART))))
+                          regular-events)
+           ;; TODO RECCURENCE-ID exceptions
+           ;; We just dump all repeating objects, since it's much cheaper to do
+           ;; it this way than to actually figure out which are applicable for
+           ;; the given date range.
+           repeating-events)))
-- 
cgit v1.2.3