aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-03-18 22:57:28 +0100
committerLudovic Courtès <ludo@gnu.org>2020-03-22 12:42:51 +0100
commitbdda46a67d5b8d9d45a53a7d6b32d9acb9374ae2 (patch)
tree49f826adb6a5efbb57bdb344c48eea8712766dd2
parent62195b9a8fd6846117c5d7698842748300d13e31 (diff)
downloadguix-bdda46a67d5b8d9d45a53a7d6b32d9acb9374ae2.tar.gz
guix-bdda46a67d5b8d9d45a53a7d6b32d9acb9374ae2.zip
deploy: Use 'with-build-handler'.
Until now, 'guix deploy' would never display what is going to be built. * guix/scripts/deploy.scm (guix-deploy): Wrap 'for-each' in 'with-build-handler'.
-rw-r--r--guix/scripts/deploy.scm34
1 files changed, 18 insertions, 16 deletions
diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm
index ad05c333dc..a82dde00a4 100644
--- a/guix/scripts/deploy.scm
+++ b/guix/scripts/deploy.scm
@@ -108,19 +108,21 @@ Perform the deployment specified by FILE.\n"))
(with-status-verbosity (assoc-ref opts 'verbosity)
(with-store store
(set-build-options-from-command-line store opts)
- (for-each (lambda (machine)
- (info (G_ "deploying to ~a...~%")
- (machine-display-name machine))
- (parameterize ((%graft? (assq-ref opts 'graft?)))
- (guard (c ((message-condition? c)
- (report-error (G_ "failed to deploy ~a: ~a~%")
- (machine-display-name machine)
- (condition-message c)))
- ((deploy-error? c)
- (when (deploy-error-should-roll-back c)
- (info (G_ "rolling back ~a...~%")
- (machine-display-name machine))
- (run-with-store store (roll-back-machine machine)))
- (apply throw (deploy-error-captured-args c))))
- (run-with-store store (deploy-machine machine)))))
- machines)))))
+ (with-build-handler (build-notifier #:use-substitutes?
+ (assoc-ref opts 'substitutes?))
+ (for-each (lambda (machine)
+ (info (G_ "deploying to ~a...~%")
+ (machine-display-name machine))
+ (parameterize ((%graft? (assq-ref opts 'graft?)))
+ (guard (c ((message-condition? c)
+ (report-error (G_ "failed to deploy ~a: ~a~%")
+ (machine-display-name machine)
+ (condition-message c)))
+ ((deploy-error? c)
+ (when (deploy-error-should-roll-back c)
+ (info (G_ "rolling back ~a...~%")
+ (machine-display-name machine))
+ (run-with-store store (roll-back-machine machine)))
+ (apply throw (deploy-error-captured-args c))))
+ (run-with-store store (deploy-machine machine)))))
+ machines))))))