Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Sun, 13 May 2018 22:24:02 UTC
Severity: normal
Tags: patch
Message #11 received at 31442 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31442 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 1/5] profiles: Add '%current-profile', 'user-friendly-profile', & co. Date: Mon, 14 May 2018 10:25:46 +0200
* guix/scripts/package.scm (%user-profile-directory)
(%profile-directory, %current-profile, canonicalize-profile)
(user-friendly-profile): Move to...
* guix/profiles.scm: ... here.
---
guix/profiles.scm | 49 +++++++++++++++++++++++++++++++++++++++-
guix/scripts/package.scm | 40 --------------------------------
2 files changed, 48 insertions(+), 41 deletions(-)
diff --git a/guix/profiles.scm b/guix/profiles.scm
index dca247976..3cdc3d2f1 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:
;;;
@@ -1465,4 +1472,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 4f519e6f3..29829f52c 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."
--
2.17.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.