~ruther/guix-local

5284339d9d31c97146d92ee3f860ba5c70b77c46 — Ludovic Courtès 10 years ago efb107e
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.
2 files changed, 63 insertions(+), 45 deletions(-)

M doc/guix.texi
M guix/scripts/build.scm
M doc/guix.texi => doc/guix.texi +7 -1
@@ 3836,7 3836,7 @@ guix build emacs guile
Similarly, the following command builds all the available packages:

@example
guix build --keep-going \
guix build --quiet --keep-going \
  `guix package -A | cut -f1,2 --output-delimiter=@@`
@end example



@@ 4070,6 4070,12 @@ build}.

@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}
@itemx -f @var{file}


M guix/scripts/build.scm => guix/scripts/build.scm +56 -44
@@ 467,6 467,8 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
  -r, --root=FILE        make FILE a symlink to the result, and register it
                         as a garbage collector root"))
  (display (_ "
  -q, --quiet            do not show the build log"))
  (display (_ "
      --log-file         return the log file names for the given derivations"))
  (newline)
  (show-build-options-help)


@@ 534,6 536,9 @@ must be one of 'package', 'all', or 'transitive'~%")
         (option '(#\r "root") #t #f
                 (lambda (opt name 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
                 (lambda (opt name arg result)
                   (alist-cons 'log-file? #t result)))


@@ 638,6 643,9 @@ needed."
    (parse-command-line args %options
                        (list %default-options)))

  (define quiet?
    (assoc-ref opts 'quiet?))

  (with-error-handling
    ;; Ask for absolute file names so that .drv file names passed from the
    ;; user to 'read-derivation' are absolute when it returns.


@@ 646,47 654,51 @@ needed."
        ;; Set the build options before we do anything else.
        (set-build-options-from-command-line store opts)

        (let* ((mode  (assoc-ref opts 'build-mode))
               (drv   (options->derivations store opts))
               (urls  (map (cut string-append <> "/log")
                           (if (assoc-ref opts 'substitutes?)
                               (or (assoc-ref opts 'substitute-urls)
                                   ;; XXX: This does not necessarily match the
                                   ;; daemon's substitute URLs.
                                   %default-substitute-urls)
                               '())))
               (items (filter-map (match-lambda
                                    (('argument . (? store-path? file))
                                     file)
                                    (_ #f))
                                  opts))
               (roots (filter-map (match-lambda
                                    (('gc-root . root) root)
                                    (_ #f))
                                  opts)))

          (unless (assoc-ref opts 'log-file?)
            (show-what-to-build store drv
                                #:use-substitutes? (assoc-ref opts 'substitutes?)
                                #:dry-run? (assoc-ref opts 'dry-run?)
                                #:mode mode))

          (cond ((assoc-ref opts 'log-file?)
                 (for-each (cut show-build-log store <> urls)
                           (delete-duplicates
                            (append (map derivation-file-name drv)
                                    items))))
                ((assoc-ref opts 'derivations-only?)
                 (format #t "~{~a~%~}" (map derivation-file-name drv))
                 (for-each (cut register-root store <> <>)
                           (map (compose list derivation-file-name) drv)
                           roots))
                ((not (assoc-ref opts 'dry-run?))
                 (and (build-derivations store drv mode)
                      (for-each show-derivation-outputs drv)
                      (for-each (cut register-root store <> <>)
                                (map (lambda (drv)
                                       (map cdr
                                            (derivation->output-paths drv)))
                                     drv)
                                roots)))))))))
        (parameterize ((current-build-output-port (if quiet?
                                                      (%make-void-port "w")
                                                      (current-error-port))))
          (let* ((mode  (assoc-ref opts 'build-mode))
                 (drv   (options->derivations store opts))
                 (urls  (map (cut string-append <> "/log")
                             (if (assoc-ref opts 'substitutes?)
                                 (or (assoc-ref opts 'substitute-urls)
                                     ;; XXX: This does not necessarily match the
                                     ;; daemon's substitute URLs.
                                     %default-substitute-urls)
                                 '())))
                 (items (filter-map (match-lambda
                                      (('argument . (? store-path? file))
                                       file)
                                      (_ #f))
                                    opts))
                 (roots (filter-map (match-lambda
                                      (('gc-root . root) root)
                                      (_ #f))
                                    opts)))

            (unless (assoc-ref opts 'log-file?)
              (show-what-to-build store drv
                                  #:use-substitutes?
                                  (assoc-ref opts 'substitutes?)
                                  #:dry-run? (assoc-ref opts 'dry-run?)
                                  #:mode mode))

            (cond ((assoc-ref opts 'log-file?)
                   (for-each (cut show-build-log store <> urls)
                             (delete-duplicates
                              (append (map derivation-file-name drv)
                                      items))))
                  ((assoc-ref opts 'derivations-only?)
                   (format #t "~{~a~%~}" (map derivation-file-name drv))
                   (for-each (cut register-root store <> <>)
                             (map (compose list derivation-file-name) drv)
                             roots))
                  ((not (assoc-ref opts 'dry-run?))
                   (and (build-derivations store drv mode)
                        (for-each show-derivation-outputs drv)
                        (for-each (cut register-root store <> <>)
                                  (map (lambda (drv)
                                         (map cdr
                                              (derivation->output-paths drv)))
                                       drv)
                                  roots))))))))))