guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

01/02: guix build: Add '--quiet'.


From: Ludovic Courtès
Subject: 01/02: guix build: Add '--quiet'.
Date: Tue, 08 Mar 2016 22:33:06 +0000

civodul pushed a commit to branch master
in repository guix.

commit 5284339d9d31c97146d92ee3f860ba5c70b77c46
Author: Ludovic Courtès <address@hidden>
Date:   Tue Mar 8 22:00:17 2016 +0100

    guix build: Add '--quiet'.
    
    Fixes <http://bugs.gnu.org/19772>.
    Reported by Andrei Osipov <address@hidden>.
    
    * 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.
---
 doc/guix.texi          |    8 +++-
 guix/scripts/build.scm |  100 +++++++++++++++++++++++++++---------------------
 2 files changed, 63 insertions(+), 45 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 0e8e5ad..7945415 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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
 
address@hidden --quiet
address@hidden -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 address@hidden
 @itemx -f @var{file}
 
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 3607d78..b25bf50 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -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))))))))))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]