guix build: Add '--quiet'.

Fixes <http://bugs.gnu.org/19772>.
Reported by Andrei Osipov <andrspv@gmail.com>.

* guix/scripts/build.scm (show-help, %options): Add --quiet.
(guix-build): Parameterize 'current-build-output-port' accordingly.
* doc/guix.texi (Invoking guix build): Use it in example.
(Additional Build Options): Document it.
This commit is contained in:
Ludovic Courtès 2016-03-08 22:00:17 +01:00
parent efb107e0cd
commit 5284339d9d
2 changed files with 61 additions and 43 deletions

View File

@ -3836,7 +3836,7 @@ guix build emacs guile
Similarly, the following command builds all the available packages: Similarly, the following command builds all the available packages:
@example @example
guix build --keep-going \ guix build --quiet --keep-going \
`guix package -A | cut -f1,2 --output-delimiter=@@` `guix package -A | cut -f1,2 --output-delimiter=@@`
@end example @end example
@ -4070,6 +4070,12 @@ build}.
@table @code @table @code
@item --quiet
@itemx -q
Build quietly, without displaying the build log. Upon completion, the
build log is kept in @file{/var} (or similar) and can always be
retrieved using the @option{--log-file} option.
@item --file=@var{file} @item --file=@var{file}
@itemx -f @var{file} @itemx -f @var{file}

View File

@ -466,6 +466,8 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(display (_ " (display (_ "
-r, --root=FILE make FILE a symlink to the result, and register it -r, --root=FILE make FILE a symlink to the result, and register it
as a garbage collector root")) as a garbage collector root"))
(display (_ "
-q, --quiet do not show the build log"))
(display (_ " (display (_ "
--log-file return the log file names for the given derivations")) --log-file return the log file names for the given derivations"))
(newline) (newline)
@ -534,6 +536,9 @@ must be one of 'package', 'all', or 'transitive'~%")
(option '(#\r "root") #t #f (option '(#\r "root") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'gc-root arg result))) (alist-cons 'gc-root arg result)))
(option '(#\q "quiet") #f #f
(lambda (opt name arg result)
(alist-cons 'quiet? #t result)))
(option '("log-file") #f #f (option '("log-file") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'log-file? #t result))) (alist-cons 'log-file? #t result)))
@ -638,6 +643,9 @@ needed."
(parse-command-line args %options (parse-command-line args %options
(list %default-options))) (list %default-options)))
(define quiet?
(assoc-ref opts 'quiet?))
(with-error-handling (with-error-handling
;; Ask for absolute file names so that .drv file names passed from the ;; Ask for absolute file names so that .drv file names passed from the
;; user to 'read-derivation' are absolute when it returns. ;; user to 'read-derivation' are absolute when it returns.
@ -646,47 +654,51 @@ needed."
;; Set the build options before we do anything else. ;; Set the build options before we do anything else.
(set-build-options-from-command-line store opts) (set-build-options-from-command-line store opts)
(let* ((mode (assoc-ref opts 'build-mode)) (parameterize ((current-build-output-port (if quiet?
(drv (options->derivations store opts)) (%make-void-port "w")
(urls (map (cut string-append <> "/log") (current-error-port))))
(if (assoc-ref opts 'substitutes?) (let* ((mode (assoc-ref opts 'build-mode))
(or (assoc-ref opts 'substitute-urls) (drv (options->derivations store opts))
;; XXX: This does not necessarily match the (urls (map (cut string-append <> "/log")
;; daemon's substitute URLs. (if (assoc-ref opts 'substitutes?)
%default-substitute-urls) (or (assoc-ref opts 'substitute-urls)
'()))) ;; XXX: This does not necessarily match the
(items (filter-map (match-lambda ;; daemon's substitute URLs.
(('argument . (? store-path? file)) %default-substitute-urls)
file) '())))
(_ #f)) (items (filter-map (match-lambda
opts)) (('argument . (? store-path? file))
(roots (filter-map (match-lambda file)
(('gc-root . root) root) (_ #f))
(_ #f)) opts))
opts))) (roots (filter-map (match-lambda
(('gc-root . root) root)
(_ #f))
opts)))
(unless (assoc-ref opts 'log-file?) (unless (assoc-ref opts 'log-file?)
(show-what-to-build store drv (show-what-to-build store drv
#:use-substitutes? (assoc-ref opts 'substitutes?) #:use-substitutes?
#:dry-run? (assoc-ref opts 'dry-run?) (assoc-ref opts 'substitutes?)
#:mode mode)) #:dry-run? (assoc-ref opts 'dry-run?)
#:mode mode))
(cond ((assoc-ref opts 'log-file?) (cond ((assoc-ref opts 'log-file?)
(for-each (cut show-build-log store <> urls) (for-each (cut show-build-log store <> urls)
(delete-duplicates (delete-duplicates
(append (map derivation-file-name drv) (append (map derivation-file-name drv)
items)))) items))))
((assoc-ref opts 'derivations-only?) ((assoc-ref opts 'derivations-only?)
(format #t "~{~a~%~}" (map derivation-file-name drv)) (format #t "~{~a~%~}" (map derivation-file-name drv))
(for-each (cut register-root store <> <>) (for-each (cut register-root store <> <>)
(map (compose list derivation-file-name) drv) (map (compose list derivation-file-name) drv)
roots)) roots))
((not (assoc-ref opts 'dry-run?)) ((not (assoc-ref opts 'dry-run?))
(and (build-derivations store drv mode) (and (build-derivations store drv mode)
(for-each show-derivation-outputs drv) (for-each show-derivation-outputs drv)
(for-each (cut register-root store <> <>) (for-each (cut register-root store <> <>)
(map (lambda (drv) (map (lambda (drv)
(map cdr (map cdr
(derivation->output-paths drv))) (derivation->output-paths drv)))
drv) drv)
roots))))))))) roots))))))))))