summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-05-03 22:33:27 +0200
committerLudovic Courtès <ludo@gnu.org>2015-05-04 00:24:21 +0200
commit3badccaa7368fd2acc640b48c1dd3c1c2ae32500 (patch)
tree2888f1dd8e95fdd33a819ec5c5d00d58f5b80d0e
parent1e7464a9d2cb84c845ab821c90f908136a1d8959 (diff)
downloadguix-3badccaa7368fd2acc640b48c1dd3c1c2ae32500.tar.gz
guix package: Move profile cleaning out of 'search-path-environment-variables'.
* guix/scripts/package.scm (user-friendly-profile): New procedure.
  (search-path-environment-variables): Remove 'profile' local variable.
  (display-search-paths): Explicitly call 'user-friendly-profile' for
  the argument to 'search-path-environment-variables'.
  (guix-package)[process-query]: Likewise.
-rw-r--r--guix/scripts/package.scm80
1 files changed, 41 insertions, 39 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index fca70f566d..d9bad7ba87 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -89,6 +89,15 @@ return PROFILE unchanged.  The goal is to treat '-p ~/.guix-profile' as if
       %current-profile
       profile))
 
+(define (user-friendly-profile profile)
+  "Return either ~/.guix-profile if that's what PROFILE refers to, directly or
+indirectly, or PROFILE."
+  (if (and %user-profile-directory
+           (false-if-exception
+            (string=? (readlink %user-profile-directory) profile)))
+      %user-profile-directory
+      profile))
+
 (define (link-to-empty-profile store generation)
   "Link GENERATION, a string, to the empty profile."
   (let* ((drv  (run-with-store store
@@ -375,49 +384,41 @@ an output path different than CURRENT-PATH."
   "Return environment variable definitions that may be needed for the use of
 ENTRIES, a list of manifest entries, in PROFILE.  Use GETENV to determine the
 current settings and report only settings not already effective."
-
-  ;; Prefer ~/.guix-profile to the real profile directory name.
-  (let ((profile (if (and %user-profile-directory
-                          (false-if-exception
-                           (string=? (readlink %user-profile-directory)
-                                     profile)))
-                     %user-profile-directory
-                     profile)))
-
-    (define search-path-definition
-      (match-lambda
-       (($ <search-path-specification> variable files separator
-                                       type pattern)
-        (let* ((values (or (and=> (getenv variable)
-                                  (cut string-tokenize* <> separator))
-                           '()))
-               ;; Add a trailing slash to force symlinks to be treated as
-               ;; directories when 'find-files' traverses them.
-               (files  (if pattern
-                           (map (cut string-append <> "/") files)
-                           files))
-
-               ;; XXX: Silence 'find-files' when it stumbles upon non-existent
-               ;; directories (see
-               ;; <http://lists.gnu.org/archive/html/guix-devel/2015-01/msg00269.html>.)
-               (path   (with-null-error-port
-                        (search-path-as-list files (list profile)
-                                             #:type type
-                                             #:pattern pattern))))
-          (if (every (cut member <> values) path)
-              #f
-              (format #f "export ~a=\"~a\""
-                      variable
-                      (string-join path separator)))))))
-
-    (let ((search-paths (delete-duplicates
-                         (append-map manifest-entry-search-paths entries))))
-      (filter-map search-path-definition search-paths))))
+  (define search-path-definition
+    (match-lambda
+      (($ <search-path-specification> variable files separator
+                                      type pattern)
+       (let* ((values (or (and=> (getenv variable)
+                                 (cut string-tokenize* <> separator))
+                          '()))
+              ;; Add a trailing slash to force symlinks to be treated as
+              ;; directories when 'find-files' traverses them.
+              (files  (if pattern
+                          (map (cut string-append <> "/") files)
+                          files))
+
+              ;; XXX: Silence 'find-files' when it stumbles upon non-existent
+              ;; directories (see
+              ;; <http://lists.gnu.org/archive/html/guix-devel/2015-01/msg00269.html>.)
+              (path   (with-null-error-port
+                       (search-path-as-list files (list profile)
+                                            #:type type
+                                            #:pattern pattern))))
+         (if (every (cut member <> values) path)
+             #f
+             (format #f "export ~a=\"~a\""
+                     variable
+                     (string-join path separator)))))))
+
+  (let ((search-paths (delete-duplicates
+                       (append-map manifest-entry-search-paths entries))))
+    (filter-map search-path-definition search-paths)))
 
 (define (display-search-paths entries profile)
   "Display the search path environment variables that may need to be set for
 ENTRIES, a list of manifest entries, in the context of PROFILE."
-  (let ((settings (search-path-environment-variables entries profile)))
+  (let* ((profile  (user-friendly-profile profile))
+         (settings (search-path-environment-variables entries profile)))
     (unless (null? settings)
       (format #t (_ "The following environment variable definitions may be needed:~%"))
       (format #t "~{   ~a~%~}" settings))))
@@ -999,6 +1000,7 @@ more information.~%"))
         (('search-paths)
          (let* ((manifest (profile-manifest profile))
                 (entries  (manifest-entries manifest))
+                (profile  (user-friendly-profile profile))
                 (settings (search-path-environment-variables entries profile
                                                              (const #f))))
            (format #t "~{~a~%~}" settings)