guix-patches
[Top][All Lists]
Advanced

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

[bug#45146] [PATCH] scripts: substitute: Improve fetch-narinfos progress


From: Christopher Baines
Subject: [bug#45146] [PATCH] scripts: substitute: Improve fetch-narinfos progress reporting.
Date: Wed, 9 Dec 2020 18:57:59 +0000

At least in guix weather, these changes make the progress bar actually appear.

* guix/scripts/substitute.scm (fetch-narinfos): Use (guix progress) for
progress reporting.
---
 guix/scripts/substitute.scm | 18 +++++-------------
 1 file changed, 5 insertions(+), 13 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 25075eedff..5128310439 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -614,16 +614,8 @@ print a warning and return #f."
 
 (define (fetch-narinfos url paths)
   "Retrieve all the narinfos for PATHS from the cache at URL and return them."
-  (define update-progress!
-    (let ((done 0)
-          (total (length paths)))
-      (lambda ()
-        (display "\r\x1b[K" (current-error-port)) ;erase current line
-        (force-output (current-error-port))
-        (format (current-error-port)
-                (G_ "updating substitutes from '~a'... ~5,1f%")
-                url (* 100. (/ done total)))
-        (set! done (+ 1 done)))))
+  (define fetch-narinfos-progress-reporter
+    (progress-reporter/bar (length paths)))
 
   (define hash-part->path
     (let ((mapping (fold (lambda (path result)
@@ -641,7 +633,7 @@ print a warning and return #f."
            (len    (response-content-length response))
            (cache  (response-cache-control response))
            (ttl    (and cache (assoc-ref cache 'max-age))))
-      (update-progress!)
+      (progress-reporter-report! fetch-narinfos-progress-reporter)
 
       ;; Make sure to read no more than LEN bytes since subsequent bytes may
       ;; belong to the next response.
@@ -673,7 +665,7 @@ print a warning and return #f."
            (#f
             '())
            (port
-            (update-progress!)
+            (start-progress-reporter! fetch-narinfos-progress-reporter)
             ;; Note: Do not check HTTPS server certificates to avoid depending
             ;; on the X.509 PKI.  We can do it because we authenticate
             ;; narinfos, which provides a much stronger guarantee.
@@ -683,7 +675,7 @@ print a warning and return #f."
                                              #:verify-certificate? #f
                                              #:port port)))
               (close-port port)
-              (newline (current-error-port))
+              (stop-progress-reporter! fetch-narinfos-progress-reporter)
               result)))))
       ((file #f)
        (let* ((base  (string-append (uri-path uri) "/"))
-- 
2.29.2






reply via email to

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