deploy: Add '--verbosity' and properly interpret build log.
This is a followup to 91300526b7
.
* guix/scripts/deploy.scm (show-help, %options): Add '--verbosity'.
(guix-deploy): Wrap 'with-store' in 'with-status-verbosity'.
This commit is contained in:
parent
90ca791ab0
commit
b69ce8a872
|
@ -26,6 +26,7 @@
|
||||||
#:use-module (guix ui)
|
#:use-module (guix ui)
|
||||||
#:use-module (guix utils)
|
#:use-module (guix utils)
|
||||||
#:use-module (guix grafts)
|
#:use-module (guix grafts)
|
||||||
|
#:use-module (guix status)
|
||||||
#:use-module (ice-9 format)
|
#:use-module (ice-9 format)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-34)
|
#:use-module (srfi srfi-34)
|
||||||
|
@ -52,6 +53,8 @@ Perform the deployment specified by FILE.\n"))
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
-V, --version display version information and exit"))
|
-V, --version display version information and exit"))
|
||||||
(newline)
|
(newline)
|
||||||
|
(display (G_ "
|
||||||
|
-v, --verbosity=LEVEL use the given verbosity LEVEL"))
|
||||||
(show-bug-report-information))
|
(show-bug-report-information))
|
||||||
|
|
||||||
(define %options
|
(define %options
|
||||||
|
@ -63,6 +66,12 @@ Perform the deployment specified by FILE.\n"))
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'system arg
|
(alist-cons 'system arg
|
||||||
(alist-delete 'system result eq?))))
|
(alist-delete 'system result eq?))))
|
||||||
|
(option '(#\v "verbosity") #t #f
|
||||||
|
(lambda (opt name arg result)
|
||||||
|
(let ((level (string->number* arg)))
|
||||||
|
(alist-cons 'verbosity level
|
||||||
|
(alist-delete 'verbosity result)))))
|
||||||
|
|
||||||
%standard-build-options))
|
%standard-build-options))
|
||||||
|
|
||||||
(define %default-options
|
(define %default-options
|
||||||
|
@ -87,10 +96,12 @@ Perform the deployment specified by FILE.\n"))
|
||||||
(define (guix-deploy . args)
|
(define (guix-deploy . args)
|
||||||
(define (handle-argument arg result)
|
(define (handle-argument arg result)
|
||||||
(alist-cons 'file arg result))
|
(alist-cons 'file arg result))
|
||||||
|
|
||||||
(let* ((opts (parse-command-line args %options (list %default-options)
|
(let* ((opts (parse-command-line args %options (list %default-options)
|
||||||
#:argument-handler handle-argument))
|
#:argument-handler handle-argument))
|
||||||
(file (assq-ref opts 'file))
|
(file (assq-ref opts 'file))
|
||||||
(machines (or (and file (load-source-file file)) '())))
|
(machines (or (and file (load-source-file file)) '())))
|
||||||
|
(with-status-verbosity (assoc-ref opts 'verbosity)
|
||||||
(with-store store
|
(with-store store
|
||||||
(set-build-options-from-command-line store opts)
|
(set-build-options-from-command-line store opts)
|
||||||
(for-each (lambda (machine)
|
(for-each (lambda (machine)
|
||||||
|
@ -108,4 +119,4 @@ Perform the deployment specified by FILE.\n"))
|
||||||
(run-with-store store (roll-back-machine machine)))
|
(run-with-store store (roll-back-machine machine)))
|
||||||
(apply throw (deploy-error-captured-args c))))
|
(apply throw (deploy-error-captured-args c))))
|
||||||
(run-with-store store (deploy-machine machine)))))
|
(run-with-store store (deploy-machine machine)))))
|
||||||
machines))))
|
machines)))))
|
||||||
|
|
Loading…
Reference in New Issue