[bug#50350] [PATCH core-updates] utils: Add helpers for list environment variables.

[Sarah Morgensen]

Add helpers 'getenv/list', 'setenv/list', 'setenv/list-extend', and
'setenv/list-delete' for list environment variables (such as search
paths).

* guix/build/utils.scm (getenv/list, setenv/list)
(setenv/list-extend, setenv/list-delete): New procedures.
* .dir-locals.el (scheme-mode): Indent them.
* tests/build-utils.scm ("getenv/list", "getenv/list: unset")
("setenv/list: ignore empty elements")
("setenv/list: unset if empty")
("setenv/list-extend: single element, prepend")
("setenv/list-extend: multiple elements, prepend")
("setenv/list-extend: multiple elements, append")
("setenv/list-delete: single deletion")
("setenv/list-delete: multiple deletions"): New tests.
---
Hello Guix,

I noticed that there are over 200 occurrences of this pattern in packages:

--8<---------------cut here---------------start------------->8---
  (setenv "PYTHONPATH"
          (string-append (getcwd) ":" (getenv "PYTHONPATH")))
--8<---------------cut here---------------end--------------->8---

This patch introduces some helper procedures for these kinds of cases. With
this patch, instead of the above you could write:

  (setenv/list-extend "PYTHONPATH" (getcwd))

Sometimes you want to add to the end of the path:

--8<---------------cut here---------------start------------->8---
  (setenv "GEM_PATH"
          (string-append (getenv "GEM_PATH") ":" new-gem))
--8<---------------cut here---------------end--------------->8---

With this patch, you could write instead:

  (setenv/list-extend "GEM_PATH" new-gem #:prepend? #f)

Adding include paths becomes much more readable in conjunction with
search-input-directory, with this:

--8<---------------cut here---------------start------------->8---
  (setenv "CPATH"
          (string-append (assoc-ref inputs "libtirpc")
                         "/include/tirpc/:"
                         (or (getenv "CPATH") "")))
--8<---------------cut here---------------end--------------->8---

becoming this:

  (setenv/list-extend "CPATH"
    (search-input-directory "/include/tirpc"))

A less common case, of removing a path:

--8<---------------cut here---------------start------------->8---
  (setenv "CPLUS_INCLUDE_PATH"
          (string-join
           (delete (string-append gcc "/include/c++")
                   (string-split (getenv "CPLUS_INCLUDE_PATH") #\:))
           ":"))
--8<---------------cut here---------------end--------------->8---

becomes this:

  (setenv/list-delete "CPLUS_INCLUDE_PATH"
    (string-append gcc "/include/c++"))

What do you all think?

(Bikeshed opportunity: I'm not in love with the names.  I originally named
these 'setenv/path' rather than 'setenv/list', because I wanted to avoid
confusion with Guix's search paths, but I'm not sure 'setenv/list' is actually
more clear.

I considered getenv*, setenv*, and so on, but I didn't think they were quite
clear enough either.

I did consider 'setenv/list-extend!' and 'setenv/list-delete!' since they do
modify the env var in place, but "setenv" should already imply that.

Finally, it might be better to have e.g. 'setenv/path-prepend!' and
'setenv/path-append!' rather than the single 'setenv/path-extend', but I could
not settle on memorable, representative names.  Using 'append' carries a
connotation that you are dealing with lists, because of 'append', but it also
accepts a single element.  Using 'extend'/'prepend' together seems confusing
to me, because I might reach for 'extend' to add to the beginning of the list
if I forget about 'prepend'.)

--
Sarah

 .dir-locals.el        |  4 ++++
 guix/build/utils.scm  | 56 +++++++++++++++++++++++++++++++++++++++++++
 tests/build-utils.scm | 53 ++++++++++++++++++++++++++++++++++++++++
 3 files changed, 113 insertions(+)

diff --git a/.dir-locals.el b/.dir-locals.el
index 919ed1d1c4..4b58220526 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -69,6 +69,10 @@
    (eval . (put 'add-before 'scheme-indent-function 2))
    (eval . (put 'add-after 'scheme-indent-function 2))
 
+   (eval . (put 'setenv/list 'scheme-indent-function 1))
+   (eval . (put 'setenv/list-extend 'scheme-indent-function 1))
+   (eval . (put 'setenv/list-delete 'scheme-indent-function 1))
+
    (eval . (put 'modify-services 'scheme-indent-function 1))
    (eval . (put 'with-directory-excursion 'scheme-indent-function 1))
    (eval . (put 'with-file-lock 'scheme-indent-function 1))
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 3beb7da67a..d0ac33a64f 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -75,6 +76,11 @@
             find-files
             false-if-file-not-found
 
+            getenv/list
+            setenv/list
+            setenv/list-extend
+            setenv/list-delete
+
             search-path-as-list
             set-path-environment-variable
             search-path-as-string->list
@@ -521,6 +527,56 @@ also be included.  If FAIL-ON-ERROR? is true, raise an 
exception upon error."
           #f
           (apply throw args)))))
 
+
+;;;
+;;; Multiple-valued environment variables.
+;;;
+
+(define* (setenv/list env-var lst #:key (separator #\:))
+  "Set environment variable ENV-VAR to the elements of LST separated by
+SEPARATOR.  Empty elements are ignored.  If ENV-VAR would be set to the empty
+string, unset ENV-VAR."
+  (let ((path (string-join (delete "" lst) (string separator))))
+    (if (string-null? path)
+        (unsetenv env-var)
+        (setenv env-var path))))
+
+(define* (getenv/list env-var #:key (separator #\:))
+  "Return a list of the SEPARATOR-separated elements of environment variable
+ENV-VAR, or the empty list if ENV-VAR is unset."
+  (or (and=> (getenv env-var)
+             (cut string-split <> separator))
+      '()))
+
+(define* (setenv/list-extend env-var list-or-str
+                             #:key (separator #\:) (prepend? #t))
+  "Add the element(s) LIST-OR-STR to the environment variable ENV-VAR using
+SEPARATOR between elements.  Empty elements are ignored.  Elements are placed
+at the beginning if PREPEND? is #t, or at the end otherwise."
+  (let* ((elements (match list-or-str
+                     ((? string? str) (list str))
+                     ((? list? lst) lst)))
+         (original (or (getenv env-var) ""))
+         (path-list (if prepend?
+                        (append elements (list original))
+                        (cons original elements))))
+    (when (not (null? elements))
+      (setenv/list env-var path-list #:separator separator))))
+
+(define* (setenv/list-delete env-var list-or-str #:key (separator #\:))
+  "Remove the element(s) LIST-OR-STR from the SEPARATOR-separated environment
+variable ENV-VAR, and set ENV-VAR to that value.  If ENV-VAR would be set to
+the empty string, unset ENV-VAR."
+  (let* ((elements (match list-or-str
+                     ((? string? str) (list str))
+                     ((? list? lst) lst)))
+         (original (getenv/list env-var #:separator separator))
+         (path-list (lset-difference string=? original elements))
+         (path (string-join path-list (string separator))))
+    (if (string-null? path)
+        (unsetenv env-var)
+        (setenv env-var path))))
+
 
 ;;;
 ;;; Search paths.
diff --git a/tests/build-utils.scm b/tests/build-utils.scm
index 6b131c0af8..b26bffd9a8 100644
--- a/tests/build-utils.scm
+++ b/tests/build-utils.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -264,6 +265,58 @@ print('hello world')"))
          (lambda _
            (get-string-all (current-input-port))))))))
 
+(test-equal "setenv/list: ignore empty elements"
+  "one:three"
+  (with-environment-variable "TEST_SETENV" #f
+    (setenv/list "TEST_SETENV" '("one" "" "three"))
+    (getenv "TEST_SETENV")))
+
+(test-equal "setenv/list: unset if empty"
+  #f
+  (with-environment-variable "TEST_SETENV" #f
+    (setenv/list "TEST_SETENV" '())
+    (getenv "TEST_SETENV")))
+
+(test-equal "getenv/list"
+  '("one" "two" "three")
+  (with-environment-variable "TEST_SETENV" "one:two:three"
+    (getenv/list "TEST_SETENV")))
+
+(test-equal "getenv/list: unset"
+  '()
+  (with-environment-variable "TEST_SETENV" #f
+    (getenv/list "TEST_SETENV")))
+
+(test-equal "setenv/list-extend: single element, prepend"
+  "new:one:two"
+  (with-environment-variable "TEST_SETENV" "one:two"
+    (setenv/list-extend "TEST_SETENV" "new")
+    (getenv "TEST_SETENV")))
+
+(test-equal "setenv/list-extend: multiple elements, prepend"
+  "first:second:one:two"
+  (with-environment-variable "TEST_SETENV" "one:two"
+    (setenv/list-extend "TEST_SETENV" '("first" "second"))
+    (getenv "TEST_SETENV")))
+
+(test-equal "setenv/list-extend: multiple elements, append"
+  "one:two:first:second"
+  (with-environment-variable "TEST_SETENV" "one:two"
+    (setenv/list-extend "TEST_SETENV" '("first" "second") #:prepend? #f)
+    (getenv "TEST_SETENV")))
+
+(test-equal "setenv/list-delete: single deletion"
+  "one:two:three"
+  (with-environment-variable "TEST_SETENV" "bad:one:two:bad:three:bad"
+    (setenv/list-delete "TEST_SETENV" "bad")
+    (getenv "TEST_SETENV")))
+
+(test-equal "setenv/list-delete: multiple deletions"
+  "one:three"
+  (with-environment-variable "TEST_SETENV" "bad:one:two:bad:three:bad"
+    (setenv/list-delete "TEST_SETENV" '("bad" "two"))
+    (getenv "TEST_SETENV")))
+
 (test-equal "search-input-file: exception if not found"
   `((path)
     (file . "does-not-exist"))

base-commit: 693d75e859150601145b7f7303f61d4f48e76927
-- 
2.31.1