diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-05-03 22:33:27 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2015-05-04 00:24:21 +0200 |
commit | 3badccaa7368fd2acc640b48c1dd3c1c2ae32500 (patch) | |
tree | 2888f1dd8e95fdd33a819ec5c5d00d58f5b80d0e | |
parent | 1e7464a9d2cb84c845ab821c90f908136a1d8959 (diff) | |
download | guix-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.scm | 80 |
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) |