From 388b432cea4ae2bb9bf4b044026b7764ab002e1e Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Sat, 28 Mar 2020 15:55:13 +0100 Subject: deploy: Remove use of '~*' in format string. ...since 'msgfmt' fails to interpret it. Reported by Vagrant Cascadian in . See also . * guix/scripts/deploy.scm (show-what-to-deploy): Use ~d instead of ~* when displaying machines that will be deployed. --- guix/scripts/deploy.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix/scripts') diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm index f70d41f35c..5c871cd6ed 100644 --- a/guix/scripts/deploy.scm +++ b/guix/scripts/deploy.scm @@ -102,7 +102,7 @@ Perform the deployment specified by FILE.\n")) "Show the list of machines to deploy, MACHINES." (let ((count (length machines))) (format (current-error-port) - (N_ "The following ~*machine will be deployed:~%" + (N_ "The following ~d machine will be deployed:~%" "The following ~d machines will be deployed:~%" count) count) -- cgit v1.2.3 From 1213ea9bd91c3051365637731c6baeca791e0f65 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 25 Mar 2020 12:42:54 +0100 Subject: guix build: Use 'map/accumulate-builds'. * guix/scripts/build.scm (options->derivations): Use 'map/accumulate-builds' instead of 'append-map'. --- guix/scripts/build.scm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'guix/scripts') diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index af18d8b6f9..9f87febb56 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -920,8 +920,10 @@ build." (with-unbound-variable-handling (parameterize ((%graft? graft?)) (append-map (lambda (system) - (append-map (cut compute-derivation <> system) - things-to-build)) + (concatenate + (map/accumulate-builds store + (cut compute-derivation <> system) + things-to-build))) systems)))) (define (show-build-log store file urls) -- cgit v1.2.3 From 131f50cdc9dbb7183023f4dae759876a9e700bef Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 25 Mar 2020 15:05:15 +0100 Subject: '--dry-run' no longer implies '--no-grafts'. * guix/scripts/archive.scm (%options): "dry-run" option no longer adds 'graft? #f to RESULT. * guix/scripts/environment.scm (%options): Likewise. * guix/scripts/pack.scm (%options): Likewise. * guix/scripts/package.scm (%options): Likewise. * guix/scripts/pull.scm (%options): Likewise. * guix/scripts/system.scm (%options): Likewise. --- guix/scripts/archive.scm | 2 +- guix/scripts/build.scm | 2 +- guix/scripts/copy.scm | 2 +- guix/scripts/environment.scm | 2 +- guix/scripts/pack.scm | 2 +- guix/scripts/package.scm | 3 +-- guix/scripts/pull.scm | 2 +- guix/scripts/system.scm | 2 +- 8 files changed, 8 insertions(+), 9 deletions(-) (limited to 'guix/scripts') diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index 80f3b704d7..41a2a42c21 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -183,7 +183,7 @@ Export/import one or more packages from/to the store.\n")) (alist-delete 'verbosity result))))) (option '(#\n "dry-run") #f #f (lambda (opt name arg result) - (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) + (alist-cons 'dry-run? #t result))) %standard-build-options)) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 9f87febb56..79bd84a1a0 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -778,7 +778,7 @@ must be one of 'package', 'all', or 'transitive'~%") (alist-cons 'manifest arg result))) (option '(#\n "dry-run") #f #f (lambda (opt name arg result) - (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) + (alist-cons 'dry-run? #t result))) (option '(#\r "root") #t #f (lambda (opt name arg result) (alist-cons 'gc-root arg result))) diff --git a/guix/scripts/copy.scm b/guix/scripts/copy.scm index 2fa31ecf45..f6f64d0a11 100644 --- a/guix/scripts/copy.scm +++ b/guix/scripts/copy.scm @@ -135,7 +135,7 @@ Copy ITEMS to or from the specified host over SSH.\n")) (alist-delete 'verbosity result))))) (option '(#\n "dry-run") #f #f (lambda (opt name arg result) - (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) + (alist-cons 'dry-run? #t result))) (option '(#\h "help") #f #f (lambda args diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index ca12346815..bfc4039c2b 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -256,7 +256,7 @@ use '--preserve' instead~%")) (alist-cons 'ad-hoc? #t result))) (option '(#\n "dry-run") #f #f (lambda (opt name arg result) - (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) + (alist-cons 'dry-run? #t result))) (option '(#\s "system") #t #f (lambda (opt name arg result) (alist-cons 'system arg diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index b6fb73838d..f641f535b9 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -823,7 +823,7 @@ last resort for relocation." (option '(#\n "dry-run") #f #f (lambda (opt name arg result) - (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) + (alist-cons 'dry-run? #t result))) (option '(#\d "derivation") #f #f (lambda (opt name arg result) (alist-cons 'derivation-only? #t result))) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 110d4f2977..c7908ece6c 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -489,8 +489,7 @@ kind of search path~%") #f))) (option '(#\n "dry-run") #f #f (lambda (opt name arg result arg-handler) - (values (alist-cons 'dry-run? #t - (alist-cons 'graft? #f result)) + (values (alist-cons 'dry-run? #t result) #f))) (option '(#\v "verbosity") #t #f (lambda (opt name arg result arg-handler) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index b7e0a4a416..42c9956136 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -168,7 +168,7 @@ Download and deploy the latest version of Guix.\n")) (alist-delete 'system result eq?)))) (option '(#\n "dry-run") #f #f (lambda (opt name arg result) - (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) + (alist-cons 'dry-run? #t result))) (option '(#\v "verbosity") #t #f (lambda (opt name arg result) (let ((level (string->number* arg))) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 61a3c95dbd..a178761203 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -1041,7 +1041,7 @@ Some ACTIONS support additional ARGS.\n")) (option '(#\n "dry-run") #f #f (lambda (opt name arg result) - (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) + (alist-cons 'dry-run? #t result))) (option '(#\v "verbosity") #t #f (lambda (opt name arg result) (let ((level (string->number* arg))) -- cgit v1.2.3 From d089b233353f05440a97afc5c1e903b8c1891969 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 29 Mar 2020 15:51:08 +0200 Subject: deploy: Factorize machine deployment. * guix/scripts/deploy.scm (deploy-machine*): New procedure. (guix-deploy): Call it in 'for-each'. --- guix/scripts/deploy.scm | 42 ++++++++++++++++++++++++------------------ 1 file changed, 24 insertions(+), 18 deletions(-) (limited to 'guix/scripts') diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm index 5c871cd6ed..7a44b9a503 100644 --- a/guix/scripts/deploy.scm +++ b/guix/scripts/deploy.scm @@ -30,6 +30,7 @@ #:use-module (guix status) #:use-module (ice-9 format) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (srfi srfi-37) @@ -114,6 +115,27 @@ Perform the deployment specified by FILE.\n")) (current-error-port)) (display "\n\n" (current-error-port)))) +(define (deploy-machine* store machine) + "Deploy MACHINE, taking care of error handling." + (info (G_ "deploying to ~a...~%") + (machine-display-name machine)) + + (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)) + + (info (G_ "successfully deployed ~a~%") + (machine-display-name machine)))) + + (define (guix-deploy . args) (define (handle-argument arg result) (alist-cons 'file arg result)) @@ -129,21 +151,5 @@ Perform the deployment specified by FILE.\n")) (set-build-options-from-command-line store opts) (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)) - (info (G_ "successfully deployed ~a~%") - (machine-display-name machine))))) - machines)))))) + (parameterize ((%graft? (assq-ref opts 'graft?))) + (for-each (cut deploy-machine* store <>) machines))))))) -- cgit v1.2.3 From 18c8a4396bdb9e9c842ef386a2aecfac38943112 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 29 Mar 2020 16:05:17 +0200 Subject: deploy: Use 'map/accumulate-builds'. * guix/scripts/deploy.scm (guix-deploy): Use 'map/accumulate-builds' instead of 'for-each'. --- guix/scripts/deploy.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'guix/scripts') diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm index 7a44b9a503..4466a0c632 100644 --- a/guix/scripts/deploy.scm +++ b/guix/scripts/deploy.scm @@ -152,4 +152,6 @@ Perform the deployment specified by FILE.\n")) (with-build-handler (build-notifier #:use-substitutes? (assoc-ref opts 'substitutes?)) (parameterize ((%graft? (assq-ref opts 'graft?))) - (for-each (cut deploy-machine* store <>) machines))))))) + (map/accumulate-builds store + (cut deploy-machine* store <>) + machines))))))) -- cgit v1.2.3