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.
This commit is contained in:
Ludovic Courtès 2015-05-03 22:33:27 +02:00
parent 1e7464a9d2
commit 3badccaa73
1 changed files with 39 additions and 37 deletions

View File

@ -89,6 +89,15 @@ return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if
%current-profile %current-profile
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) (define (link-to-empty-profile store generation)
"Link GENERATION, a string, to the empty profile." "Link GENERATION, a string, to the empty profile."
(let* ((drv (run-with-store store (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 "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 ENTRIES, a list of manifest entries, in PROFILE. Use GETENV to determine the
current settings and report only settings not already effective." current settings and report only settings not already effective."
(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))
;; Prefer ~/.guix-profile to the real profile directory name. ;; XXX: Silence 'find-files' when it stumbles upon non-existent
(let ((profile (if (and %user-profile-directory ;; directories (see
(false-if-exception ;; <http://lists.gnu.org/archive/html/guix-devel/2015-01/msg00269.html>.)
(string=? (readlink %user-profile-directory) (path (with-null-error-port
profile))) (search-path-as-list files (list profile)
%user-profile-directory #:type type
profile))) #:pattern pattern))))
(if (every (cut member <> values) path)
#f
(format #f "export ~a=\"~a\""
variable
(string-join path separator)))))))
(define search-path-definition (let ((search-paths (delete-duplicates
(match-lambda (append-map manifest-entry-search-paths entries))))
(($ <search-path-specification> variable files separator (filter-map search-path-definition search-paths)))
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) (define (display-search-paths entries profile)
"Display the search path environment variables that may need to be set for "Display the search path environment variables that may need to be set for
ENTRIES, a list of manifest entries, in the context of PROFILE." 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) (unless (null? settings)
(format #t (_ "The following environment variable definitions may be needed:~%")) (format #t (_ "The following environment variable definitions may be needed:~%"))
(format #t "~{ ~a~%~}" settings)))) (format #t "~{ ~a~%~}" settings))))
@ -999,6 +1000,7 @@ more information.~%"))
(('search-paths) (('search-paths)
(let* ((manifest (profile-manifest profile)) (let* ((manifest (profile-manifest profile))
(entries (manifest-entries manifest)) (entries (manifest-entries manifest))
(profile (user-friendly-profile profile))
(settings (search-path-environment-variables entries profile (settings (search-path-environment-variables entries profile
(const #f)))) (const #f))))
(format #t "~{~a~%~}" settings) (format #t "~{~a~%~}" settings)