Replace (directories) with general (xdg basedir).

5 files changed, 78 insertions, 54 deletions

diff --git a/module/calp/entry-points/html.scm b/module/calp/entry-points/html.scm
index b2f613ea..8c400e1d 100644
--- a/module/calp/entry-points/html.scm
+++ b/module/calp/entry-points/html.scm
@@ -19,7 +19,7 @@
 
   :use-module ((sxml simple) :select (sxml->xml))
   :use-module ((sxml transformations) :select (href-transformer))
-  :use-module (directories)
+  :use-module ((xdg basedir) :prefix xdg-)
 
   :autoload (vcomponent instance) (global-event-object)
   )
@@ -74,7 +74,7 @@
     ;; TODO nicer way to resolve static
     (let ((link (path-append output-directory "/static")))
      (unless (file-exists? link)
-       (symlink (path-append data-directory "www/static") link)))))
+       (symlink (path-append (xdg-data-home) "/calp/www/static") link)))))
 
 
 (define (re-root-static tree)
diff --git a/module/calp/main.scm b/module/calp/main.scm
index 2a7944a9..e336846a 100644
--- a/module/calp/main.scm
+++ b/module/calp/main.scm
@@ -8,7 +8,6 @@
   :use-module ((util config) :select (set-config! get-config get-configuration-documentation))
   :use-module (util options)
   :use-module ((util hooks) :select (shutdown-hook))
-  :use-module (directories)
 
   :use-module ((text markup) :select (sxml->ansi-text))
 
@@ -19,6 +18,8 @@
   :use-module (statprof)
   :use-module (calp repl)
 
+  :use-module ((xdg basedir) :prefix xdg-)
+
   )
 
 
@@ -106,8 +107,9 @@
 
   (when stprof (statprof-start))
 
-  (cond [(eqv? #t repl) (repl-start (format #f "~a/calp-~a" 
-                                            runtime-directory (getpid)))]
+  (cond [(eqv? #t repl) (repl-start (format #f "~a/calp-~a"
+                                            (xdg-runtime-dir)
+                                            (getpid)))]
         [repl => repl-start])
 
   (if altconfig
@@ -119,8 +121,8 @@
 
       (awhen (find file-exists?
                    (list
-                     (path-append user-config-directory "/config.scm")
-                     (path-append system-config-directory "/config.scm")))
+                     (path-append (xdg-config-home) "/calp/config.scm")
+                     (path-append (xdg-sysconfdir) "/calp/config.scm")))
              (primitive-load it)))
 
 
@@ -160,21 +162,22 @@
     (throw 'return))
 
   (when (option-ref opts 'update-zoneinfo #f)
-    (let ((pipe
-           (let-env ((PREFIX (get-config 'path-prefix)))
-                    (open-input-pipe (path-append libexec "/tzget")))))
+    (let* ((locations (list "/usr/libexec/calp/tzget" (path-append (xdg-data-home) "/tzget")))
+           (filename (or (find file-exists? locations)
+                         (error "tzget not installed, please put it in one of ~a" locations)))
+           (pipe (open-input-pipe filename)))
 
       ;; (define path (read-line pipe))
       (define line ((@ (ice-9 rdelim) read-line) pipe))
       (define names (string-split line #\space))
       ((@ (util io) with-atomic-output-to-file)
-       (path-append data-directory "/zoneinfo.scm")
+       (path-append (xdg-data-home) "/calp/zoneinfo.scm")
        (lambda ()
          (write `(set-config! 'tz-list ',names)) (newline)
          (write `(set-config! 'last-zoneinfo-upgrade ,((@ (datetime) current-date)))) (newline)))))
 
   ;; always load zoneinfo if available.
-  (let ((z (path-append data-directory "/zoneinfo.scm")))
+  (let ((z (path-append (xdg-data-home) "/calp/zoneinfo.scm")))
     (when (file-exists? z)
       (primitive-load z)))
 
diff --git a/module/datetime/instance.scm b/module/datetime/instance.scm
index db24d8a2..5b5a6604 100644
--- a/module/datetime/instance.scm
+++ b/module/datetime/instance.scm
@@ -3,7 +3,7 @@
   :use-module (util config)
   :use-module (util exceptions)
   :use-module (datetime zic)
-  :use-module (directories)
+  :use-module ((xdg basedir) :prefix xdg-)
   :export (zoneinfo))
 
 (define-config tz-list '()
@@ -21,7 +21,7 @@
                 (self tz-list)))
              ((file-list)
               (provide 'zoneinfo)
-              (let* ((directory (path-append data-directory "/zoneinfo"))
+              (let* ((directory (path-append (xdg-data-home) "/calp/zoneinfo"))
                      (key (cons directory file-list)))
                 (aif (hash-ref cache key)
                      it
diff --git a/module/directories.scm b/module/directories.scm
deleted file mode 100644
index 8e46d8b6..00000000
--- a/module/directories.scm
+++ /dev/null
@@ -1,40 +0,0 @@
-(define-module (directories)
-  :use-module (util)
-  :use-module (util config)
-  )
-
-;; TODO possiblyy create a (system) parameter, which flips many
-;; settings between being based in $HOME, and in / (or $prefix/).
-
-(define-config path-prefix "/usr")
-
-(define-public runtime-directory
-  (or (getenv "XDG_RUNTIME_DIR")
-      "/tmp"))
-
-(define-public system-config-directory "/etc/calp")
-
-(define-public user-config-directory
-  (path-append
-    (or (getenv "XDG_CONFIG_HOME")
-        (and=> (getenv "HOME")
-               (lambda (s) (path-append s "/.config"))))
-    "/calp"))
-
-(define (libexec%)
-  (or (getenv "LIBEXEC")
-      (path-append (get-config 'path-prefix)
-                   "/lib/calp")))
-
-(define-syntax libexec (identifier-syntax (libexec%)))
-(export libexec)
-
-(define (data-directory%)
-  (path-append
-    (or (getenv "XDG_DATA_HOME")
-        (path-append (get-config 'path-prefix) "/share"))
-    "/calp"))
-
-(define-syntax data-directory (identifier-syntax (data-directory%)))
-(export data-directory)
-
diff --git a/module/xdg/basedir.scm b/module/xdg/basedir.scm
new file mode 100644
index 00000000..e734500e
--- /dev/null
+++ b/module/xdg/basedir.scm
@@ -0,0 +1,61 @@
+;;; Commentary:
+;;; https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html
+;;; Code:
+
+(define-module (xdg basedir)
+  :export (sysconfdir runtime-dir
+           data-home config-home cache-home
+           data-dirs config-dirs))
+
+;;; XDG_DATA_HOME
+;;; $HOME/.local/share
+(define (data-home)
+  (or (getenv "XDG_DATA_HOME")
+      (string-append (getenv "HOME") "/.local/share")))
+
+;;; XDG_CONFIG_HOME
+;;; $HOME/.config
+(define (config-home)
+  (or (getenv "XDG_CONFIG_HOME")
+      (string-append (getenv "HOME") "/.config")))
+
+;;; XDG_DATA_DIRS
+;;; colon (:) sepparated, in addition to XDG_DATA_HOME
+;;; /usr/local/share/:/usr/share/
+(define (data-dirs)
+  (let ((str (getenv "XDG_DATA_DIRS")))
+    (if str
+        (string-split str #\:)
+        '("/usr/local/share" "/usr/share"))))
+
+;;; sysconfdir
+;;; /etc
+;;; Techincly not part of the standard, but it's mentioned
+(define (sysconfdir)
+  (or (getenv "sysconfdir")
+      "/etc"))
+
+
+;;; XDG_CONFIG_DIRS
+;;; colon (:) separated, in adddition to XDG_CONFIG_HOME
+;;; /etc/xdg
+(define (config-dirs)
+  (let ((str (getenv "XDG_CONFIG_DIRS")))
+    (if str
+        (string-split str #\:)
+        (list (string-append sysconfdir "/xdg")))))
+
+;;; XDG_CACHE_HOME
+;;; $HOME/.cache
+(define (cache-home)
+  (or (getenv "XDG_CACHE_HOME")
+      (string-append (getenv "HOME") "/.cache")))
+
+;;; XDG_RUNTIME_DIR
+;;; Default to /tmp or /tmp/$(uid), and raise a warning
+(define (runtime-dir)
+  (or (getenv "XDG_RUNTIME_DIR")
+      (begin
+        (display "WARNING: XDG_RUNTIME_DIR unset, defaulting to /tmp\n"
+                 (current-error-port))
+        "/tmp")))