Merge branch 'app'.

The app objects both makes the whole program sort of behave like one
class in some object oriented languages, with an implicitly (actually
hiddenly explicitly) passed 'app' argument to all methods. Multiple
concurrent apps should be supported, but is of now untested.

The app is also configured to lazily bind all its fields, which means
that almost all loading is now lazy!

12 files changed, 200 insertions, 114 deletions

diff --git a/module/datetime/app.scm b/module/datetime/app.scm
new file mode 100644
index 00000000..9797ee39
--- /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 '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/html.scm b/module/entry-points/html.scm
index 70fbde42..d80de3b5 100644
--- a/module/entry-points/html.scm
+++ b/module/entry-points/html.scm
@@ -4,7 +4,7 @@
   :use-module (util)
   :use-module (util time)
   :use-module (util config)
-  :use-module (vcomponent)
+  ;; :use-module (vcomponent)
   :use-module (datetime)
   :use-module (datetime util)
   :use-module (ice-9 getopt-long)
@@ -30,26 +30,17 @@
 
   (define style (string->symbol (option-ref opts 'style "wide")))
 
-  (define-values (calendars events)
-    (cond [(option-ref opts 'file #f) => (compose load-calendars list)]
-          [else (load-calendars)]))
-
-
-  (report-time! "Calendars loaded")
-
   (case style
-    [(unchunked)
-     (html-generate calendars events start end render-calendar)]
     [(wide)                             ; previously `chunked'
-     (html-chunked-main count calendars events start (date month: 1))]
+     (html-chunked-main count start (date month: 1))]
     [(week)
      ;; TODO The small calendar is always centered on months, it might
      ;; be a good idea to instead center it on the current week, meaning
      ;; that the active row is always in the center
-     (html-chunked-main count calendars events
+     (html-chunked-main count
                         (start-of-week start (get-config 'week-start))
                         (date day: 7))]
     [(table)
-     (html-table-main count calendars events start)]
+     (html-table-main count start)]
     [else
      (error "Unknown html style: ~a" style)]))
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/entry-points/server.scm b/module/entry-points/server.scm
index 3455540d..63fb83a8 100644
--- a/module/entry-points/server.scm
+++ b/module/entry-points/server.scm
@@ -1,5 +1,6 @@
 (define-module (entry-points server)
   :use-module (util)
+  :use-module (util app)
 
   :use-module (srfi srfi-1)
 
@@ -56,7 +57,7 @@
             (cdr (scandir dir))))))
 
 
-(define (make-make-routes calendar regular repeating events)
+(define-method (make-make-routes)
   (make-routes
 
    (GET "/week/:start-date.html" (start-date)
@@ -65,8 +66,8 @@
           (return '((content-type text/html))
                   (with-output-to-string
                     (lambda ()
-                      (html-generate calendars: calendar
-                                     events: events
+                      (html-generate calendars: (getf 'calendars)
+                                     events: (getf 'event-set)
                                      start-date: start-date
                                      end-date: (date+ start-date (date day: 6))
                                      next-start: (lambda (d) (date+ d (date day: 7)))
@@ -80,8 +81,8 @@
           (return '((content-type text/html))
                   (with-output-to-string
                     (lambda ()
-                      (html-generate calendars: calendar
-                                     events: events
+                      (html-generate calendars: (getf 'calendars)
+                                     events: (getf 'event-set)
                                      start-date: start-date
                                      end-date: (date- (month+ start-date)
                                                       (date day: 1))
@@ -97,19 +98,12 @@
         (return '((content-type text/calendar))
                 (with-output-to-string
                   (lambda ()
-                   (ical-main calendar
-                              regular
-                              repeating
-                              (parse-iso-date start)
+                   (ical-main (parse-iso-date start)
                               (parse-iso-date end))))))
 
    ;; TODO this fails if there's a period in the uid.
    (GET "/calendar/:uid.ics" (uid)
-        ;; NOTE build an index.
-        (aif (or (find (lambda (ev) (equal? uid (attr ev 'UID)))
-                       regular)
-                 (find (lambda (ev) (equal? uid (attr ev 'UID)))
-                       repeating))
+        (aif (get-event-by-uid uid)
              (return '((content-type text/calendar))
                      (with-output-to-string
                        (lambda () (print-components-with-fake-parent
@@ -162,15 +156,6 @@
           [(and addr (string-contains addr ".")) AF_INET]
           [else AF_INET6]))
 
-  (define-values (c regular repeating)
-    (cond [(option-ref opts 'file #f) => (compose load-calendars* list)]
-          [else (load-calendars*)]))
-
-  (define all-events
-    ((@ (vcomponent load) calculate-recurrence-set) regular repeating))
-
-
-
   ;; update address if it was left blank. A bit clumsy since
   ;; @var{addr} & @var{family} depend on each other.
   ;; placed after load-calendars to keep Guile 2.2 compability.
@@ -197,7 +182,7 @@
           addr port
           (getpid) (getcwd))
 
-  (run-server (make-make-routes c regular repeating all-events)
+  (run-server (make-make-routes)
               'http
               `(family: ,family
                         port: ,port
diff --git a/module/main.scm b/module/main.scm
index b2899014..332d9990 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/html.scm b/module/output/html.scm
index 8a932fd0..702d229d 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -7,6 +7,7 @@
   #:use-module (vcomponent group)
   #:use-module (vcomponent datetime)
   #:use-module (util)
+  #:use-module (util app)
   #:use-module (util exceptions)
   #:use-module (util config)
   #:use-module (util tree)
@@ -745,7 +746,11 @@
                      ,@(stream->list (stream-map fmt-day evs))))))))
 
 
-(define-public (html-chunked-main count calendars events start-date chunk-length)
+(define-method (html-chunked-main count start-date chunk-length)
+
+  (define calendars (getf 'calendars))
+  (define events (getf 'event-set))
+
   ;; TODO This still doesn't account for PWD, file existing but is of
   ;; wrong type, html directory existing but static symlink missing,
   ;; static being a different file type, and probably something else
@@ -778,7 +783,12 @@
                       (cdr ms))))))))
 
 
-(define-public (html-table-main count calendars events start-date)
+
+(define-method (html-table-main count start-date)
+
+  (define calendars (getf 'calendars))
+  (define events (getf 'event-set))
+
   ;; TODO same file creation as in html-chunked-main
   (stream-for-each
    (lambda (start-of-month)
diff --git a/module/output/ical.scm b/module/output/ical.scm
index 822d929d..098d4e90 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 '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 '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 'repeating-events))))
diff --git a/module/util/app.scm b/module/util/app.scm
new file mode 100644
index 00000000..e5b03b0f
--- /dev/null
+++ b/module/util/app.scm
@@ -0,0 +1,50 @@
+(define-module (util app)
+  :use-module (util)
+  :use-module (srfi srfi-1)
+  :use-module (srfi srfi-9)
+  :use-module (srfi srfi-9 gnu)
+  :export (make-app current-app define-method getf setf)
+  )
+
+(define-immutable-record-type <app>
+  (make-app% ht) app? (ht get-ht))
+
+(define-public (make-app)
+  (make-app% (make-hash-table)))
+
+(define current-app (make-parameter (make-app)))
+
+(define-syntax (define-method stx)
+  (with-syntax ((app (datum->syntax stx 'app)))
+   (syntax-case stx ()
+     [(_ (name args ...) body ...)
+
+      (let* ((pre post (break (lambda (s) (eqv? key: (syntax->datum s)))
+                              #'(args ...))))
+        #`(define*-public (name #,@pre #,@(if (null? post) '(key:) post)
+                         (app (current-app)))
+            body ...))])))
+
+
+(define-method (getf field)
+  (aif (hashq-ref (get-ht app) field)
+       (force it)
+       (error "No field" field)))
+
+(define-syntax setf%
+  (syntax-rules ()
+    [(_ field value)
+     (setf% (current-app) field value)]
+    [(_ app field value)
+     (hashq-set! (get-ht app) field (delay value))]))
+
+(define-syntax setf
+  (syntax-rules ()
+    ;; special case to use current appp)
+    [(_ key value)
+     (setf% key value)]
+
+    [(_ app) app]
+    [(_ app key value rest ...)
+     (begin (setf% app key value)
+            (setf app rest ...))]))
diff --git a/module/vcomponent.scm b/module/vcomponent.scm
index 32406f0a..aaaf5d36 100644
--- a/module/vcomponent.scm
+++ b/module/vcomponent.scm
@@ -1,10 +1,69 @@
 (define-module (vcomponent)
+  :use-module (util)
+  :use-module (util app)
+  :use-module (srfi srfi-1)
+  :use-module (srfi srfi-41)
+  :use-module (srfi srfi-41 util)
+  :use-module (datetime)
+  :use-module (datetime util)
   :use-module (vcomponent base)
   :use-module (vcomponent parse)
   :use-module (vcomponent load)
-  :use-module (util)
+  :use-module ((vcomponent recurrence) :select (generate-recurrence-set repeating?))
+  :use-module ((vcomponent datetime) :select (ev-time<?))
   :re-export (make-vcomponent
               parse-cal-path parse-calendar
               load-calendars load-calendars*))
 
 (re-export-modules (vcomponent base))
+
+
+;; TODO rename function
+(define (calculate-recurrence-set regular repeating)
+  (interleave-streams
+   ev-time<?
+   (cons (list->stream regular)
+         (map (@ (vcomponent recurrence) generate-recurrence-set) repeating)
+         )))
+
+
+(define-method (init-app calendar-files)
+  (setf 'calendars (load-calendars calendar-files))
+
+  (setf 'events
+        (concatenate
+         ;; TODO does this drop events?
+         (map (lambda (cal) (filter (lambda (o) (eq? 'VEVENT (type o)))
+                               (children cal)))
+              (getf 'calendars))))
+
+  (setf 'fixed-and-repeating-events
+        (let* ((repeating regular (partition repeating? (getf 'events))))
+
+          ;; (report-time! "Sorting")
+          ;; NOTE There might be instances where we don't care if the
+          ;; collection if sorted, but for the time beieng it's much
+          ;; easier to always sort it.
+          (list
+           (sort*! regular   date/-time<? (extract 'DTSTART))
+           (sort*! repeating date/-time<? (extract 'DTSTART)))))
+
+  (setf 'fixed-events (car (getf 'fixed-and-repeating-events)))
+  (setf 'repeating-events (cadr (getf 'fixed-and-repeating-events)))
+
+  (setf 'event-set (calculate-recurrence-set
+                    (getf 'fixed-events)
+                        (getf 'repeating-events)))
+
+  (setf 'uid-map
+        (let ((ht (make-hash-table)))
+          (for-each (lambda (event) (hash-set! ht (attr event 'UID) event)) (getf 'events))
+          ht)))
+
+(define-method (fixed-events-in-range start end)
+  (filter-sorted (lambda (ev) ((in-date-range? start end)
+                          (as-date (attr ev 'DTSTART))))
+                 (getf 'fixed-events)))
+
+(define-method (get-event-by-uid uid)
+  (hash-ref (getf 'uid-map) uid))
diff --git a/module/vcomponent/load.scm b/module/vcomponent/load.scm
index 37d57b56..09dcd3c8 100644
--- a/module/vcomponent/load.scm
+++ b/module/vcomponent/load.scm
@@ -1,59 +1,10 @@
 (define-module (vcomponent load)
   :export (load-calendars load-calendars*)
   :use-module (util)
-  :use-module (util time)
   :use-module (util config)
-  :use-module (srfi srfi-1)
-  :use-module (datetime)
-  :use-module (datetime util)
-  :use-module (srfi srfi-41)
-  :use-module (srfi srfi-41 util)
-  ;; :use-module (parameters)
-  ;; :use-module (vcomponent)
-  :use-module (vcomponent base)
-  :use-module ((vcomponent parse) :select (parse-cal-path))
-  :use-module ((vcomponent recurrence) :select (generate-recurrence-set repeating?))
-  :use-module ((vcomponent datetime) :select (ev-time<?)))
+  :use-module ((vcomponent parse) :select (parse-cal-path)))
 
 (define-config calendar-files '() "" list?)
 
-(define-public (calculate-recurrence-set regular repeating)
- (interleave-streams
-  ev-time<?
-  (cons (list->stream regular)
-        (map generate-recurrence-set repeating)
-        )))
-
-;; Reads all calendar files from disk, generate recurence-sets for all repeating events,
-;; and returns a list of calendars, and a stream of all events "ready" for display.
-(define* (load-calendars #:optional (calendar-files (get-config 'calendar-files)))
-  (report-time! "Parsing ~a calendars" (length calendar-files))
-  (let* ((calendars regular repeating (load-calendars* calendar-files)))
-    (report-time! "Calendars loaded, interleaving and reccurring")
-    (values
-     calendars
-     (calculate-recurrence-set regular repeating))))
-
-;; Basic version, loads calendrs, sorts the events, and returns
-;; regular and repeating events separated from each other.
-;; 
-;; (list string) → (list calendar), (list event), (list event)
-(define* (load-calendars* #:optional (calendar-files (get-config 'calendar-files)))
-
-  (define calendars (map parse-cal-path calendar-files))
-  (define events (concatenate
-                  ;; TODO does this drop events?
-                  (map (lambda (cal) (filter (lambda (o) (eq? 'VEVENT (type o)))
-                                        (children cal)))
-                       calendars)))
-
-  (report-time! "Parse done, partitioning...")
-  (let* ((repeating regular (partition repeating? events)))
-
-    (report-time! "Sorting")
-    ;; NOTE There might be instances where we don't care if the
-    ;; collection if sorted, but for the time beieng it's much
-    ;; easier to always sort it.
-    (values calendars
-            (sort*! regular   date/-time<? (extract 'DTSTART))
-            (sort*! repeating date/-time<? (extract 'DTSTART)))))
+(define* (load-calendars calendar-files)
+  (map parse-cal-path calendar-files))
diff --git a/tzget b/tzget
new file mode 100755
index 00000000..1fd2340a
--- /dev/null
+++ b/tzget
@@ -0,0 +1,28 @@
+#!/bin/bash
+
+CACHE_DIR=${CACHE_DIR:-~/.cache/calp}
+RELEASE=2020a
+TZ_SRC="https://github.com/eggert/tz/archive/$RELEASE.tar.gz"
+
+mkdir -p $CACHE_DIR
+cd $CACHE_DIR
+
+test -f "$RELEASE.tar.gz" || curl -sOL $TZ_SRC
+test -d "tz-$RELEASE" || tar xzf "$RELEASE.tar.gz"
+cd "tz-$RELEASE"
+
+tzpath=$(pwd)
+
+size=$(stat -c "%s" Makefile)
+
+cat >> Makefile << EOF
+.PHONY: print-tdata
+print-tdata:
+	@echo \$(TDATA_TO_CHECK)
+EOF
+files=$(make print-tdata)
+
+truncate -cs $size Makefile
+
+echo $tzpath
+echo $files