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:
Ludovic Courtès 2019-09-23 11:57:39 +02:00
parent 90ca791ab0
commit b69ce8a872
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 29 additions and 18 deletions

View File

@ -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)))))