me
/
guix
Archived
1
0
Fork 0
Code

environment: Allow starting from existing profile. 

* guix/scripts/environment.scm (%options): Add -p/--profile switch.
(show-help): Document new switch.
(guix-environment): Handle new 'profile switch.

Signed-off-by: 宋文武 <iyzsong@member.fsf.org>
master
Lars-Dominik Braun 2021-02-04 10:43:45 +01:00 committed by 宋文武
parent 4b62be5ca4
commit a643deac2d
No known key found for this signature in database
GPG Key ID: D415BF253B515976
1 changed files with 20 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
guix/scripts/environment.scm
View File

@ -21,6 +21,7 @@
(define-module (guix scripts environment) (define-module (guix scripts environment)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix utils)
#:use-module ((guix status) #:select (with-status-verbosity)) #:use-module ((guix status) #:select (with-status-verbosity))
#:use-module (guix grafts) #:use-module (guix grafts)
#:use-module (guix derivations) #:use-module (guix derivations)
@ -136,6 +137,8 @@ COMMAND or an interactive shell in that environment.\n"))
FILE evaluates to")) FILE evaluates to"))
(display (G_ " (display (G_ "
-m, --manifest=FILE create environment with the manifest from FILE")) -m, --manifest=FILE create environment with the manifest from FILE"))
(display (G_ "
-p, --profile=PATH create environment from profile at PATH"))
(display (G_ " (display (G_ "
--ad-hoc include all specified packages in the environment instead --ad-hoc include all specified packages in the environment instead
of only their inputs")) of only their inputs"))
@ -269,6 +272,10 @@ use '--preserve' instead~%"))
(option '(#\P "link-profile") #f #f (option '(#\P "link-profile") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'link-profile? #t result))) (alist-cons 'link-profile? #t result)))
(option '(#\p "profile") #t #f
(lambda (opt name arg result)
(alist-cons 'profile arg
(alist-delete 'profile result eq?))))
(option '(#\u "user") #t #f (option '(#\u "user") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'user arg (alist-cons 'user arg
@ -706,6 +713,7 @@ message if any test fails."
(user (assoc-ref opts 'user)) (user (assoc-ref opts 'user))
(bootstrap? (assoc-ref opts 'bootstrap?)) (bootstrap? (assoc-ref opts 'bootstrap?))
(system (assoc-ref opts 'system)) (system (assoc-ref opts 'system))
(profile (assoc-ref opts 'profile))
(command (or (assoc-ref opts 'exec) (command (or (assoc-ref opts 'exec)
;; Spawn a shell if the user didn't specify ;; Spawn a shell if the user didn't specify
;; anything in particular. ;; anything in particular.
@ -735,8 +743,16 @@ message if any test fails."
#:dry-run? #:dry-run?
(assoc-ref opts 'dry-run?)) (assoc-ref opts 'dry-run?))
(with-status-verbosity (assoc-ref opts 'verbosity) (with-status-verbosity (assoc-ref opts 'verbosity)
(define manifest (define manifest-from-opts
(options/resolve-packages store opts)) (options/resolve-packages store opts))
(when (and profile
(> (length (manifest-entries manifest-from-opts)) 0))
(leave (G_ "'--profile' cannot be used with package options~%")))
(define manifest
(if profile
(profile-manifest profile)
manifest-from-opts))
(set-build-options-from-command-line store opts) (set-build-options-from-command-line store opts)
@ -755,7 +771,9 @@ message if any test fails."
system)) system))
(prof-drv (manifest->derivation (prof-drv (manifest->derivation
manifest system bootstrap?)) manifest system bootstrap?))
(profile -> (derivation->output-path prof-drv)) (profile -> (if profile
(readlink* profile)
(derivation->output-path prof-drv)))
(gc-root -> (assoc-ref opts 'gc-root))) (gc-root -> (assoc-ref opts 'gc-root)))
;; First build the inputs. This is necessary even for ;; First build the inputs. This is necessary even for