guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

01/15: deploy: Honor '--dry-run'.


From: guix-commits
Subject: 01/15: deploy: Honor '--dry-run'.
Date: Fri, 22 Jul 2022 18:40:50 -0400 (EDT)

civodul pushed a commit to branch master
in repository guix.

commit ff94f9dfde142750be0ae3e48aaba82a76189da9
Author: Ludovic Court├Ęs <ludo@gnu.org>
AuthorDate: Sun Jul 17 16:34:01 2022 +0200

    deploy: Honor '--dry-run'.
    
    * guix/scripts/deploy.scm (%options): Add "dry-run".
    (show-what-to-deploy): Add #:dry-run? and honor it.
    (guix-deploy): Honor --dry-run.
---
 guix/scripts/deploy.scm | 32 ++++++++++++++++++++++----------
 1 file changed, 22 insertions(+), 10 deletions(-)

diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm
index 27478eabc0..2c76645173 100644
--- a/guix/scripts/deploy.scm
+++ b/guix/scripts/deploy.scm
@@ -76,6 +76,9 @@ Perform the deployment specified by FILE.\n"))
                  (lambda args
                    (show-version-and-exit "guix deploy")))
 
+         (option '(#\n "dry-run") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'dry-run? #t result)))
          (option '(#\x "execute") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'execute-command? #t result)))
@@ -110,14 +113,20 @@ Perform the deployment specified by FILE.\n"))
                                            environment-modules))))
     (load* file module)))
 
-(define (show-what-to-deploy machines)
+(define* (show-what-to-deploy machines #:key (dry-run? #f))
   "Show the list of machines to deploy, MACHINES."
   (let ((count (length machines)))
-    (format (current-error-port)
-            (N_ "The following ~d machine will be deployed:~%"
-                "The following ~d machines will be deployed:~%"
+    (if dry-run?
+        (format (current-error-port)
+                (N_ "The following ~d machine would be deployed:~%"
+                    "The following ~d machines would be deployed:~%"
+                    count)
                 count)
-            count)
+        (format (current-error-port)
+                (N_ "The following ~d 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)
                                            ", ")
@@ -241,6 +250,7 @@ otherwise."
                                      #:argument-handler handle-argument))
            (file (assq-ref opts 'file))
            (machines (and file (load-source-file file)))
+           (dry-run? (assoc-ref opts 'dry-run?))
            (execute-command? (assoc-ref opts 'execute-command?)))
       (unless file
         (leave (G_ "missing deployment file argument~%")))
@@ -254,7 +264,8 @@ otherwise."
           (with-build-handler (build-notifier #:use-substitutes?
                                               (assoc-ref opts 'substitutes?)
                                               #:verbosity
-                                              (assoc-ref opts 'verbosity))
+                                              (assoc-ref opts 'verbosity)
+                                              #:dry-run? dry-run?)
             (parameterize ((%graft? (assq-ref opts 'graft?)))
               (if execute-command?
                   (match command
@@ -270,7 +281,8 @@ otherwise."
                     (_
                      (leave (G_ "'-x' specified but no command given~%"))))
                   (begin
-                    (show-what-to-deploy machines)
-                    (map/accumulate-builds store
-                                           (cut deploy-machine* store <>)
-                                           machines))))))))))
+                    (show-what-to-deploy machines #:dry-run? dry-run?)
+                    (unless dry-run?
+                      (map/accumulate-builds store
+                                             (cut deploy-machine* store <>)
+                                             machines)))))))))))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]