[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/04: environment: Use 'with-build-handler'.
|
From: |
guix-commits |
|
Subject: |
02/04: environment: Use 'with-build-handler'. |
|
Date: |
Wed, 25 Mar 2020 11:03:21 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit c74f19d758c786d30ee238e3bc8c4e3f8893ba4b
Author: Ludovic Courtès <address@hidden>
AuthorDate: Wed Mar 25 15:01:15 2020 +0100
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'.
---
guix/scripts/environment.scm | 144 ++++++++++++++++++++-----------------------
1 file changed, 66 insertions(+), 78 deletions(-)
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index f043637..ca12346 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 <address@hidden>
-;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <address@hidden>
+;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès
<address@hidden>
;;; Copyright © 2018 Mike Gerwitz <address@hidden>
;;;
;;; 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?)))))))))))))))