rekahsoft
/
guix
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2018-05-13 16:08:24 +02:00
parent cdc5b9320f
commit efcb4441f1
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 48 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
guix/profiles.scm
View File

@ -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

40
guix/scripts/package.scm
View File

@ -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."