From f0e492f0a54f184e47c0bd639ad338b1b783d258 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 28 Jul 2017 14:51:44 +0200
Subject: utils: Factorize XDG directory handling.

* guix/ui.scm (config-directory): Remove.
* guix/utils.scm (xdg-directory, config-directory): New procedures.
(cache-directory): Rewrite in terms of 'xdg-directory'.
* guix/scripts/substitute.scm (%narinfo-cache-directory): Pass #:ensure?
 #f to 'cache-directory'.
---
 guix/scripts/substitute.scm |  2 +-
 guix/ui.scm                 | 21 ---------------------
 guix/utils.scm              | 32 ++++++++++++++++++++++++--------
 3 files changed, 25 insertions(+), 30 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 35282f9027..0d36997bc4 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -113,7 +113,7 @@ (define %narinfo-cache-directory
       (or (and=> (getenv "XDG_CACHE_HOME")
                  (cut string-append <> "/guix/substitute"))
           (string-append %state-directory "/substitute/cache"))
-      (string-append (cache-directory) "/substitute")))
+      (string-append (cache-directory #:ensure? #f) "/substitute")))
 
 (define %allow-unauthenticated-substitutes?
   ;; Whether to allow unchecked substitutes.  This is useful for testing
diff --git a/guix/ui.scm b/guix/ui.scm
index 4bad00e8cf..b0108d0705 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -36,7 +36,6 @@ (define-module (guix ui)
   #:use-module (guix combinators)
   #:use-module (guix build-system)
   #:use-module (guix serialization)
-  #:use-module ((guix build utils) #:select (mkdir-p))
   #:use-module ((guix licenses) #:select (license? license-name))
   #:use-module ((guix build syscalls)
                 #:select (free-disk-space terminal-columns))
@@ -79,7 +78,6 @@ (define-module (guix ui)
             read/eval
             read/eval-package-expression
             location->string
-            config-directory
             fill-paragraph
             texi->plain-text
             package-description-string
@@ -856,25 +854,6 @@ (define (location->string loc)
     (($ <location> file line column)
      (format #f "~a:~a:~a" file line column))))
 
-(define* (config-directory #:key (ensure? #t))
-  "Return the name of the configuration directory, after making sure that it
-exists if ENSURE? is true.  Honor the XDG specs,
-<http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html>."
-  (let ((dir (and=> (or (getenv "XDG_CONFIG_HOME")
-                        (and=> (getenv "HOME")
-                               (cut string-append <> "/.config")))
-                    (cut string-append <> "/guix"))))
-    (catch 'system-error
-      (lambda ()
-        (when ensure?
-          (mkdir-p dir))
-        dir)
-      (lambda args
-        (let ((err (system-error-errno args)))
-          ;; ERR is necessarily different from EEXIST.
-          (leave (G_ "failed to create configuration directory `~a': ~a~%")
-                 dir (strerror err)))))))
-
 (define* (fill-paragraph str width #:optional (column 0))
   "Fill STR such that each line contains at most WIDTH characters, assuming
 that the first character is at COLUMN.
diff --git a/guix/utils.scm b/guix/utils.scm
index 9bf1cc893f..ab43ed4008 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -33,7 +33,7 @@ (define-module (guix utils)
   #:autoload   (rnrs io ports) (make-custom-binary-input-port)
   #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
   #:use-module (guix memoization)
-  #:use-module ((guix build utils) #:select (dump-port))
+  #:use-module ((guix build utils) #:select (dump-port mkdir-p))
   #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync))
   #:use-module (ice-9 format)
   #:autoload   (ice-9 popen)  (open-pipe*)
@@ -81,7 +81,10 @@ (define-module (guix utils)
             call-with-temporary-output-file
             call-with-temporary-directory
             with-atomic-file-output
+
+            config-directory
             cache-directory
+
             readlink*
             edit-expression
 
@@ -598,13 +601,26 @@ (define (with-atomic-file-output file proc)
         (false-if-exception (delete-file template))
         (close-port out)))))
 
-(define (cache-directory)
-  "Return the cache directory for Guix, by default ~/.cache/guix."
-  (string-append (or (getenv "XDG_CACHE_HOME")
-                     (and=> (or (getenv "HOME")
-                                (passwd:dir (getpwuid (getuid))))
-                            (cut string-append <> "/.cache")))
-                 "/guix"))
+(define* (xdg-directory variable suffix #:key (ensure? #t))
+  "Return the name of the XDG directory that matches VARIABLE and SUFFIX,
+after making sure that it exists if ENSURE? is true.  VARIABLE is an
+environment variable name like \"XDG_CONFIG_HOME\"; SUFFIX is a suffix like
+\"/.config\".  Honor the XDG specs,
+<http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html>."
+  (let ((dir (and=> (or (getenv variable)
+                        (and=> (or (getenv "HOME")
+                                   (passwd:dir (getpwuid (getuid))))
+                               (cut string-append <> suffix)))
+                    (cut string-append <> "/guix"))))
+    (when ensure?
+      (mkdir-p dir))
+    dir))
+
+(define config-directory
+  (cut xdg-directory "XDG_CONFIG_HOME" "/.config" <...>))
+
+(define cache-directory
+  (cut xdg-directory "XDG_CACHE_HOME" "/.cache" <...>))
 
 (define (readlink* file)
   "Call 'readlink' until the result is not a symlink."
-- 
cgit v1.2.3