From 7bbf2470bbdc46089dec1eb4c2328d0c87ba594f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Mon, 3 Aug 2020 12:39:30 +0200
Subject: Resolve (datetime instance) TODO with ./configure?

Tried adding a ./configure script, which mostly is responsible for
downloading a default zoneinfo file, and setting up the environment for
the program.

I have for quite a while thought about having a configure system for
things like these, but also for setting up default paths. Let's see if
it works out.
---
 module/.gitignore            |  1 +
 module/datetime/instance.scm | 41 ++++++++++++++++++++++++++++-------------
 module/main.scm              |  8 ++++++++
 module/output/ical.scm       |  8 +++++---
 module/util/config.scm       |  3 +++
 5 files changed, 45 insertions(+), 16 deletions(-)
 create mode 100644 module/.gitignore

(limited to 'module')

diff --git a/module/.gitignore b/module/.gitignore
new file mode 100644
index 00000000..0eaae741
--- /dev/null
+++ b/module/.gitignore
@@ -0,0 +1 @@
+autoconfig.scm
diff --git a/module/datetime/instance.scm b/module/datetime/instance.scm
index 9ec883e2..048c9a9b 100644
--- a/module/datetime/instance.scm
+++ b/module/datetime/instance.scm
@@ -1,20 +1,35 @@
 (define-module (datetime instance)
   :use-module (util)
-  :use-module (ice-9 rdelim)
+  :use-module (util config)
   :use-module (datetime zic)
   :export (zoneinfo))
 
+(define-config tz-dir #f
+  "Directory in which zoneinfo files can be found")
+
+(define-config tz-list '()
+  "List of default zoneinfo files to be parsed")
+
+
+(define / file-name-separator-string)
 
 ;; TODO see (vcomponent instance), this has a similar problem with early load
-(define-once
-  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))))
+(define-once zoneinfo
+  (let ((cache (make-hash-table)))
+    (label self
+     (case-lambda
+       (()
+        (define tz-dir (get-config 'tz-dir))
+        (define tz-list (get-config 'tz-list))
+        (when (or (not tz-dir) (null? tz-list))
+          (error "Default zoneinfo only available when tz-dir and tz-list are configured"))
+        (self tz-dir tz-list))
+       ((directory file-list)
+        (let ((key (cons directory file-list)))
+          (aif (hash-ref cache key)
+               it
+               (let ((tz (read-zoneinfo
+                          (map (lambda (s) (string-append directory / s))
+                               file-list))))
+                 (hash-set! cache key tz)
+                 tz))))))))
diff --git a/module/main.scm b/module/main.scm
index a0708275..98a07c44 100644
--- a/module/main.scm
+++ b/module/main.scm
@@ -5,6 +5,14 @@
 
 (set! (@ (global) basedir) (car %load-path))
 
+(catch 'misc-error
+  (lambda () (use-modules (autoconfig)))
+  (lambda (err caller fmt args . rest)
+    (if (eqv? (caadr args) 'autoconfig)
+        (format (current-error-port) "Run ./configure first~%")
+        (format (current-error-port) "~?~%" fmt args))
+    (exit 1)))
+
 (use-modules (srfi srfi-1)
              (srfi srfi-88)             ; keyword syntax
 
diff --git a/module/output/ical.scm b/module/output/ical.scm
index a9d325f8..203c6d0e 100644
--- a/module/output/ical.scm
+++ b/module/output/ical.scm
@@ -16,7 +16,7 @@
   :use-module (output types)
   :use-module (output common)
   :autoload (vcomponent instance) (global-event-object)
-  :autoload (datetime instance) (zoneinfo)
+  :use-module ((datetime instance) :select (zoneinfo))
   )
 
 
@@ -172,7 +172,7 @@
 
   (awhen (param (prop* event 'DTSTART) 'TZID)
          ;; TODO this is broken
-         (add-child! cal (zoneinfo->vtimezone zoneinfo it)))
+         (add-child! cal (zoneinfo->vtimezone (zoneinfo) it)))
 
   (unless (prop event 'UID)
     (set! (prop event 'UID)
@@ -213,7 +213,9 @@ CALSCALE:GREGORIAN\r
     (for-each component->ical-string
               ;; TODO we realy should send the earliest event from each timezone here,
               ;; instead of just the first.
-              (map (lambda (name) (zoneinfo->vtimezone zoneinfo name (car events)))
+              (map (lambda (name) (zoneinfo->vtimezone
+                              (zoneinfo)
+                              name (car events)))
                    tz-names)))
 
   (for-each component->ical-string events)
diff --git a/module/util/config.scm b/module/util/config.scm
index 0b6677fa..f324ff63 100644
--- a/module/util/config.scm
+++ b/module/util/config.scm
@@ -88,6 +88,9 @@
               (cond [(not value)
                      (set-value! conf #f)
                      ((config-attribute conf #:post identity) #f)]
+                    [(unconfig? conf)
+                     (hashq-set! config-values key
+                                 (make-unconfig value))]
                     [((config-attribute conf #:pre identity)
                       value)
                      => (lambda (it)
-- 
cgit v1.2.3