[bug#56616] [PATCH] deploy: Honor '--dry-run'.

[bug#56616] [PATCH] deploy: Honor '--dry-run'.

[Ludovic Courtès]

* 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(-)

Hi!

‘guix deploy --help’ would advertise ‘--dry-run’ but it wasn’t
actually implemented.  This patch fixes that.

Note that ‘--dry-run’ doesn’t go beyond loading the deploy file.
In particular, it doesn’t attempt to build anything because that
is left to backends such as (gnu machine ssh).

Thoughts?

Ludo’.

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 @@ (define %options
                  (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 @@ (module (make-user-module (append '((gnu) (gnu machine))
                                            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 @@ (define (handle-argument arg result)
                                      #: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 @@ (define (handle-argument arg result)
           (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 @@ (define (handle-argument arg result)
                     (_
                      (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)))))))))))

base-commit: 4ce7f1fb24a111f3e92d5b889d1271bebf109d09
-- 
2.36.1

[bug#56616] [PATCH] deploy: Honor '--dry-run'.

[Maxime Devos]

[-- Attachment #1.1.1: Type: text/plain, Size: 428 bytes --]


On 17-07-2022 16:50, Ludovic Courtès wrote:
> +        (format (current-error-port)
> +                (N_ "The following ~d machine will be deployed:~%"


Wouldn't 'The following machine will be deployed' be better? 
Unfortunately, (ice-9 format) emits a warning in that case, but you can 
work-around that with argument jumping:

(format #t "~*The following machine will be deployed:~%")

Greetings,
Maxime.


[-- Attachment #1.1.2: OpenPGP public key --]
[-- Type: application/pgp-keys, Size: 929 bytes --]

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 236 bytes --]

[bug#56616] [PATCH] deploy: Honor '--dry-run'.

[Ludovic Courtès]

Maxime Devos <maximedevos@telenet.be> skribis:

> On 17-07-2022 16:50, Ludovic Courtès wrote:
>> +        (format (current-error-port)
>> +                (N_ "The following ~d machine will be deployed:~%"
>
>
> Wouldn't 'The following machine will be deployed' be better?
> Unfortunately, (ice-9 format) emits a warning in that case, but you
> can work-around that with argument jumping:
>
> (format #t "~*The following machine will be deployed:~%")

We used to do that but unfortunately that triggered a bug in xgettext;
see 388b432cea4ae2bb9bf4b044026b7764ab002e1e and
<https://bugs.gnu.org/37505>.

Ludo’.

[bug#56616] [PATCH] deploy: Honor '--dry-run'.

[Maxime Devos]

[-- Attachment #1.1.1.1: Type: text/plain, Size: 792 bytes --]


On 22-07-2022 14:15, Ludovic Courtès wrote:
> Maxime Devos<maximedevos@telenet.be>  skribis:
>
>> On 17-07-2022 16:50, Ludovic Courtès wrote:
>>> +        (format (current-error-port)
>>> +                (N_ "The following ~d machine will be deployed:~%"
>> Wouldn't 'The following machine will be deployed' be better?
>> Unfortunately, (ice-9 format) emits a warning in that case, but you
>> can work-around that with argument jumping:
>>
>> (format #t "~*The following machine will be deployed:~%")
> We used to do that but unfortunately that triggered a bug in xgettext;
> see 388b432cea4ae2bb9bf4b044026b7764ab002e1e and
> <https://bugs.gnu.org/37505>.
>
> Ludo’.

It's closed, but the bug is still there? Where is the upstream bug report?

Greetings,
Maxime.

[-- Attachment #1.1.1.2: Type: text/html, Size: 1881 bytes --]

[-- Attachment #1.1.2: OpenPGP public key --]
[-- Type: application/pgp-keys, Size: 929 bytes --]

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 236 bytes --]

[bug#56616] [PATCH] deploy: Honor '--dry-run'.

[Ludovic Courtès]

Maxime Devos <maximedevos@telenet.be> skribis:

> On 22-07-2022 14:15, Ludovic Courtès wrote:
>> Maxime Devos<maximedevos@telenet.be>  skribis:

[...]

>>> (format #t "~*The following machine will be deployed:~%")
>> We used to do that but unfortunately that triggered a bug in xgettext;
>> see 388b432cea4ae2bb9bf4b044026b7764ab002e1e and
>> <https://bugs.gnu.org/37505>.
>>
>> Ludo’.
>
> It's closed, but the bug is still there? Where is the upstream bug report?

I can’t find one, neither in the thread above nor at
<https://savannah.gnu.org/support/?group=gettext>, so maybe it’s time to
report it for good.

Ludo’.

bug#56616: [PATCH] deploy: Honor '--dry-run'.

[Ludovic Courtès]

Ludovic Courtès <ludo@gnu.org> skribis:

> * guix/scripts/deploy.scm (%options): Add "dry-run".
> (show-what-to-deploy): Add #:dry-run? and honor it.
> (guix-deploy): Honor --dry-run.

Pushed as ff94f9dfde142750be0ae3e48aaba82a76189da9.