mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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.
This commit is contained in:
parent
c9a37f57cb
commit
ff94f9dfde
1 changed files with 22 additions and 10 deletions
|
@ -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)))))))))))
|
||||
|
|
Loading…
Reference in a new issue