mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
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:
parent
cdc5b9320f
commit
efcb4441f1
2 changed files with 48 additions and 41 deletions
|
@ -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 @@ (define-module (guix profiles)
|
|||
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 @@ (define (delete-and-return)
|
|||
(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
|
||||
|
|
|
@ -64,46 +64,6 @@ (define %store
|
|||
;;; 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."
|
||||
|
||||
|
|
Loading…
Reference in a new issue