diff options
author | Ludovic Courtès <ludo@gnu.org> | 2020-03-20 12:46:06 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2020-03-23 10:48:17 +0100 |
commit | 1bb248d0b10af77379096f4456ce6f5c5d1c23ac (patch) | |
tree | 9e8b4801dc9996035ba9417fb5d82aaa90bd3329 | |
parent | 7b322d3c4cb266a0d84f5e3a8ceedd302f9f73df (diff) | |
download | patches-1bb248d0b10af77379096f4456ce6f5c5d1c23ac.tar patches-1bb248d0b10af77379096f4456ce6f5c5d1c23ac.tar.gz |
deploy: Show what machines will be deployed.
* guix/scripts/deploy.scm (show-what-to-deploy): New procedure.
(guix-deploy): Call it.
-rw-r--r-- | guix/scripts/deploy.scm | 19 |
1 files changed, 19 insertions, 0 deletions
diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm index a82dde00a4..d4d07bea5a 100644 --- a/guix/scripts/deploy.scm +++ b/guix/scripts/deploy.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 David Thompson <davet@gnu.org> ;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org> +;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -97,6 +98,22 @@ Perform the deployment specified by FILE.\n")) environment-modules)))) (load* file module))) +(define (show-what-to-deploy machines) + "Show the list of machines to deploy, MACHINES." + (let ((count (length machines))) + (format (current-error-port) + (N_ "The following ~*machine will be deployed:~%" + "The following ~d machines will be deployed:~%" + count) + count) + (display (indented-string + (fill-paragraph (string-join (map machine-display-name machines) + ", ") + (- (%text-width) 2) 2) + 2) + (current-error-port)) + (display "\n\n" (current-error-port)))) + (define (guix-deploy . args) (define (handle-argument arg result) (alist-cons 'file arg result)) @@ -105,6 +122,8 @@ Perform the deployment specified by FILE.\n")) #:argument-handler handle-argument)) (file (assq-ref opts 'file)) (machines (or (and file (load-source-file file)) '()))) + (show-what-to-deploy machines) + (with-status-verbosity (assoc-ref opts 'verbosity) (with-store store (set-build-options-from-command-line store opts) |