branch master updated: environment: Allow starting from existing profile.

[guix-commits]

This is an automated email from the git hooks/post-receive script.

iyzsong pushed a commit to branch master
in repository guix.

The following commit(s) were added to refs/heads/master by this push:
     new a643dea  environment: Allow starting from existing profile.
a643dea is described below

commit a643deac2de81755a1843a3b41dd53857678bebc
Author: Lars-Dominik Braun <lars@6xq.net>
AuthorDate: Thu Feb 4 10:43:45 2021 +0100

    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>
---
 guix/scripts/environment.scm | 22 ++++++++++++++++++++--
 1 file changed, 20 insertions(+), 2 deletions(-)

diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index f4d12f8..a393477 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -21,6 +21,7 @@
 (define-module (guix scripts environment)
   #:use-module (guix ui)
   #:use-module (guix store)
+  #:use-module (guix utils)
   #:use-module ((guix status) #:select (with-status-verbosity))
   #:use-module (guix grafts)
   #:use-module (guix derivations)
@@ -137,6 +138,8 @@ COMMAND or an interactive shell in that environment.\n"))
   (display (G_ "
   -m, --manifest=FILE    create environment with the manifest from FILE"))
   (display (G_ "
+  -p, --profile=PATH     create environment from profile at PATH"))
+  (display (G_ "
       --ad-hoc           include all specified packages in the environment 
instead
                          of only their inputs"))
   (display (G_ "
@@ -269,6 +272,10 @@ use '--preserve' instead~%"))
          (option '(#\P "link-profile") #f #f
                  (lambda (opt name arg 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
                  (lambda (opt name arg result)
                    (alist-cons 'user arg
@@ -706,6 +713,7 @@ message if any test fails."
            (user       (assoc-ref opts 'user))
            (bootstrap? (assoc-ref opts 'bootstrap?))
            (system     (assoc-ref opts 'system))
+           (profile    (assoc-ref opts 'profile))
            (command    (or (assoc-ref opts 'exec)
                            ;; Spawn a shell if the user didn't specify
                            ;; anything in particular.
@@ -735,8 +743,16 @@ message if any test fails."
                                             #:dry-run?
                                             (assoc-ref opts 'dry-run?))
           (with-status-verbosity (assoc-ref opts 'verbosity)
-            (define manifest
+            (define manifest-from-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)
 
@@ -755,7 +771,9 @@ message if any test fails."
                                                                    system))
                                      (prof-drv   (manifest->derivation
                                                   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)))
 
                   ;; First build the inputs.  This is necessary even for