GNU bug report logs - #60408
[PATCH wip] guix: Support showing status in parallel.

Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.

Package: guix-patches; Reported by: Julien Lepiller <julien@HIDDEN>; Keywords: patch; dated Thu, 29 Dec 2022 18:43:02 UTC; Maintainer for guix-patches is guix-patches@HIDDEN.

Message received at submit <at> debbugs.gnu.org:


Received: (at submit) by debbugs.gnu.org; 29 Dec 2022 18:42:49 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Thu Dec 29 13:42:49 2022
Received: from localhost ([127.0.0.1]:32852 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1pAxrc-00087y-2s
	for submit <at> debbugs.gnu.org; Thu, 29 Dec 2022 13:42:49 -0500
Received: from lists.gnu.org ([209.51.188.17]:59066)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <julien@HIDDEN>) id 1pAxrY-00087p-UU
 for submit <at> debbugs.gnu.org; Thu, 29 Dec 2022 13:42:46 -0500
Received: from eggs.gnu.org ([2001:470:142:3::10])
 by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <julien@HIDDEN>)
 id 1pAxrY-0007w3-6n
 for guix-patches@HIDDEN; Thu, 29 Dec 2022 13:42:44 -0500
Received: from lepiller.eu ([2a00:5884:8208::1])
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <julien@HIDDEN>)
 id 1pAxrU-0006iW-UH
 for guix-patches@HIDDEN; Thu, 29 Dec 2022 13:42:43 -0500
Received: from lepiller.eu (localhost [127.0.0.1])
 by lepiller.eu (OpenSMTPD) with ESMTP id da4e5937
 for <guix-patches@HIDDEN>; Thu, 29 Dec 2022 18:42:31 +0000 (UTC)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed; d=lepiller.eu; h=date:from
 :to:subject:message-id:mime-version:content-type; s=dkim; bh=11L
 AcLwX5WV2Sa1J1RtrT3tTg0Ywy/ZXSdMsNszpC0A=; b=iUFRNjPwZscRvbns+HS
 v3NoJ1xUud0SDPTgUAssKmxlcMRUuCrNKI7heyS6h23uSBbT79DMiZ4nJe+XBW7E
 Bez1GgrJooYWIpgl7ez1uHR+BRyiH6FwGj0EGNyoVaFxYWA2iw6bG/vvXIzYl3lC
 /11lhgesgTjiDtbZJAGYyC/EiLmTo6KmYZlP1unSFXTFQUlOkMlBn2GFt4+r+qtS
 gmjrunoeZ34pXcbmbQecBnCvhrUmXPBjA2BHbap3TrraXGMulACnRRaxL2Dn6UvR
 48QVcFXPFYCKWogHHNGwUkg3FhvcWvo9QnmQ8sj5mkbgUsxxzfB8SObqqoxFToOF
 X0g==
Received: by lepiller.eu (OpenSMTPD) with ESMTPSA id a17d1b78
 (TLSv1.3:AEAD-AES256-GCM-SHA384:256:NO) for <guix-patches@HIDDEN>;
 Thu, 29 Dec 2022 18:42:30 +0000 (UTC)
Date: Thu, 29 Dec 2022 19:42:12 +0100
From: Julien Lepiller <julien@HIDDEN>
To: guix-patches@HIDDEN
Subject: [PATCH wip] guix: Support showing status in parallel.
Message-ID: <20221229194212.44e5cabf@HIDDEN>
X-Mailer: Claws Mail 4.1.1 (GTK 3.24.30; x86_64-pc-linux-gnu)
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="MP_/3mhdKAe/CGQI_cITvmS0eBI"
Received-SPF: pass client-ip=2a00:5884:8208::1;
 envelope-from=julien@HIDDEN; helo=lepiller.eu
X-Spam_score_int: -20
X-Spam_score: -2.1
X-Spam_bar: --
X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1,
 DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, SPF_HELO_PASS=-0.001,
 SPF_PASS=-0.001 autolearn=ham autolearn_force=no
X-Spam_action: no action
X-Spam-Score: -1.3 (-)
X-Debbugs-Envelope-To: submit
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -2.3 (--)

--MP_/3mhdKAe/CGQI_cITvmS0eBI
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: quoted-printable
Content-Disposition: inline

Hi Guix!

The attached patch allows showing more detailed status in parallel.
One of the reasons for doing that is for supporting another of my
patches, that allows specifying download tasks and build tasks numbers
separately, with a default of 1 for each (so 2 tasks in parallel by
default).

With verbosity level 2, all messages from all builds are shown
(interleaved, obviously), and messages for other levels are the same.

When only one build is performed, no changes are visible.

When multiple builds are happening in parallel, this patch shows one
line per running job (whether build or download), and messages above.
This will look like this:

module-import-compiled.drv  75% =E2=96=95=E2=96=88=E2=96=88=E2=96=88=E2=96=
=88=E2=96=88=E2=96=88=E2=96=88=E2=96=88=E2=96=88=E2=96=88=E2=96=88=E2=96=88=
=E2=96=88=E2=96=88=E2=96=88=E2=96=88=E2=96=88=E2=96=88=E2=96=88=E2=96=88=E2=
=96=88=E2=96=88=E2=96=88=E2=96=88=E2=96=88            =E2=96=8F
openjdk-9.181-jdk  337.6MiB 4.3MiB/s 00:07 =E2=96=95=E2=96=88=E2=96=8C     =
           =E2=96=8F   8.8%


If there is no progress lines in the output of a build, it doesn't show
a spinner (yet), so no feedback that something is happening, but that's
planned for v2. One other issue is probably caused by having lots of
events (caused by build log output), that make status lines blink.
Another issue is when you ^C, the cursor is on the first status line.

My ideas for this patch are:

First, it's possible to go back a few lines with an ANSI escape code,
so basically print all status lines, then go back to the first line.

When an even needs to print a new line, let it do it from the first
status line, and print the status lines from below it.

Sometimes, an event will contain an incomplete line (for instance, it
ends with \r instead of \n), so I want to record the line to prevent it
from being overwritten by a status line. It's printed together with the
status lines, so we can go back to that line and print the rest of the
line when we get more of it.


Thoughts, ideas?

--MP_/3mhdKAe/CGQI_cITvmS0eBI
Content-Type: text/x-patch
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
 filename=0001-guix-Support-showing-status-in-parallel.patch

=46rom c40fc712dec93299657e916907bc603d30178327 Mon Sep 17 00:00:00 2001
Message-Id: <c40fc712dec93299657e916907bc603d30178327.1672338241.git.julien=
@lepiller.eu>
From: Julien Lepiller <julien@HIDDEN>
Date: Thu, 29 Dec 2022 19:20:34 +0100
Subject: [PATCH] guix: Support showing status in parallel.

* guix/status.scm (build-status): Add `last-daemon-line` field.
(build): Add `last-line` and `start` fields.
(update-build): Record partial lines (not ending with \n) in the
last-line field of the new build or status record.
(print-build-event): Always print status of all current builds and
downloads at the end.  Update all status lines.
---
 guix/status.scm | 358 +++++++++++++++++++++++++++++++++---------------
 1 file changed, 245 insertions(+), 113 deletions(-)

diff --git a/guix/status.scm b/guix/status.scm
index 2c69f49fb5..5eb3ebc46b 100644
--- a/guix/status.scm
+++ b/guix/status.scm
@@ -49,6 +49,7 @@ (define-module (guix status)
             build-status-downloading
             build-status-builds-completed
             build-status-downloads-completed
+            build-status-last-daemon-line
=20
             build?
             build
@@ -57,6 +58,8 @@ (define-module (guix status)
             build-log-file
             build-phase
             build-completion
+            build-start
+            build-last-line
=20
             download?
             download
@@ -100,11 +103,13 @@ (define-record-type* <build-status> build-status make=
-build-status
   (builds-completed build-status-builds-completed ;list of <build>
                     (default '()))
   (downloads-completed build-status-downloads-completed ;list of <download>
-                       (default '())))
+                       (default '()))
+  (last-daemon-line build-status-last-daemon-line ;string
+                    (default "")))
=20
 ;; On-going or completed build.
 (define-immutable-record-type <build>
-  (%build derivation id system log-file phase completion)
+  (%build derivation id system log-file phase completion start last-line)
   build?
   (derivation  build-derivation)                ;string (.drv file name)
   (id          build-id)                        ;#f | integer
@@ -113,11 +118,17 @@ (define-immutable-record-type <build>
   (phase       build-phase                      ;#f | symbol
                set-build-phase)
   (completion  build-completion                 ;#f | integer (percentage)
-               set-build-completion))
+               set-build-completion)
+  (start       build-start                      ;<time>
+               set-build-start)
+  (last-line   build-last-line                  ;#f | string
+               set-build-last-line))
=20
-(define* (build derivation system #:key id log-file phase completion)
+(define* (build derivation system #:key id log-file phase completion
+                (start (current-time time-monotonic))
+                (last-line ""))
   "Return a new build."
-  (%build derivation id system log-file phase completion))
+  (%build derivation id system log-file phase completion start last-line))
=20
 ;; On-going or completed downloads.  Downloads can be stem from substitutes
 ;; and from "builtin:download" fixed-output derivations.
@@ -166,6 +177,12 @@ (define %fraction-line-rx
 (define (update-build status id line)
   "Update STATUS based on LINE, a build output line for ID that might cont=
ain
 a completion indication."
+  (define (last-line str)
+    (last (string-split str #\newline)))
+
+  (define (update-last-line build)
+    (set-build-last-line build (last-line (string-append (build-last-line =
build) line))))
+
   (define (find-build)
     (find (lambda (build)
             (and (build-id build)
@@ -173,15 +190,27 @@ (define (update-build status id line)
           (build-status-building status)))
=20
   (define (update %)
-    (let ((build (find-build)))
+    (let ((build (find-build))
+          (new-build (update-last-line (find-build))))
       (build-status
        (inherit status)
-       (building (cons (set-build-completion build %)
+       (building (cons (set-build-completion new-build %)
                        (delq build (build-status-building status)))))))
=20
-  (cond ((string-any #\nul line)
+  (cond ((not id)
+         (build-status
+           (inherit status)
+           (last-daemon-line (string-append (build-status-last-daemon-line=
 status) line))))
+        ((string-any #\nul line)
          ;; Don't try to match a regexp here.
-         status)
+         (let ((build (find-build)))
+           (if build
+               (build-status
+                 (inherit status)
+                 (building
+                   (cons (update-last-line build)
+                         (delq build (build-status-building status)))))
+               status)))
         ((regexp-exec %percentage-line-rx line)
          =3D>
          (lambda (match)
@@ -202,12 +231,20 @@ (define (update-build status id line)
                  (build-status
                   (inherit status)
                   (building
-                   (cons (set-build-phase (set-build-completion build #f)
-                                          (string->symbol phase))
+                   (cons (update-last-line
+                           (set-build-phase (set-build-completion build #f)
+                                            (string->symbol phase)))
                          (delq build (build-status-building status)))))
                  status))))
         (else
-         status)))
+         (let ((build (find-build)))
+           (if build
+               (build-status
+                 (inherit status)
+                 (building
+                   (cons (update-last-line build)
+                         (delq build (build-status-building status)))))
+               status)))))
=20
 (define* (compute-status event status
                          #:key
@@ -436,48 +473,170 @@ (define* (print-build-event event old-status status
   (define tty?
     (isatty?* port))
=20
-  (define (report-build-progress phase %)
-    (let ((% (min (max % 0) 100)))                ;sanitize
-      (erase-current-line port)
-      (let* ((prefix (format #f "~3d% ~@['~a' ~]"
-                            (inexact->exact (round %))
-                            (case phase
-                              ((build) #f)        ;not useful to display it
-                              (else phase))))
-             (length (string-length prefix)))
-        (display prefix port)
-        (display (progress-bar % (- (current-terminal-columns) length))
-                 port))
-      (force-output port)))
+  (define (report-build-progress name phase %)
+    (if %
+      (let ((% (min (max % 0) 100)))                ;sanitize
+        (erase-current-line port)
+        (let* ((prefix (format #f "~a ~3d% ~@['~a' ~]"
+                               (string-join (cdr (string-split (basename n=
ame) #\-)) "-")
+                               (inexact->exact (round %))
+                               (case phase
+                                 ((build) #f)        ;not useful to displa=
y it
+                                 (else phase))))
+               (length (string-length prefix)))
+          (display prefix port)
+          (display (progress-bar % (- (current-terminal-columns) length))
+                   port)
+          (newline port)))
+      (erase-format port "~a=E2=80=A6~%" name))
+    (force-output port))
+
+  (define (find-build id status)
+    (find
+      (lambda (build)
+        (and id (build-id build)
+             (=3D (build-id build) id)))
+      (build-status-building status)))
+
+  (define (get-line id line)
+    (define (remove-last lst)
+      (match lst
+        (() '())
+        ((_) '())
+        ((e lst ...) (cons e (remove-last lst)))))
+
+    (let ((old-build (find-build id old-status)))
+      (cond
+        ((not id)
+         (let ((commited-lines
+                 (remove-last
+                   (string-split (string-append (build-status-last-daemon-=
line old-status) line)
+                                 #\newline))))
+           (if (null? commited-lines)
+               ""
+               (string-append (string-join commited-lines "\n") "\n"))))
+        (old-build
+          (let ((commited-lines
+                  (remove-last
+                    (string-split (string-append (build-last-line old-buil=
d) line)
+                                  #\newline))))
+            (if (null? commited-lines)
+                ""
+                (string-append (string-join commited-lines "\n") "\n"))))
+        (else line))))
=20
   (define print-log-line
-    (if print-log?
-        (if colorize?
-            (lambda (id line)
-              (display (colorize-log-line line) port))
-            (lambda (id line)
-              (display line port)))
-        (lambda (id line)
-          (match (build-status-building status)
-            ((build)                              ;single job
-             (match (build-completion build)
-               ((? number? %)
-                (report-build-progress (build-phase build) %))
-               (_
-                (spin! (build-phase build) port))))
-            (_
-             (spin! #f port))))))
+    (lambda (id line)
+      (print-log-line* (get-line id line))))
+
+  (define (print-log-line* line)
+    (define (print-lines lines)
+      (match lines
+        ((line) (print-line line))
+        ((line lines ...)
+         (print-line (string-append line "\n")))))
+
+    (define (print-line line)
+      (erase-current-line*)
+      (if colorize?
+          (display (colorize-log-line line) port)
+          (display line port)))
+
+    (when print-log?
+      (print-lines (string-split line #\newline))))
=20
   (define erase-current-line*
-    (if (and (not print-log?) (isatty?* port))
+    (if (isatty?* port)
         (lambda ()
           (erase-current-line port)
           (force-output port))
         (const #t)))
=20
+  (define (go-back n)
+    (when (and (isatty?* port) (> n 0))
+      (format port "\r\x1b[~dA" n)))
+
+  (define (build<? build1 build2)
+    (match (list (build-start build1) (build-start build2))
+      ((#f #f) (string<? (build-derivation build1) (build-derivation build=
2)))
+      ((_ #f) #t)
+      ((#f _) #f)
+      ((t1 t2) (time<? t1 t2))))
+
+  (define (download<? download1 download2)
+    (match (list (download-start download1) (download-start download2))
+      ((#f #f) (string<? (download-uri download1) (download-uri download2)=
))
+      ((_ #f) #t)
+      ((#f _) #f)
+      ((t1 t2) (time<? t1 t2))))
+
+  (define (print-progress)
+    (unless (string-null? (build-status-last-daemon-line status))
+      (pk 'daemon-partial (build-status-last-daemon-line status))
+      #;(erase-current-line*)
+      #;(print-log-line* (build-status-last-daemon-line status))
+      #;(newline port))
+
+    (when print-log?
+      (for-each
+        (lambda (build)
+          (unless (or (not (build-last-line build))
+                      (string-null? (build-last-line build)))
+            (erase-current-line*)
+            (print-log-line* (build-last-line build))
+            (newline port)))
+        (sort (build-status-building status)
+              build<?)))
+
+    (for-each
+      (lambda (build)
+        (report-build-progress (build-derivation build) (build-phase build)
+                               (build-completion build)))
+      (sort (build-status-building status)
+            build<?))
+    (for-each
+      (lambda (download)
+        (let ((uri (if (string-contains (download-uri download) "/nar/")
+                       (nar-uri-abbreviation (download-uri download))
+                       (basename (download-uri download)))))
+          (display-download-progress uri (download-size download)
+                                     #:tty? tty?
+                                     #:start-time
+                                     (download-start download)
+                                     #:transferred (download-transferred d=
ownload))
+          (newline port)))
+      (sort (build-status-downloading status)
+            download<?))
+
+    (go-back (+ (length (build-status-building status))
+                (if print-log?
+                    (length (filter
+                              (lambda (build)
+                                (let ((last-line (build-last-line build)))
+                                  (and last-line (not (string-null? last-l=
ine)))))
+                              (build-status-building status)))
+                    0)
+                (length (build-status-downloading status))
+                (if (string-null? (build-status-last-daemon-line status)) =
0 1)))
+    (force-output port))
+
+  (define* (erase-format port msg . args)
+    (define (print-lines lines)
+      (match lines
+        (() #t)
+        ((line)
+         (erase-current-line*)
+         (format port line))
+        ((line lines ...)
+         (erase-current-line*)
+         (format port line)
+         (newline port)
+         (print-lines lines))))
+    (let ((str (apply format #f msg args)))
+      (print-lines (string-split str #\newline))))
+
   (match event
     (('build-started drv . _)
-     (erase-current-line*)
      (let ((properties (derivation-properties
                         (read-derivation-from-file drv))))
        (match (assq-ref properties 'type)
@@ -485,120 +644,91 @@ (define* (print-build-event event old-status status
            (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 ..."
-                                    count))
-                     count
-                     (string-drop-right (store-path-package-name drv)
-                                        (string-length ".drv")))))
+             (erase-format port (info (N_ "applying ~a graft for ~a ..."
+                                      "applying ~a grafts for ~a ..."
+                                      count))
+                           count
+                           (string-drop-right (store-path-package-name drv)
+                                              (string-length ".drv")))))
          ('profile
           (let ((count (match (assq-ref properties 'profile)
                          (#f  0)
                          (lst (or (assq-ref lst 'count) 0)))))
-            (format port (info (N_ "building profile with ~a package..."
-                                   "building profile with ~a packages..."
-                                   count))
-                    count)))
+            (erase-format port (info (N_ "building profile with ~a package=
..."
+                                         "building profile with ~a package=
s..."
+                                         count))
+                          count)))
          ('profile-hook
           (let ((hook-type (assq-ref properties 'hook)))
             (or (and=3D> (hook-message hook-type)
                        (lambda (msg)
                          (display (info msg) port)))
-                (format port (info (G_ "running profile hook of type '~a'.=
.."))
-                        hook-type))))
+                (erase-format port (info (G_ "running profile hook of type=
 '~a'..."))
+                              hook-type))))
          (_
-          (format port (info (G_ "building ~a...")) drv))))
-     (newline port))
+          (erase-format port (info (G_ "building ~a...")) drv)))
+       (newline port)))
     (('build-succeeded drv . _)
-     (erase-current-line*)                      ;erase spinner or progress=
 bar
      (when (or print-log? (not (extended-build-trace-supported?)))
-       (format port (success (G_ "successfully built ~a")) drv)
-       (newline port))
-     (match (build-status-building status)
-       (() #t)
-       (ongoing                                   ;when max-jobs > 1
-        (format port
-                (N_ "The following build is still in progress:~%~{  ~a~%~}=
~%"
-                    "The following builds are still in progress:~%~{  ~a~%=
~}~%"
-                    (length ongoing))
-                (map build-derivation ongoing)))))
+       (erase-format port (success (G_ "successfully built ~a")) drv)
+       (newline port)))
     (('build-failed drv . _)
-     (erase-current-line*)                      ;erase spinner or progress=
 bar
-     (format port (failure (G_ "build of ~a failed")) drv)
+     (erase-format port (failure (G_ "build of ~a failed")) drv)
      (newline port)
      (match (derivation-log-file drv)
        (#f
-        (format port (failure (G_ "Could not find build log for '~a'."))
-                drv))
+        (erase-format port (failure (G_ "Could not find build log for '~a'=
."))
+                      drv)
+        (newline port))
        (log
-        (format port (emph (G_ "View build log at '~a'.")) log)))
-     (newline port))
+        (erase-format port (emph (G_ "View build log at '~a'.")) log)
+        (newline port))))
     (('substituter-started item _ ...)
-     (erase-current-line*)
      (when (or print-log? (not (extended-build-trace-supported?)))
-       (format port (info (G_ "substituting ~a...")) item)
+       (erase-format port (info (G_ "substituting ~a...")) item)
        (newline port)))
     (('download-started item uri _ ...)
      (when print-urls?
-       (erase-current-line*)
-       (format port (info (G_ "downloading from ~a ...")) uri)
+       (erase-format port (info (G_ "downloading from ~a ...")) uri)
        (newline port)))
     (('download-progress item uri
                          (=3D string->number size)
                          (=3D string->number transferred))
-     ;; Print a progress bar, but only if there's only one on-going
-     ;; job--otherwise the output would be intermingled.
-     (when (=3D 1 (simultaneous-jobs status))
-       (match (find (matching-download item)
-                    (build-status-downloading status))
-         (#f #f)                                  ;shouldn't happen!
-         (download
-          ;; XXX: It would be nice to memoize the abbreviation.
-          (let ((uri (if (string-contains uri "/nar/")
-                         (nar-uri-abbreviation uri)
-                         (basename uri))))
-            (display-download-progress uri size
-                                       #:tty? tty?
-                                       #:start-time
-                                       (download-start download)
-                                       #:transferred transferred))))))
+     ;; ignore event, since progress is shown after messages
+     event)
     (('substituter-succeeded item _ ...)
      (when (extended-build-trace-supported?)
-       ;; If there are no jobs running, we already reported download compl=
etion
-       ;; so there's nothing left to do.
-       (unless (zero? (simultaneous-jobs status))
-         (format port (success (G_ "substitution of ~a complete")) item)
-         (newline port))
-
-       (when (and print-urls? (zero? (simultaneous-jobs status)))
-         ;; Leave a blank line after the "downloading ..." line and the
-         ;; progress bar (that's three lines in total).
-         (newline port))))
+       (erase-format port (success (G_ "substitution of ~a complete")) ite=
m)
+       (newline port)))
     (('substituter-failed item _ ...)
-     (format port (failure (G_ "substitution of ~a failed")) item)
+     (erase-format port (failure (G_ "substitution of ~a failed")) item)
      (newline port))
     (('hash-mismatch item algo expected actual _ ...)
      ;; TRANSLATORS: The final string looks like "sha256 hash mismatch for
      ;; /gnu/store/=E2=80=A6-sth:", where "sha256" is the hash algorithm.
-     (format port (failure (G_ "~a hash mismatch for ~a:")) algo item)
+     (erase-format port (failure (G_ "~a hash mismatch for ~a:")) algo ite=
m)
      (newline port)
-     (format port (emph (G_ "\
+     (erase-format port (emph (G_ "\
   expected hash: ~a
   actual hash:   ~a~%"))
-             expected actual))
+             expected actual)
+     (newline port))
     (('build-remote drv host _ ...)
-     (format port (emph (G_ "offloading build of ~a to '~a'")) drv host)
+     (erase-format port (emph (G_ "offloading build of ~a to '~a'")) drv h=
ost)
      (newline port))
     (('build-log pid line)
+     ;(pk 'build-log pid line)
      (if (multiplexed-output-supported?)
          (if (not pid)
              (begin
                ;; LINE comes from the daemon, not from builders.  Let it
-               ;; through.
-               (display line port)
+               ;; through, but only full lines. Partial lines are printed =
in
+               ;; print-progress
+               (erase-format port (get-line pid line))
                (force-output port))
              (print-log-line pid line))
-         (cond ((string-prefix? "substitute: " line)
+         (print-log-line pid line)
+         #;(cond ((string-prefix? "substitute: " line)
                 ;; The daemon prefixes early messages coming with 'guix
                 ;; substitute' with "substitute:".  These are useful ("upd=
ating
                 ;; substitutes from URL"), so let them through.
@@ -612,7 +742,9 @@ (define* (print-build-event event old-status status
                (else
                 (print-log-line pid line)))))
     (_
-     event)))
+     event))
+ =20
+  (print-progress))
=20
 (define* (print-build-event/quiet event old-status status
                                   #:optional
--=20
2.38.1


--MP_/3mhdKAe/CGQI_cITvmS0eBI--




Acknowledgement sent to Julien Lepiller <julien@HIDDEN>:
New bug report received and forwarded. Copy sent to guix-patches@HIDDEN. Full text available.
Report forwarded to guix-patches@HIDDEN:
bug#60408; Package guix-patches. Full text available.
Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.
Last modified: Thu, 29 Dec 2022 18:45:02 UTC

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997 nCipher Corporation Ltd, 1994-97 Ian Jackson.