summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-03-20 12:46:06 +0100
committerLudovic Courtès <ludo@gnu.org>2020-03-23 10:48:17 +0100
commit1bb248d0b10af77379096f4456ce6f5c5d1c23ac (patch)
tree9e8b4801dc9996035ba9417fb5d82aaa90bd3329
parent7b322d3c4cb266a0d84f5e3a8ceedd302f9f73df (diff)
downloadpatches-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.scm19
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)