From 8b426edf1b6d4de0ec825da8a34b1df7b51212db Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Thu, 30 Apr 2020 18:37:03 +0200
Subject: Update ical parts to use app context.

---
 module/datetime/app.scm      | 18 ++++++++++++++++++
 module/datetime/zic.scm      |  2 +-
 module/entry-points/ical.scm |  9 +--------
 module/main.scm              |  8 ++++++++
 module/output/ical.scm       | 19 ++++++-------------
 5 files changed, 34 insertions(+), 22 deletions(-)
 create mode 100644 module/datetime/app.scm

diff --git a/module/datetime/app.scm b/module/datetime/app.scm
new file mode 100644
index 00000000..989a0847
--- /dev/null
+++ b/module/datetime/app.scm
@@ -0,0 +1,18 @@
+(define-module (datetime app)
+  :use-module (util)
+  :use-module (util app)
+  :use-module (ice-9 rdelim)
+  :use-module (datetime zic))
+
+(define-method (init-app)
+  (setf app 'zoneinfo
+        (let* ((pipe
+               (-> (@ (global) basedir)
+                   dirname
+                   (string-append "/tzget")
+                   ((@ (ice-9 popen) open-input-pipe))))
+               (path (read-line pipe))
+               (names (string-split (read-line pipe) #\space)))
+          (read-zoneinfo
+           (map (lambda (s) (string-append path file-name-separator-string s))
+                names)))))
diff --git a/module/datetime/zic.scm b/module/datetime/zic.scm
index 1c81b706..02f3230f 100644
--- a/module/datetime/zic.scm
+++ b/module/datetime/zic.scm
@@ -19,7 +19,7 @@
   :use-module (srfi srfi-9 gnu))
 
 
-(define-public (read-zoneinfo . ports-or-filenames)
+(define-public (read-zoneinfo ports-or-filenames)
   (parsed-zic->zoneinfo
    (concatenate
     (map (lambda (port-or-filename)
diff --git a/module/entry-points/ical.scm b/module/entry-points/ical.scm
index f2f4e0b5..dc060ec6 100644
--- a/module/entry-points/ical.scm
+++ b/module/entry-points/ical.scm
@@ -22,11 +22,4 @@
                       ;; [else (normalize-date* (set (month start) = (+ 1)))]
                       [(date+ start (date month: 1))]
                       ))
-
-  ;; TODO this contains repeated events multiple times
-  (define-values (calendars regular repeating)
-    (cond [(option-ref opts 'file #f) => (compose load-calendars* list)]
-          [else (load-calendars*)]))
-
-  (ical-main calendars regular repeating start end)
- )
+  (ical-main start end))
diff --git a/module/main.scm b/module/main.scm
index b2899014..96fe2da1 100755
--- a/module/main.scm
+++ b/module/main.scm
@@ -13,6 +13,7 @@
              (util)
              (util io)
              (util time)
+             (util app)
 
              ((entry-points html)      :prefix      html-)
              ((entry-points terminal)  :prefix  terminal-)
@@ -31,6 +32,7 @@
 
              )
 
+
 (define options
   '((statprof (value optional))
     (repl (value optional))
@@ -56,6 +58,12 @@
     (when (file-exists? config-file)
      (primitive-load config-file)))
 
+
+  (current-app (make-app))
+
+  ((@ (vcomponent) init-app) (get-config 'calendar-files))
+  ((@ (datetime app) init-app))
+
   (let ((ropt (ornull (option-ref opts '() '())
                       '("term"))))
     ((case (string->symbol (car ropt))
diff --git a/module/output/ical.scm b/module/output/ical.scm
index 822d929d..8388bfc1 100644
--- a/module/output/ical.scm
+++ b/module/output/ical.scm
@@ -2,6 +2,7 @@
   :use-module (ice-9 format)
   :use-module (ice-9 match)
   :use-module (util)
+  :use-module (util app)
   :use-module (vcomponent)
   :use-module (vcomponent datetime)
   :use-module (srfi srfi-1)
@@ -139,10 +140,6 @@
 
 ;; TODO place these somewhere better
 (define *prodid* "-//hugo//Calparse 0.9//EN")
-(define *zoneinfo* (apply read-zoneinfo
-        ;; TODO move this to config, and figure out
-        ;; how to best acquire/bundle zoneinfo.
-        (glob "~/down/tz/{africa,antartica,asia,australasia,europe,northamerica,southamerica,backward}")))
 
 ;; TODO tzid prop on dtstart vs tz field in datetime object
 ;; how do we keep these two in sync?
@@ -156,7 +153,7 @@
   (add-child! cal event)
 
   (awhen (prop (attr* event 'DTSTART) 'TZID)
-         (add-child! cal (zoneinfo->vtimezone *zoneinfo* it)))
+         (add-child! cal (zoneinfo->vtimezone (getf (current-app) 'zoneinfo) it)))
 
   (unless (attr event 'UID)
     (set! (attr event 'UID)
@@ -205,7 +202,7 @@ CALSCALE:GREGORIAN\r
   (let ((tz-names (get-tz-names events)))
     (for-each component->ical-string
               ;; TODO we realy should send the earliest event from each timezone here.
-              (map (lambda (name) (zoneinfo->vtimezone *zoneinfo* name (car events)))
+              (map (lambda (name) (zoneinfo->vtimezone (getf (current-app) 'zoneinfo) name (car events)))
                    tz-names)))
 
   (for-each component->ical-string events)
@@ -214,15 +211,11 @@ CALSCALE:GREGORIAN\r
 
 
 ;; 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)
-
+(define-public (ical-main start end)
   (print-components-with-fake-parent
-   (append (filter-sorted (lambda (ev) ((in-date-range? start end)
-                                   (as-date (attr ev 'DTSTART))))
-                          regular-events)
+   (append (fixed-events-in-range start end)
            ;; 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)))
+           (getf (current-app) 'repeating-events))))
-- 
cgit v1.2.3