channels: Build user channels with '-O1'.

[jackhill/guix/guix.git] / guix / status.scm

diff --git a/guix/status.scm b/guix/status.scm
index 4b2edc2..362ae28 100644 (file)
--- a/guix/status.scm
+++ b/guix/status.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -23,8 +23,7 @@
   #:use-module (guix colors)
   #:use-module (guix progress)
   #:autoload   (guix build syscalls) (terminal-columns)
-  #:use-module ((guix build download)
-                #:select (nar-uri-abbreviation))
+  #:autoload   (guix build download) (nar-uri-abbreviation)
   #:use-module (guix store)
   #:use-module (guix derivations)
   #:use-module (guix memoization)
@@ -404,10 +403,12 @@ the current build phase."
                             #:optional (port (current-error-port))
                             #:key
                             (colorize? (color-output? port))
+                            (print-urls? #t)
                             (print-log? #t))
   "Print information about EVENT and STATUS to PORT.  When COLORIZE? is true,
 produce colorful output.  When PRINT-LOG? is true, display the build log in
-addition to build events."
+addition to build events.  When PRINT-URLS? is true, display the URL of
+substitutes being downloaded."
   (define info
     (if colorize?
         (cute colorize-string <> (color BOLD))
@@ -423,6 +424,9 @@ addition to build events."
         (cute colorize-string <> (color RED BOLD))
         identity))
 
+  (define tty?
+    (isatty?* port))
+
   (define (report-build-progress phase %)
     (let ((% (min (max % 0) 100)))                ;sanitize
       (erase-current-line port)
@@ -472,8 +476,8 @@ addition to build events."
            (let ((count (match (assq-ref properties 'graft)
                           (#f  0)
                           (lst (or (assq-ref lst 'count) 0)))))
-             (format port (info (N_ "applying ~a graft for ~a..."
-                                    "applying ~a grafts for ~a..."
+             (format port (info (N_ "applying ~a graft for ~a ..."
+                                    "applying ~a grafts for ~a ..."
                                     count))
                      count drv)))
          ('profile
@@ -524,9 +528,10 @@ addition to build events."
        (format port (info (G_ "substituting ~a...")) item)
        (newline port)))
     (('download-started item uri _ ...)
-     (erase-current-line*)
-     (format port (info (G_ "downloading from ~a...")) uri)
-     (newline port))
+     (when print-urls?
+       (erase-current-line*)
+       (format port (info (G_ "downloading from ~a ...")) uri)
+       (newline port)))
     (('download-progress item uri
                          (= string->number size)
                          (= string->number transferred))
@@ -542,6 +547,7 @@ addition to build events."
                          (nar-uri-abbreviation uri)
                          (basename uri))))
             (display-download-progress uri size
+                                       #:tty? tty?
                                        #:start-time
                                        (download-start download)
                                        #:transferred transferred))))))
@@ -599,6 +605,17 @@ addition to build events."
                                   (colorize? (color-output? port)))
   (print-build-event event old-status status port
                      #:colorize? colorize?
+                     #:print-urls? #f
+                     #:print-log? #f))
+
+(define* (print-build-event/quiet-with-urls event old-status status
+                                            #:optional
+                                            (port (current-error-port))
+                                            #:key
+                                            (colorize? (color-output? port)))
+  (print-build-event event old-status status port
+                     #:colorize? colorize?
+                     #:print-urls? #t             ;show download URLs
                      #:print-log? #f))
 
 (define* (build-status-updater #:optional (on-change (const #t)))
@@ -784,6 +801,7 @@ evaluate EXP... in that context."
   "Return the logging procedure that corresponds to LEVEL."
   (cond ((<= level 0) (const #t))
         ((= level 1)  print-build-event/quiet)
+        ((= level 2)  print-build-event/quiet-with-urls)
         (else         print-build-event)))
 
 (define (call-with-status-verbosity level thunk)