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.

7 files changed, 94 insertions, 16 deletions

diff --git a/configure b/configure
new file mode 100755
index 00000000..30a78a24
--- /dev/null
+++ b/configure
@@ -0,0 +1,44 @@
+#!/usr/bin/guile \
+--no-auto-compile -s
+!#
+
+(define // file-name-separator-string)
+
+(define here (cond ((current-filename) => dirname)
+                   (else (getcwd))))
+(define module-dir (string-append here // "module"))
+(add-to-load-path module-dir)
+
+(use-modules (util))
+
+;; --with-zoneinfo
+(define zoneinfo #t)
+
+;; when zoneinfo
+(use-modules (ice-9 rdelim))
+
+(define pipe
+  (-> here
+      (string-append "/tzget")
+      ((@ (ice-9 popen) open-input-pipe))))
+(define path (read-line pipe))
+(define names (string-split (read-line pipe) #\space))
+
+(use-modules (util io)
+             (datetime))
+(with-atomic-output-to-file
+ (string-append module-dir // "autoconfig.scm")
+ (lambda ()
+   (display ";;; Commentary:") (newline)
+   (display ";;; File genererated by ./configure on ")
+   (display (datetime->string
+             (current-datetime) "~Y-~m-~d ~H:~M:~S~Z"))
+   (newline)
+   (display ";;; DONT make any manual changes") (newline)
+   (display ";;; Code:") (newline)
+   (for-each (@ (ice-9 pretty-print) pretty-print)
+             `((define-module (autoconfig)
+                 use-module: (util config))
+               ,@(when zoneinfo
+                   `((set-config! 'tz-file ,path)
+                     (set-config! 'tz-list (quote ,names))))))))
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)
diff --git a/tzget b/tzget
index 1fd2340a..bd81e4b7 100755
--- a/tzget
+++ b/tzget
@@ -1,5 +1,10 @@
 #!/bin/bash
 
+# Downloads zoneinfo files if not already present
+# echos 2 lines,
+# - the directory with the zoneinfo files
+# - the names of the zoneinfo files to be parsed
+
 CACHE_DIR=${CACHE_DIR:-~/.cache/calp}
 RELEASE=2020a
 TZ_SRC="https://github.com/eggert/tz/archive/$RELEASE.tar.gz"