aboutsummaryrefslogtreecommitdiff
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)
downloadpatches-3badccaa7368fd2acc640b48c1dd3c1c2ae32500.tar
patches-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)