diff options
| -rw-r--r-- | guix/profiles.scm | 49 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 40 |
2 files changed, 48 insertions, 41 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm index 9bddf88162..95a8f30335 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -25,6 +25,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix profiles) + #:use-module ((guix config) #:select (%state-directory)) #:use-module ((guix utils) #:hide (package-name->name+version)) #:use-module ((guix build utils) #:select (package-name->name+version)) @@ -118,7 +119,13 @@ generation-file-name switch-to-generation roll-back - delete-generation)) + delete-generation + + %user-profile-directory + %profile-directory + %current-profile + canonicalize-profile + user-friendly-profile)) ;;; Commentary: ;;; @@ -1515,4 +1522,44 @@ because the NUMBER is zero.)" (else (delete-and-return))))) +(define %user-profile-directory + (and=> (getenv "HOME") + (cut string-append <> "/.guix-profile"))) + +(define %profile-directory + (string-append %state-directory "/profiles/" + (or (and=> (or (getenv "USER") + (getenv "LOGNAME")) + (cut string-append "per-user/" <>)) + "default"))) + +(define %current-profile + ;; Call it `guix-profile', not `profile', to allow Guix profiles to + ;; coexist with Nix profiles. + (string-append %profile-directory "/guix-profile")) + +(define (canonicalize-profile profile) + "If PROFILE is %USER-PROFILE-DIRECTORY, return %CURRENT-PROFILE. Otherwise +return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if +'-p' was omitted." ; see <http://bugs.gnu.org/17939> + + ;; Trim trailing slashes so that the basename comparison below works as + ;; intended. + (let ((profile (string-trim-right profile #\/))) + (if (and %user-profile-directory + (string=? (canonicalize-path (dirname profile)) + (dirname %user-profile-directory)) + (string=? (basename profile) (basename %user-profile-directory))) + %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)) + ;;; profiles.scm ends here diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 4f519e6f33..29829f52c8 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -64,46 +64,6 @@ ;;; Profiles. ;;; -(define %user-profile-directory - (and=> (getenv "HOME") - (cut string-append <> "/.guix-profile"))) - -(define %profile-directory - (string-append %state-directory "/profiles/" - (or (and=> (or (getenv "USER") - (getenv "LOGNAME")) - (cut string-append "per-user/" <>)) - "default"))) - -(define %current-profile - ;; Call it `guix-profile', not `profile', to allow Guix profiles to - ;; coexist with Nix profiles. - (string-append %profile-directory "/guix-profile")) - -(define (canonicalize-profile profile) - "If PROFILE is %USER-PROFILE-DIRECTORY, return %CURRENT-PROFILE. Otherwise -return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if -'-p' was omitted." ; see <http://bugs.gnu.org/17939> - - ;; Trim trailing slashes so that the basename comparison below works as - ;; intended. - (let ((profile (string-trim-right profile #\/))) - (if (and %user-profile-directory - (string=? (canonicalize-path (dirname profile)) - (dirname %user-profile-directory)) - (string=? (basename profile) (basename %user-profile-directory))) - %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 (ensure-default-profile) "Ensure the default profile symlink and directory exist and are writable." |