[bug#43627] [PATCH core-updates 1/3] guix: Add an append-separator? field to the <search-path-specification> record.

[Maxim Cournoyer <maxim.cournoyer@gmail.com>]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain; charset=yes, Size: 14127 bytes --]

This new field allows to specify in a search-path-specification that a
trailing separator should be added to the computed value of the environment
variable.  A trailing separator sometimes has the meaning that the usual
builtin locations should be looked up as well as the ones explicitly
specified.

One use case is to specify the Emacs library paths using EMACSLOADPATH.  This
allows to not embed the Emacs version in its search path specification, which
has been shown to cause issues when upgrading a profile or when defining
variant Emacs packages of different versions.

* guix/search-paths.scm (searh-path-specification): Add an APPEND-SEPARATOR?
field.
(search-path-specification->sexp): Adjust accordingly.
(sexp->search-path-specification): Likewise.
(evaluate-search-paths): Append a separator to the search path value when both
`separator' and `append-separator?' are #t.  Document the new behavior.
* guix/scripts/environment.scm (create-environment): Adjust the logic used to
merge search-path values when creating an environment profile.
* guix/build/gnu-build-system.scm (set-paths): Adjust accordingly.
---
 guix/build/gnu-build-system.scm | 11 +++++---
 guix/build/profiles.scm         | 13 ++++++---
 guix/build/utils.scm            | 13 +++++++--
 guix/scripts/environment.scm    | 11 ++++++--
 guix/search-paths.scm           | 49 +++++++++++++++++++++++----------
 5 files changed, 70 insertions(+), 27 deletions(-)

diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index d3347c9518..7039910c79 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2020 Brendan Tildesley <mail@brendan.scot>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -96,23 +97,25 @@ See https://reproducible-builds.org/specs/source-date-epoch/."
                                              input-directories)))
 
   (for-each (match-lambda
-             ((env-var (files ...) separator type pattern)
+             ((env-var (files ...) separator type pattern append-sep)
               (set-path-environment-variable env-var files
                                              input-directories
                                              #:separator separator
                                              #:type type
-                                             #:pattern pattern)))
+                                             #:pattern pattern
+                                             #:append-separator? append-sep)))
             search-paths)
 
   (when native-search-paths
     ;; Search paths for native inputs, when cross building.
     (for-each (match-lambda
-               ((env-var (files ...) separator type pattern)
+               ((env-var (files ...) separator type pattern append-sep)
                 (set-path-environment-variable env-var files
                                                native-input-directories
                                                #:separator separator
                                                #:type type
-                                               #:pattern pattern)))
+                                               #:pattern pattern
+                                               #:append-separator? append-sep)))
               native-search-paths))
 
   #t)
diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm
index 67ee9b665a..035c6558ba 100644
--- a/guix/build/profiles.scm
+++ b/guix/build/profiles.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,6 +21,7 @@
   #:use-module (guix build union)
   #:use-module (guix build utils)
   #:use-module (guix search-paths)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
@@ -51,10 +53,13 @@ user-friendly name of the profile is, for instance ~/.guix-profile rather than
          ((? string? separator)
           (let ((items (string-tokenize* value separator)))
             (cons search-path
-                  (string-join (map (lambda (str)
-                                      (string-append replacement (crop str)))
-                                    items)
-                               separator)))))))))
+                  (string-join
+                   (map (lambda (str)
+                          (string-append replacement (crop str)))
+                        ;; When APPEND-SEPARATOR? is #t, the trailing
+                        ;; separator causes an empty string item.  Remove it.
+                        (remove string-null? items))
+                   separator)))))))))
 
 (define (write-environment-variable-definition port)
   "Write the given environment variable definition to PORT."
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index afcb71fae3..0a3f38fc69 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -524,7 +525,8 @@ for under the directories designated by FILES.  For example:
                                         #:key
                                         (separator ":")
                                         (type 'directory)
-                                        pattern)
+                                        pattern
+                                        (append-separator? #f))
   "Look for each of FILES of the given TYPE (a symbol as returned by
 'stat:type') in INPUT-DIRS.  Set ENV-VAR to a SEPARATOR-separated path
 accordingly.  Example:
@@ -541,11 +543,16 @@ denoting file names to look for under the directories designated by FILES:
                                  (list docbook-xml docbook-xsl)
                                  #:type 'regular
                                  #:pattern \"^catalog\\\\.xml$\")
-"
+
+When both SEPARATOR and APPEND-SEPARATOR? are true, a separator is appended to
+the value of the environment variable."
   (let* ((path  (search-path-as-list files input-dirs
                                      #:type type
                                      #:pattern pattern))
-         (value (list->search-path-as-string path separator)))
+         (value (list->search-path-as-string path separator))
+         (value (if append-separator?
+                          (string-append value separator)
+                          value)))
     (if (string-null? value)
         (begin
           ;; Never set ENV-VAR to an empty string because often, the empty
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index ad50281eb2..f3d53c7ae5 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2014, 2015, 2018 David Thompson <davet@gnu.org>
 ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Mike Gerwitz <mtg@gnu.org>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -80,12 +81,18 @@ variables with additional search paths."
   (when pure?
     (purify-environment white-list))
   (for-each (match-lambda
-              ((($ <search-path-specification> variable _ separator) . value)
+              ((($ <search-path-specification> variable _ separator _
+                                               append-separator?) . value)
                (let ((current (getenv variable)))
                  (setenv variable
                          (if (and current (not pure?))
                              (if separator
-                                 (string-append value separator current)
+                                 (if append-separator?
+                                     ;; There is already a trailing separator
+                                     ;; at the end of value.
+                                     ;; (see: `evaluate-search-paths').
+                                     (string-append value current separator)
+                                     (string-append value separator current))
                                  value)
                              value)))))
             (profile-search-paths profile manifest))
diff --git a/guix/search-paths.scm b/guix/search-paths.scm
index 002e6342bb..d783a2815f 100644
--- a/guix/search-paths.scm
+++ b/guix/search-paths.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,6 +31,7 @@
             search-path-specification-separator
             search-path-specification-file-type
             search-path-specification-file-pattern
+            search-path-specification-append-separator?
 
             $PATH
 
@@ -54,14 +56,16 @@
 (define-record-type* <search-path-specification>
   search-path-specification make-search-path-specification
   search-path-specification?
-  (variable     search-path-specification-variable) ;string
-  (files        search-path-specification-files)    ;list of strings
-  (separator    search-path-specification-separator ;string | #f
-                (default ":"))
-  (file-type    search-path-specification-file-type ;symbol
-                (default 'directory))
-  (file-pattern search-path-specification-file-pattern ;#f | string
-                (default #f)))
+  (variable          search-path-specification-variable) ;string
+  (files             search-path-specification-files)    ;list of strings
+  (separator         search-path-specification-separator ;string | #f
+                     (default ":"))
+  (file-type         search-path-specification-file-type ;symbol
+                     (default 'directory))
+  (file-pattern      search-path-specification-file-pattern ;#f | string
+                     (default #f))
+  (append-separator? search-path-specification-append-separator? ;#f | #t
+                     (default #f)))
 
 (define $PATH
   ;; The 'PATH' variable.  This variable is a bit special: it is not attached
@@ -76,20 +80,32 @@ corresponds to the arguments expected by `set-path-environment-variable'."
   ;; Note that this sexp format is used both by build systems and in
   ;; (guix profiles), so think twice before you change it.
   (match spec
-    (($ <search-path-specification> variable files separator type pattern)
-     `(,variable ,files ,separator ,type ,pattern))))
+    (($ <search-path-specification> variable files separator type pattern
+                                    append-separator?)
+     `(,variable ,files ,separator ,type ,pattern ,append-separator?))))
 
 (define (sexp->search-path-specification sexp)
   "Convert SEXP, which is as returned by 'search-path-specification->sexp', to
 a <search-path-specification> object."
   (match sexp
+    ((variable files separator type pattern append-separator?)
+     (search-path-specification
+      (variable variable)
+      (files files)
+      (separator separator)
+      (file-type type)
+      (file-pattern pattern)
+      (append-separator? append-separator?)))
+    ;; Previous search-path-specification form (without append-separator?
+    ;; might still be found in manifest files.
     ((variable files separator type pattern)
      (search-path-specification
       (variable variable)
       (files files)
       (separator separator)
       (file-type type)
-      (file-pattern pattern)))))
+      (file-pattern pattern)
+      (append-separator? #f)))))
 
 (define-syntax-rule (with-null-error-port exp)
   "Evaluate EXP with the error port pointing to the bit bucket."
@@ -131,7 +147,9 @@ like `string-tokenize', but SEPARATOR is a string."
   "Evaluate SEARCH-PATHS, a list of search-path specifications, for
 DIRECTORIES, a list of directory names, and return a list of
 specification/value pairs.  Use GETENV to determine the current settings and
-report only settings not already effective."
+report only settings not already effective.  When the search path
+specification APPEND-SEPARATOR? and SEPARATOR fields are both set to true, a
+separator is appended to its computed value."
   (define (search-path-definition spec)
     (match spec
       (($ <search-path-specification> variable files #f type pattern)
@@ -148,7 +166,7 @@ report only settings not already effective."
                 #f                         ;VARIABLE already set appropriately
                 (cons spec head))))))
       (($ <search-path-specification> variable files separator
-                                      type pattern)
+                                      type pattern append-separator?)
        (let* ((values (or (and=> (getenv variable)
                                  (cut string-tokenize* <> separator))
                           '()))
@@ -161,7 +179,10 @@ report only settings not already effective."
                                             #:pattern pattern))))
          (if (every (cut member <> values) path)
              #f                         ;VARIABLE is already set appropriately
-             (cons spec (string-join path separator)))))))
+             (let ((value (string-join path separator)))
+               (cons spec (if append-separator?
+                              (string-append value separator)
+                              value))))))))
 
   (filter-map search-path-definition search-paths))
 
-- 
2.28.0