aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-05-13 16:08:24 +0200
committerLudovic Courtès <ludo@gnu.org>2018-06-09 12:02:28 +0200
commitefcb4441f1c2dd6729938ca68f2fdfd6243e24e4 (patch)
tree17221335f331cb8bbe5d46b6df2361e326c78036
parentcdc5b9320f34a73b0a05a8915872e2aa21ff1197 (diff)
downloadguix-efcb4441f1c2dd6729938ca68f2fdfd6243e24e4.tar
guix-efcb4441f1c2dd6729938ca68f2fdfd6243e24e4.tar.gz
profiles: Add '%current-profile', 'user-friendly-profile', & co.
* guix/scripts/package.scm (%user-profile-directory) (%profile-directory, %current-profile, canonicalize-profile) (user-friendly-profile): Move to... * guix/profiles.scm: ... here.
-rw-r--r--guix/profiles.scm49
-rw-r--r--guix/scripts/package.scm40
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."