From dc0f74e5fc26977a3ee6c4f2aa74a141f4359982 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 18 Jan 2017 23:21:29 +0100
Subject: Add (guix status) and use it for pretty colored output.

* guix/progress.scm (progress-reporter/trace): New procedure.
(%progress-interval): New variable.
(progress-reporter/file): Use it.
* guix/scripts/build.scm (set-build-options-from-command-line): Pass
 #:print-extended-build-trace?.
(%default-options): Add 'print-extended-build-trace?'.
(guix-build): Parameterize CURRENT-TERMINAL-COLUMNS.  Use
'build-status-updater'.
* guix/scripts/environment.scm (%default-options): Add
'print-extended-build-trace?'.
(guix-environment): Wrap body in 'with-status-report'.
* guix/scripts/pack.scm (%default-options): Add 'print-build-trace?' and
'print-extended-build-trace?'.
(guix-pack): Wrap body in 'with-status-report'.
* guix/scripts/package.scm (%default-options, guix-package): Likewise.
* guix/scripts/system.scm (%default-options, guix-system): Likewise.
* guix/scripts/pull.scm (%default-options, guix-pull): Likewise.
* guix/scripts/substitute.scm (progress-report-port): Don't call STOP
when TOTAL is zero.
(process-substitution): Add #:print-build-trace? and honor it.
(guix-substitute)[print-build-trace?]: New variable.
Pass #:print-build-trace? to 'process-substitution'.
* guix/status.scm: New file.
* guix/store.scm (set-build-options): Add #:print-extended-build-trace?;
pass it into PAIRS.
(%protocol-version): Bump.
(protocol-version, nix-server-version): New procedures.
(current-store-protocol-version): New variable.
(with-store, build-things): Parameterize it.
* guix/ui.scm (build-output-port): Remove.
(colorize-string): Export.
* po/guix/POTFILES.in: Add guix/status.scm.
* tests/status.scm: New file.
* Makefile.am (SCM_TESTS): Add it.
* nix/libstore/worker-protocol.hh (PROTOCOL_VERSION): Bump to 0x162.
* nix/libstore/build.cc (DerivationGoal::registerOutputs)
(SubstitutionGoal::finished): Print a "@ hash-mismatch" trace before
throwing.
---
 guix/progress.scm | 38 +++++++++++++++++++++++++++++++++++---
 1 file changed, 35 insertions(+), 3 deletions(-)

(limited to 'guix/progress.scm')

diff --git a/guix/progress.scm b/guix/progress.scm
index d4ebb32991..3b9ff408cd 100644
--- a/guix/progress.scm
+++ b/guix/progress.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Sou Bunnbu <iyzsong@gmail.com>
 ;;; Copyright © 2015 Steve Sprang <scs@stevesprang.com>
-;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -38,8 +38,11 @@
             progress-reporter/silent
             progress-reporter/file
             progress-reporter/bar
+            progress-reporter/trace
 
             display-download-progress
+            erase-current-line
+            progress-bar
             byte-count->string
             current-terminal-columns
 
@@ -220,6 +223,10 @@ throughput."
                  log-port)
         (force-output log-port))))
 
+(define %progress-interval
+  ;; Default interval between subsequent outputs for rate-limited displays.
+  (make-time time-monotonic 200000000 0))
+
 (define* (progress-reporter/file file size
                                  #:optional (log-port (current-output-port))
                                  #:key (abbreviation basename))
@@ -238,8 +245,7 @@ ABBREVIATION used to shorten FILE for display."
      (start render)
      ;; Report the progress every 300ms or longer.
      (report
-      (let ((rate-limited-render
-             (rate-limited render (make-time time-monotonic 300000000 0))))
+      (let ((rate-limited-render (rate-limited render %progress-interval)))
         (lambda (value)
           (set! transferred value)
           (rate-limited-render))))
@@ -279,6 +285,32 @@ tasks is performed.  Write PREFIX at the beginning of the line."
              (newline port))
            (force-output port)))))
 
+(define* (progress-reporter/trace file url size
+                                  #:optional (log-port (current-output-port)))
+  "Like 'progress-reporter/file', but instead of returning human-readable
+progress reports, write \"build trace\" lines to be processed elsewhere."
+  (define (report-progress transferred)
+    (define message
+      (format #f "@ download-progress ~a ~a ~a ~a~%"
+              file url (or size "-") transferred))
+
+    (display message log-port)                    ;should be atomic
+    (flush-output-port log-port))
+
+  (progress-reporter
+   (start (lambda ()
+            (display (format #f "@ download-started ~a ~a ~a~%"
+                             file url (or size "-"))
+                     log-port)))
+   (report (rate-limited report-progress %progress-interval))
+   (stop (lambda ()
+           (report-progress size)
+           (display (format #f "@ download-succeeded ~a ~a ~a~%"
+                            file url
+                            (or (and=> (stat file #f) stat:size)
+                                size))
+                    log-port)))))
+
 ;; TODO: replace '(@ (guix build utils) dump-port))'.
 (define* (dump-port* in out
                      #:key (buffer-size 16384)
-- 
cgit v1.2.3