environment: Use 'with-build-handler'.

* guix/scripts/environment.scm (build-environment): Remove.
(guix-environment): Wrap 'with-status-verbosity' in
'with-build-handler'.  Remove 'dry-run?' conditional.  Use
'built-derivations' instead of 'build-environment'.

1 files changed, 66 insertions, 78 deletions

diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index f04363750e..ca12346815 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2018 David Thompson <davet@gnu.org>
-;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Mike Gerwitz <mtg@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -364,19 +364,6 @@ for the corresponding packages."
                 opts)
     manifest-entry=?)))
 
-(define* (build-environment derivations opts)
-  "Build the DERIVATIONS required by the environment using the build options
-in OPTS."
-  (let ((substitutes? (assoc-ref opts 'substitutes?))
-        (dry-run?     (assoc-ref opts 'dry-run?)))
-    (mbegin %store-monad
-      (show-what-to-build* derivations
-                           #:use-substitutes? substitutes?
-                           #:dry-run? dry-run?)
-      (if dry-run?
-          (return #f)
-          (built-derivations derivations)))))
-
 (define (manifest->derivation manifest system bootstrap?)
   "Return the derivation for a profile of MANIFEST.
 BOOTSTRAP? specifies whether to use the bootstrap Guile to build the profile."
@@ -720,67 +707,68 @@ message if any test fails."
 
 
       (with-store store
-        (with-status-verbosity (assoc-ref opts 'verbosity)
-          (define manifest
-            (options/resolve-packages store opts))
-
-          (set-build-options-from-command-line store opts)
-
-          ;; Use the bootstrap Guile when requested.
-          (parameterize ((%graft? (assoc-ref opts 'graft?))
-                         (%guile-for-build
-                          (package-derivation
-                           store
-                           (if bootstrap?
-                               %bootstrap-guile
-                               (canonical-package guile-2.2)))))
-            (run-with-store store
-              ;; Containers need a Bourne shell at /bin/sh.
-              (mlet* %store-monad ((bash       (environment-bash container?
-                                                                 bootstrap?
-                                                                 system))
-                                   (prof-drv   (manifest->derivation
-                                                manifest system bootstrap?))
-                                   (profile -> (derivation->output-path prof-drv))
-                                   (gc-root -> (assoc-ref opts 'gc-root)))
-
-                ;; First build the inputs.  This is necessary even for
-                ;; --search-paths.  Additionally, we might need to build bash for
-                ;; a container.
-                (mbegin %store-monad
-                  (build-environment (if (derivation? bash)
-                                         (list prof-drv bash)
-                                         (list prof-drv))
-                                     opts)
-                  (mwhen gc-root
-                    (register-gc-root profile gc-root))
-
-                  (cond
-                   ((assoc-ref opts 'dry-run?)
-                    (return #t))
-                   ((assoc-ref opts 'search-paths)
-                    (show-search-paths profile manifest #:pure? pure?)
-                    (return #t))
-                   (container?
-                    (let ((bash-binary
-                           (if bootstrap?
-                               (derivation->output-path bash)
-                               (string-append (derivation->output-path bash)
-                                              "/bin/sh"))))
-                      (launch-environment/container #:command command
-                                                    #:bash bash-binary
-                                                    #:user user
-                                                    #:user-mappings mappings
-                                                    #:profile profile
-                                                    #:manifest manifest
-                                                    #:white-list white-list
-                                                    #:link-profile? link-prof?
-                                                    #:network? network?
-                                                    #:map-cwd? (not no-cwd?))))
-
-                   (else
-                    (return
-                     (exit/status
-                      (launch-environment/fork command profile manifest
-                                               #:white-list white-list
-                                               #:pure? pure?))))))))))))))
+        (with-build-handler (build-notifier #:use-substitutes?
+                                            (assoc-ref opts 'substitutes?)
+                                            #:dry-run?
+                                            (assoc-ref opts 'dry-run?))
+          (with-status-verbosity (assoc-ref opts 'verbosity)
+            (define manifest
+              (options/resolve-packages store opts))
+
+            (set-build-options-from-command-line store opts)
+
+            ;; Use the bootstrap Guile when requested.
+            (parameterize ((%graft? (assoc-ref opts 'graft?))
+                           (%guile-for-build
+                            (package-derivation
+                             store
+                             (if bootstrap?
+                                 %bootstrap-guile
+                                 (canonical-package guile-2.2)))))
+              (run-with-store store
+                ;; Containers need a Bourne shell at /bin/sh.
+                (mlet* %store-monad ((bash       (environment-bash container?
+                                                                   bootstrap?
+                                                                   system))
+                                     (prof-drv   (manifest->derivation
+                                                  manifest system bootstrap?))
+                                     (profile -> (derivation->output-path prof-drv))
+                                     (gc-root -> (assoc-ref opts 'gc-root)))
+
+                  ;; First build the inputs.  This is necessary even for
+                  ;; --search-paths.  Additionally, we might need to build bash for
+                  ;; a container.
+                  (mbegin %store-monad
+                    (built-derivations (if (derivation? bash)
+                                           (list prof-drv bash)
+                                           (list prof-drv)))
+                    (mwhen gc-root
+                      (register-gc-root profile gc-root))
+
+                    (cond
+                     ((assoc-ref opts 'search-paths)
+                      (show-search-paths profile manifest #:pure? pure?)
+                      (return #t))
+                     (container?
+                      (let ((bash-binary
+                             (if bootstrap?
+                                 (derivation->output-path bash)
+                                 (string-append (derivation->output-path bash)
+                                                "/bin/sh"))))
+                        (launch-environment/container #:command command
+                                                      #:bash bash-binary
+                                                      #:user user
+                                                      #:user-mappings mappings
+                                                      #:profile profile
+                                                      #:manifest manifest
+                                                      #:white-list white-list
+                                                      #:link-profile? link-prof?
+                                                      #:network? network?
+                                                      #:map-cwd? (not no-cwd?))))
+
+                     (else
+                      (return
+                       (exit/status
+                        (launch-environment/fork command profile manifest
+                                                 #:white-list white-list
+                                                 #:pure? pure?)))))))))))))))