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.

1 files changed, 28 insertions, 13 deletions

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))))))))