* [bug#32837] [PATCH 0/5] Improvements to the UI with colors
@ 2018-09-25 15:11 Ludovic Courtès
2018-09-25 15:32 ` [bug#32837] [PATCH 1/5] progress: 'progress-reporter-report!' takes any number of arguments Ludovic Courtès
2018-09-27 9:59 ` [bug#32837] [PATCH 0/5] Improvements to the UI with colors Ludovic Courtès
0 siblings, 2 replies; 12+ messages in thread
From: Ludovic Courtès @ 2018-09-25 15:11 UTC (permalink / raw)
To: 32837; +Cc: Ricardo Wurmus
Hello Guix!
This is a followup to the UI work by Sahithi and Ricardo:
https://issues.guix.info/issue/32634
The output of ‘guix build’ is almost the same as on ‘master’.
The main difference is for ‘guix package’: downloads URLs are
now displayed, “updating substitutes from URL” messages and
download progress bars are back, both for substitutes and for
‘url-fetch’ kind of downloads, and max-jobs > 1 is reasonably
well handled. Upon failure the file name of the build log
is printed.
‘guix pack’ and ‘guix environment’ produce output similar to
that of ‘guix build’ (that is, build logs are shown.) ‘guix system
{init,reconfigure}’ produce concise output similar to ‘guix package’.
Other ‘guix system’ sub-commands produce verbose output like
‘guix build’.
Internally everything is handled by the (guix status) module.
This module keeps track of the on-going and completed builds and
downloads (substitutes and fixed-output derivations.) To do that
the build side is modified to print additional machine-readable
“build traces” (with the new #:print-extended-build-traces? option
of ‘set-build-options’.)
Old clients talking to the new daemon won’t see the difference
because build-side code will produce the same output as before.
New clients talking to an old daemon won’t be able to display
progress bars and URLs for downloads because the build side
won’t produce those “extended build traces”; IOW, it should be
as on current ‘master’.
It would be great if people could give it a try and report back!
You’ll have to run:
guix pull --branch=wip-ui
and then you can try building things with and without substitutes,
with ‘guix package’, with ‘guix build’, etc.
If we agree on the mechanism, then we can always fine-tune the
output later.
Thanks,
Ludo’.
Ludovic Courtès (5):
progress: 'progress-reporter-report!' takes any number of arguments.
substitute: Progress port really closes underlying port.
progress: Add 'display-download-progress'.
Add (guix status) and use it for pretty colored output.
perform-download: Optionally report a "download-progress" trace.
.dir-locals.el | 1 +
Makefile.am | 2 +
guix/build/download.scm | 31 +-
guix/progress.scm | 106 ++++---
guix/scripts/build.scm | 15 +-
guix/scripts/environment.scm | 110 +++----
guix/scripts/pack.scm | 140 ++++-----
guix/scripts/package.scm | 24 +-
guix/scripts/perform-download.scm | 17 +-
guix/scripts/substitute.scm | 44 ++-
guix/scripts/system.scm | 11 +-
guix/status.scm | 463 ++++++++++++++++++++++++++++++
guix/store.scm | 14 +-
guix/ui.scm | 108 +------
nix/libstore/builtins.cc | 5 +-
po/guix/POTFILES.in | 1 +
tests/status.scm | 115 ++++++++
17 files changed, 901 insertions(+), 306 deletions(-)
create mode 100644 guix/status.scm
create mode 100644 tests/status.scm
--
2.19.0
^ permalink raw reply [flat|nested] 12+ messages in thread
* [bug#32837] [PATCH 1/5] progress: 'progress-reporter-report!' takes any number of arguments.
2018-09-25 15:11 [bug#32837] [PATCH 0/5] Improvements to the UI with colors Ludovic Courtès
@ 2018-09-25 15:32 ` Ludovic Courtès
2018-09-25 15:32 ` [bug#32837] [PATCH 2/5] substitute: Progress port really closes underlying port Ludovic Courtès
` (4 more replies)
2018-09-27 9:59 ` [bug#32837] [PATCH 0/5] Improvements to the UI with colors Ludovic Courtès
1 sibling, 5 replies; 12+ messages in thread
From: Ludovic Courtès @ 2018-09-25 15:32 UTC (permalink / raw)
To: 32837; +Cc: Ricardo Wurmus
* guix/progress.scm (progress-reporter-report!): Accept an arbitrary
number of arguments and pass them to REPORT.
---
guix/progress.scm | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/guix/progress.scm b/guix/progress.scm
index c9c3cd12a..53aea1c56 100644
--- a/guix/progress.scm
+++ b/guix/progress.scm
@@ -70,11 +70,11 @@ stopped."
(($ <progress-reporter> start report stop)
(start))))
-(define (progress-reporter-report! reporter)
+(define (progress-reporter-report! reporter . args)
"Low-level procedure to lead REPORTER to emit a report."
(match reporter
(($ <progress-reporter> start report stop)
- (report))))
+ (apply report args))))
(define (stop-progress-reporter! reporter)
"Low-level procedure to stop REPORTER."
--
2.19.0
^ permalink raw reply related [flat|nested] 12+ messages in thread
* [bug#32837] [PATCH 2/5] substitute: Progress port really closes underlying port.
2018-09-25 15:32 ` [bug#32837] [PATCH 1/5] progress: 'progress-reporter-report!' takes any number of arguments Ludovic Courtès
@ 2018-09-25 15:32 ` Ludovic Courtès
2018-09-26 7:58 ` Danny Milosavljevic
2018-09-25 15:32 ` [bug#32837] [PATCH 3/5] progress: Add 'display-download-progress' Ludovic Courtès
` (3 subsequent siblings)
4 siblings, 1 reply; 12+ messages in thread
From: Ludovic Courtès @ 2018-09-25 15:32 UTC (permalink / raw)
To: 32837; +Cc: Ricardo Wurmus
* guix/scripts/substitute.scm (progress-report-port): Use 'close-port'
instead of 'close-connection'. Move 'stop' call first.
---
guix/scripts/substitute.scm | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 6d31dfdaa..50c6a2206 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -837,8 +837,8 @@ REPORTER, which should be a <progress-reporter> object."
(make-custom-binary-input-port "progress-port-proc"
read! #f #f
(lambda ()
- (close-connection port)
- (stop)))))))
+ (stop)
+ (close-port port)))))))
(define-syntax with-networking
(syntax-rules ()
--
2.19.0
^ permalink raw reply related [flat|nested] 12+ messages in thread
* [bug#32837] [PATCH 3/5] progress: Add 'display-download-progress'.
2018-09-25 15:32 ` [bug#32837] [PATCH 1/5] progress: 'progress-reporter-report!' takes any number of arguments Ludovic Courtès
2018-09-25 15:32 ` [bug#32837] [PATCH 2/5] substitute: Progress port really closes underlying port Ludovic Courtès
@ 2018-09-25 15:32 ` Ludovic Courtès
2018-09-26 7:59 ` Danny Milosavljevic
2018-09-25 15:32 ` [bug#32837] [PATCH 4/5] Add (guix status) and use it for pretty colored output Ludovic Courtès
` (2 subsequent siblings)
4 siblings, 1 reply; 12+ messages in thread
From: Ludovic Courtès @ 2018-09-25 15:32 UTC (permalink / raw)
To: 32837; +Cc: Ricardo Wurmus
* guix/progress.scm (display-download-progress): New procedure.
(progress-reporter/file)[render]: Rewrite in terms of
'display-download-progress'.
---
guix/progress.scm | 72 +++++++++++++++++++++++++++--------------------
1 file changed, 41 insertions(+), 31 deletions(-)
diff --git a/guix/progress.scm b/guix/progress.scm
index 53aea1c56..d4ebb3299 100644
--- a/guix/progress.scm
+++ b/guix/progress.scm
@@ -39,6 +39,7 @@
progress-reporter/file
progress-reporter/bar
+ display-download-progress
byte-count->string
current-terminal-columns
@@ -183,6 +184,42 @@ width of the bar is BAR-WIDTH."
move the cursor to the beginning of the line."
(display "\r\x1b[K" port))
+(define* (display-download-progress file size
+ #:key
+ start-time (transferred 0)
+ (log-port (current-error-port)))
+ "Write the progress report to LOG-PORT. Use START-TIME (a SRFI-19 time
+object) and TRANSFERRED (a total number of bytes) to determine the
+throughput."
+ (define elapsed
+ (duration->seconds
+ (time-difference (current-time time-monotonic) start-time)))
+ (if (number? size)
+ (let* ((% (* 100.0 (/ transferred size)))
+ (throughput (/ transferred elapsed))
+ (left (format #f " ~a ~a" file
+ (byte-count->string size)))
+ (right (format #f "~a/s ~a ~a~6,1f%"
+ (byte-count->string throughput)
+ (seconds->string elapsed)
+ (progress-bar %) %)))
+ (erase-current-line log-port)
+ (display (string-pad-middle left right
+ (current-terminal-columns))
+ log-port)
+ (force-output log-port))
+ (let* ((throughput (/ transferred elapsed))
+ (left (format #f " ~a" file))
+ (right (format #f "~a/s ~a | ~a transferred"
+ (byte-count->string throughput)
+ (seconds->string elapsed)
+ (byte-count->string transferred))))
+ (erase-current-line log-port)
+ (display (string-pad-middle left right
+ (current-terminal-columns))
+ log-port)
+ (force-output log-port))))
+
(define* (progress-reporter/file file size
#:optional (log-port (current-output-port))
#:key (abbreviation basename))
@@ -192,37 +229,10 @@ ABBREVIATION used to shorten FILE for display."
(let ((start-time (current-time time-monotonic))
(transferred 0))
(define (render)
- "Write the progress report to LOG-PORT."
- (define elapsed
- (duration->seconds
- (time-difference (current-time time-monotonic) start-time)))
- (if (number? size)
- (let* ((% (* 100.0 (/ transferred size)))
- (throughput (/ transferred elapsed))
- (left (format #f " ~a ~a"
- (abbreviation file)
- (byte-count->string size)))
- (right (format #f "~a/s ~a ~a~6,1f%"
- (byte-count->string throughput)
- (seconds->string elapsed)
- (progress-bar %) %)))
- (erase-current-line log-port)
- (display (string-pad-middle left right
- (current-terminal-columns))
- log-port)
- (force-output log-port))
- (let* ((throughput (/ transferred elapsed))
- (left (format #f " ~a"
- (abbreviation file)))
- (right (format #f "~a/s ~a | ~a transferred"
- (byte-count->string throughput)
- (seconds->string elapsed)
- (byte-count->string transferred))))
- (erase-current-line log-port)
- (display (string-pad-middle left right
- (current-terminal-columns))
- log-port)
- (force-output log-port))))
+ (display-download-progress (abbreviation file) size
+ #:start-time start-time
+ #:transferred transferred
+ #:log-port log-port))
(progress-reporter
(start render)
--
2.19.0
^ permalink raw reply related [flat|nested] 12+ messages in thread
* [bug#32837] [PATCH 4/5] Add (guix status) and use it for pretty colored output.
2018-09-25 15:32 ` [bug#32837] [PATCH 1/5] progress: 'progress-reporter-report!' takes any number of arguments Ludovic Courtès
2018-09-25 15:32 ` [bug#32837] [PATCH 2/5] substitute: Progress port really closes underlying port Ludovic Courtès
2018-09-25 15:32 ` [bug#32837] [PATCH 3/5] progress: Add 'display-download-progress' Ludovic Courtès
@ 2018-09-25 15:32 ` Ludovic Courtès
2018-09-25 15:32 ` [bug#32837] [PATCH 5/5] perform-download: Optionally report a "download-progress" trace Ludovic Courtès
2018-09-26 7:58 ` [bug#32837] [PATCH 1/5] progress: 'progress-reporter-report!' takes any number of arguments Danny Milosavljevic
4 siblings, 0 replies; 12+ messages in thread
From: Ludovic Courtès @ 2018-09-25 15:32 UTC (permalink / raw)
To: 32837; +Cc: Ricardo Wurmus
* guix/progress.scm (progress-reporter/trace): New procedure.
* 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/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.
* 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.
---
.dir-locals.el | 1 +
Makefile.am | 2 +
guix/progress.scm | 30 +-
guix/scripts/build.scm | 15 +-
guix/scripts/environment.scm | 110 +++----
guix/scripts/pack.scm | 140 ++++-----
guix/scripts/package.scm | 24 +-
guix/scripts/perform-download.scm | 1 +
guix/scripts/substitute.scm | 42 ++-
guix/scripts/system.scm | 11 +-
guix/status.scm | 463 ++++++++++++++++++++++++++++++
guix/store.scm | 14 +-
guix/ui.scm | 108 +------
po/guix/POTFILES.in | 1 +
tests/status.scm | 115 ++++++++
15 files changed, 820 insertions(+), 257 deletions(-)
create mode 100644 guix/status.scm
create mode 100644 tests/status.scm
diff --git a/.dir-locals.el b/.dir-locals.el
index eb99a5bcc..793117c0a 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -59,6 +59,7 @@
(eval . (put 'emacs-substitute-variables 'scheme-indent-function 1))
(eval . (put 'with-derivation-narinfo 'scheme-indent-function 1))
(eval . (put 'with-derivation-substitute 'scheme-indent-function 2))
+ (eval . (put 'with-status-report 'scheme-indent-function 1))
(eval . (put 'mlambda 'scheme-indent-function 1))
(eval . (put 'mlambdaq 'scheme-indent-function 1))
diff --git a/Makefile.am b/Makefile.am
index 5c8639d66..7fd29b90a 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -131,6 +131,7 @@ MODULES = \
guix/svn-download.scm \
guix/i18n.scm \
guix/ui.scm \
+ guix/status.scm \
guix/build/android-ndk-build-system.scm \
guix/build/ant-build-system.scm \
guix/build/download.scm \
@@ -340,6 +341,7 @@ SCM_TESTS = \
tests/glob.scm \
tests/grafts.scm \
tests/ui.scm \
+ tests/status.scm \
tests/records.scm \
tests/upstream.scm \
tests/combinators.scm \
diff --git a/guix/progress.scm b/guix/progress.scm
index d4ebb3299..27610091c 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
@@ -279,6 +282,31 @@ 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 report-progress)
+ (stop (lambda ()
+ (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)
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 3fa3c2c20..5a6ba62bc 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -45,6 +45,9 @@
#:use-module (srfi srfi-37)
#:autoload (gnu packages) (specification->package %package-module-path)
#:autoload (guix download) (download-to-store)
+ #:use-module (guix status)
+ #:use-module ((guix progress) #:select (current-terminal-columns))
+ #:use-module ((guix build syscalls) #:select (terminal-columns))
#:export (%standard-build-options
set-build-options-from-command-line
set-build-options-from-command-line*
@@ -390,6 +393,8 @@ options handled by 'set-build-options-from-command-line', and listed in
#:max-silent-time (assoc-ref opts 'max-silent-time)
#:timeout (assoc-ref opts 'timeout)
#:print-build-trace (assoc-ref opts 'print-build-trace?)
+ #:print-extended-build-trace?
+ (assoc-ref opts 'print-extended-build-trace?)
#:verbosity (assoc-ref opts 'verbosity)))
(define set-build-options-from-command-line*
@@ -499,6 +504,7 @@ options handled by 'set-build-options-from-command-line', and listed in
(substitutes? . #t)
(build-hook? . #t)
(print-build-trace? . #t)
+ (print-extended-build-trace? . #t)
(verbosity . 0)))
(define (show-help)
@@ -733,9 +739,12 @@ needed."
;; Set the build options before we do anything else.
(set-build-options-from-command-line store opts)
- (parameterize ((current-build-output-port (if quiet?
- (%make-void-port "w")
- (build-output-port #:verbose? #t))))
+ (parameterize ((current-terminal-columns (terminal-columns))
+ (current-build-output-port
+ (if quiet?
+ (%make-void-port "w")
+ (build-event-output-port
+ (build-status-updater print-build-event)))))
(let* ((mode (assoc-ref opts 'build-mode))
(drv (options->derivations store opts))
(urls (map (cut string-append <> "/log")
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 1c04800e4..9fc7edcd3 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -21,6 +21,7 @@
(define-module (guix scripts environment)
#:use-module (guix ui)
#:use-module (guix store)
+ #:use-module (guix status)
#:use-module (guix grafts)
#:use-module (guix derivations)
#:use-module (guix packages)
@@ -173,6 +174,8 @@ COMMAND or an interactive shell in that environment.\n"))
(substitutes? . #t)
(build-hook? . #t)
(graft? . #t)
+ (print-build-trace? . #t)
+ (print-extended-build-trace? . #t)
(verbosity . 0)))
(define (tag-package-arg opts arg)
@@ -661,59 +664,60 @@ message if any test fails."
(leave (G_ "'--user' cannot be used without '--container'~%")))
(with-store store
- (set-build-options-from-command-line store opts)
+ (with-status-report print-build-event
+ (set-build-options-from-command-line store opts)
- ;; Use the bootstrap Guile when requested.
- (parameterize ((%graft? (assoc-ref opts 'graft?))
- (%guile-for-build
- (package-derivation
- store
- (if bootstrap?
- %bootstrap-guile
- (canonical-package guile-2.2)))))
- (run-with-store store
- ;; Containers need a Bourne shell at /bin/sh.
- (mlet* %store-monad ((bash (environment-bash container?
- bootstrap?
- system))
- (prof-drv (manifest->derivation
- manifest system bootstrap?))
- (profile -> (derivation->output-path prof-drv))
- (gc-root -> (assoc-ref opts 'gc-root)))
+ ;; Use the bootstrap Guile when requested.
+ (parameterize ((%graft? (assoc-ref opts 'graft?))
+ (%guile-for-build
+ (package-derivation
+ store
+ (if bootstrap?
+ %bootstrap-guile
+ (canonical-package guile-2.2)))))
+ (run-with-store store
+ ;; Containers need a Bourne shell at /bin/sh.
+ (mlet* %store-monad ((bash (environment-bash container?
+ bootstrap?
+ system))
+ (prof-drv (manifest->derivation
+ manifest system bootstrap?))
+ (profile -> (derivation->output-path prof-drv))
+ (gc-root -> (assoc-ref opts 'gc-root)))
- ;; First build the inputs. This is necessary even for
- ;; --search-paths. Additionally, we might need to build bash for
- ;; a container.
- (mbegin %store-monad
- (build-environment (if (derivation? bash)
- (list prof-drv bash)
- (list prof-drv))
- opts)
- (mwhen gc-root
- (register-gc-root profile gc-root))
+ ;; First build the inputs. This is necessary even for
+ ;; --search-paths. Additionally, we might need to build bash for
+ ;; a container.
+ (mbegin %store-monad
+ (build-environment (if (derivation? bash)
+ (list prof-drv bash)
+ (list prof-drv))
+ opts)
+ (mwhen gc-root
+ (register-gc-root profile gc-root))
- (cond
- ((assoc-ref opts 'dry-run?)
- (return #t))
- ((assoc-ref opts 'search-paths)
- (show-search-paths profile manifest #:pure? pure?)
- (return #t))
- (container?
- (let ((bash-binary
- (if bootstrap?
- bash
- (string-append (derivation->output-path bash)
- "/bin/sh"))))
- (launch-environment/container #:command command
- #:bash bash-binary
- #:user user
- #:user-mappings mappings
- #:profile profile
- #:manifest manifest
- #:link-profile? link-prof?
- #:network? network?)))
- (else
- (return
- (exit/status
- (launch-environment/fork command profile manifest
- #:pure? pure?)))))))))))))
+ (cond
+ ((assoc-ref opts 'dry-run?)
+ (return #t))
+ ((assoc-ref opts 'search-paths)
+ (show-search-paths profile manifest #:pure? pure?)
+ (return #t))
+ (container?
+ (let ((bash-binary
+ (if bootstrap?
+ bash
+ (string-append (derivation->output-path bash)
+ "/bin/sh"))))
+ (launch-environment/container #:command command
+ #:bash bash-binary
+ #:user user
+ #:user-mappings mappings
+ #:profile profile
+ #:manifest manifest
+ #:link-profile? link-prof?
+ #:network? network?)))
+ (else
+ (return
+ (exit/status
+ (launch-environment/fork command profile manifest
+ #:pure? pure?))))))))))))))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 1916f3b9d..163f5b1dc 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -25,6 +25,7 @@
#:use-module (guix gexp)
#:use-module (guix utils)
#:use-module (guix store)
+ #:use-module (guix status)
#:use-module (guix grafts)
#:use-module (guix monads)
#:use-module (guix modules)
@@ -538,6 +539,8 @@ please email '~a'~%")
(substitutes? . #t)
(build-hook? . #t)
(graft? . #t)
+ (print-build-trace? . #t)
+ (print-extended-build-trace? . #t)
(verbosity . 0)
(symlinks . ())
(compressor . ,(first %compressors))))
@@ -684,72 +687,73 @@ Create a bundle of PACKAGE.\n"))
(with-error-handling
(with-store store
- ;; Set the build options before we do anything else.
- (set-build-options-from-command-line store opts)
+ (with-status-report print-build-event
+ ;; Set the build options before we do anything else.
+ (set-build-options-from-command-line store opts)
- (parameterize ((%graft? (assoc-ref opts 'graft?))
- (%guile-for-build (package-derivation
- store
- (if (assoc-ref opts 'bootstrap?)
- %bootstrap-guile
- (canonical-package guile-2.2))
- (assoc-ref opts 'system)
- #:graft? (assoc-ref opts 'graft?))))
- (let* ((dry-run? (assoc-ref opts 'dry-run?))
- (relocatable? (assoc-ref opts 'relocatable?))
- (manifest (let ((manifest (manifest-from-args store opts)))
- ;; Note: We cannot honor '--bootstrap' here because
- ;; 'glibc-bootstrap' lacks 'libc.a'.
- (if relocatable?
- (map-manifest-entries wrapped-package manifest)
- manifest)))
- (pack-format (assoc-ref opts 'format))
- (name (string-append (symbol->string pack-format)
- "-pack"))
- (target (assoc-ref opts 'target))
- (bootstrap? (assoc-ref opts 'bootstrap?))
- (compressor (if bootstrap?
- bootstrap-xz
- (assoc-ref opts 'compressor)))
- (archiver (if (equal? pack-format 'squashfs)
- squashfs-tools-next
- (if bootstrap?
- %bootstrap-coreutils&co
- tar)))
- (symlinks (assoc-ref opts 'symlinks))
- (build-image (match (assq-ref %formats pack-format)
- ((? procedure? proc) proc)
- (#f
- (leave (G_ "~a: unknown pack format~%")
- pack-format))))
- (localstatedir? (assoc-ref opts 'localstatedir?)))
- (run-with-store store
- (mlet* %store-monad ((profile (profile-derivation
- manifest
- #:relative-symlinks? relocatable?
- #:hooks (if bootstrap?
- '()
- %default-profile-hooks)
- #:locales? (not bootstrap?)
- #:target target))
- (drv (build-image name profile
- #:target
- target
- #:compressor
- compressor
- #:symlinks
- symlinks
- #:localstatedir?
- localstatedir?
- #:archiver
- archiver)))
- (mbegin %store-monad
- (show-what-to-build* (list drv)
- #:use-substitutes?
- (assoc-ref opts 'substitutes?)
- #:dry-run? dry-run?)
- (munless dry-run?
- (built-derivations (list drv))
- (return (format #t "~a~%"
- (derivation->output-path drv))))))
- #:system (assoc-ref opts 'system)))))))
+ (parameterize ((%graft? (assoc-ref opts 'graft?))
+ (%guile-for-build (package-derivation
+ store
+ (if (assoc-ref opts 'bootstrap?)
+ %bootstrap-guile
+ (canonical-package guile-2.2))
+ (assoc-ref opts 'system)
+ #:graft? (assoc-ref opts 'graft?))))
+ (let* ((dry-run? (assoc-ref opts 'dry-run?))
+ (relocatable? (assoc-ref opts 'relocatable?))
+ (manifest (let ((manifest (manifest-from-args store opts)))
+ ;; Note: We cannot honor '--bootstrap' here because
+ ;; 'glibc-bootstrap' lacks 'libc.a'.
+ (if relocatable?
+ (map-manifest-entries wrapped-package manifest)
+ manifest)))
+ (pack-format (assoc-ref opts 'format))
+ (name (string-append (symbol->string pack-format)
+ "-pack"))
+ (target (assoc-ref opts 'target))
+ (bootstrap? (assoc-ref opts 'bootstrap?))
+ (compressor (if bootstrap?
+ bootstrap-xz
+ (assoc-ref opts 'compressor)))
+ (archiver (if (equal? pack-format 'squashfs)
+ squashfs-tools-next
+ (if bootstrap?
+ %bootstrap-coreutils&co
+ tar)))
+ (symlinks (assoc-ref opts 'symlinks))
+ (build-image (match (assq-ref %formats pack-format)
+ ((? procedure? proc) proc)
+ (#f
+ (leave (G_ "~a: unknown pack format~%")
+ pack-format))))
+ (localstatedir? (assoc-ref opts 'localstatedir?)))
+ (run-with-store store
+ (mlet* %store-monad ((profile (profile-derivation
+ manifest
+ #:relative-symlinks? relocatable?
+ #:hooks (if bootstrap?
+ '()
+ %default-profile-hooks)
+ #:locales? (not bootstrap?)
+ #:target target))
+ (drv (build-image name profile
+ #:target
+ target
+ #:compressor
+ compressor
+ #:symlinks
+ symlinks
+ #:localstatedir?
+ localstatedir?
+ #:archiver
+ archiver)))
+ (mbegin %store-monad
+ (show-what-to-build* (list drv)
+ #:use-substitutes?
+ (assoc-ref opts 'substitutes?)
+ #:dry-run? dry-run?)
+ (munless dry-run?
+ (built-derivations (list drv))
+ (return (format #t "~a~%"
+ (derivation->output-path drv))))))
+ #:system (assoc-ref opts 'system))))))))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 73cbccba3..93a77915f 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -24,6 +24,7 @@
(define-module (guix scripts package)
#:use-module (guix ui)
+ #:use-module (guix status)
#:use-module (guix store)
#:use-module (guix grafts)
#:use-module (guix derivations)
@@ -330,7 +331,8 @@ ENTRIES, a list of manifest entries, in the context of PROFILE."
(graft? . #t)
(substitutes? . #t)
(build-hook? . #t)
- (print-build-trace? . #t)))
+ (print-build-trace? . #t)
+ (print-extended-build-trace? . #t)))
(define (show-help)
(display (G_ "Usage: guix package [OPTION]...
@@ -941,14 +943,12 @@ processed, #f otherwise."
(or (process-query opts)
(parameterize ((%store (open-connection))
(%graft? (assoc-ref opts 'graft?)))
- (set-build-options-from-command-line (%store) opts)
-
- (parameterize ((%guile-for-build
- (package-derivation
- (%store)
- (if (assoc-ref opts 'bootstrap?)
- %bootstrap-guile
- (canonical-package guile-2.2))))
- (current-build-output-port
- (build-output-port #:verbose? verbose?)))
- (process-actions (%store) opts))))))
+ (with-status-report print-build-event/quiet
+ (set-build-options-from-command-line (%store) opts)
+ (parameterize ((%guile-for-build
+ (package-derivation
+ (%store)
+ (if (assoc-ref opts 'bootstrap?)
+ %bootstrap-guile
+ (canonical-package guile-2.2)))))
+ (process-actions (%store) opts)))))))
diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm
index 18e2fc92f..9f6ecc00d 100644
--- a/guix/scripts/perform-download.scm
+++ b/guix/scripts/perform-download.scm
@@ -48,6 +48,7 @@ OUTPUT.
Note: Unless OUTPUT is #f, we don't read the value of 'out' in DRV since the
actual output is different from that when we're doing a 'bmCheck' or
'bmRepair' build."
+ ;; TODO: Use 'trace-progress-proc' when possible.
(derivation-let drv ((url "url")
(output* "out")
(executable "executable")
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 50c6a2206..eb8222401 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -837,7 +837,16 @@ REPORTER, which should be a <progress-reporter> object."
(make-custom-binary-input-port "progress-port-proc"
read! #f #f
(lambda ()
- (stop)
+ ;; XXX: Kludge! When used through
+ ;; 'decompressed-port', this port ends
+ ;; up being closed twice: once in a
+ ;; child process early on, and at the
+ ;; end in the parent process. Ignore
+ ;; the early close so we don't output
+ ;; a spurious "download-succeeded"
+ ;; trace.
+ (unless (zero? total)
+ (stop))
(close-port port)))))))
(define-syntax with-networking
@@ -930,7 +939,7 @@ authorized substitutes."
(error "unknown `--query' command" wtf))))
(define* (process-substitution store-item destination
- #:key cache-urls acl)
+ #:key cache-urls acl print-build-trace?)
"Substitute STORE-ITEM (a store file name) from CACHE-URLS, and write it to
DESTINATION as a nar file. Verify the substitute against ACL."
(let* ((narinfo (lookup-narinfo cache-urls store-item
@@ -943,8 +952,10 @@ DESTINATION as a nar file. Verify the substitute against ACL."
;; Tell the daemon what the expected hash of the Nar itself is.
(format #t "~a~%" (narinfo-hash narinfo))
- (format (current-error-port)
- (G_ "Downloading ~a...~%") (uri->string uri))
+ (unless print-build-trace?
+ (format (current-error-port)
+ (G_ "Downloading ~a...~%") (uri->string uri)))
+
(let*-values (((raw download-size)
;; Note that Hydra currently generates Nars on the fly
;; and doesn't specify a Content-Length, so
@@ -955,10 +966,15 @@ DESTINATION as a nar file. Verify the substitute against ACL."
(dl-size (or download-size
(and (equal? comp "none")
(narinfo-size narinfo))))
- (reporter (progress-reporter/file
- (uri->string uri) dl-size
- (current-error-port)
- #:abbreviation nar-uri-abbreviation)))
+ (reporter (if print-build-trace?
+ (progress-reporter/trace
+ destination
+ (uri->string uri) dl-size
+ (current-error-port))
+ (progress-reporter/file
+ (uri->string uri) dl-size
+ (current-error-port)
+ #:abbreviation nar-uri-abbreviation))))
(progress-report-port reporter raw)))
((input pids)
;; NOTE: This 'progress' port of current process will be
@@ -1058,6 +1074,13 @@ default value."
(define (guix-substitute . args)
"Implement the build daemon's substituter protocol."
+ (define print-build-trace?
+ (match (or (find-daemon-option "untrusted-print-extended-build-trace")
+ (find-daemon-option "print-extended-build-trace"))
+ (#f #f)
+ ((= string->number number) (> number 0))
+ (_ #f)))
+
(mkdir-p %narinfo-cache-directory)
(maybe-remove-expired-cache-entries %narinfo-cache-directory
cached-narinfo-files
@@ -1111,7 +1134,8 @@ default value."
(parameterize ((current-terminal-columns (client-terminal-columns)))
(process-substitution store-path destination
#:cache-urls (substitute-urls)
- #:acl (current-acl))))
+ #:acl (current-acl)
+ #:print-build-trace? print-build-trace?)))
((or ("-V") ("--version"))
(show-version-and-exit "guix substitute"))
(("--help")
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 69bd05b51..5d003c88f 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -23,6 +23,7 @@
(define-module (guix scripts system)
#:use-module (guix config)
#:use-module (guix ui)
+ #:use-module (guix status)
#:use-module (guix store)
#:autoload (guix store database) (register-path)
#:use-module (guix grafts)
@@ -1072,6 +1073,8 @@ Some ACTIONS support additional ARGS.\n"))
`((system . ,(%current-system))
(substitutes? . #t)
(build-hook? . #t)
+ (print-build-trace? . #t)
+ (print-extended-build-trace? . #t)
(graft? . #t)
(verbosity . 0)
(file-system-type . "ext4")
@@ -1246,9 +1249,11 @@ argument list and OPTS is the option alist."
parse-sub-command))
(args (option-arguments opts))
(command (assoc-ref opts 'action)))
- (parameterize ((%graft? (assoc-ref opts 'graft?))
- (current-terminal-columns (terminal-columns)))
- (process-command command args opts)))))
+ (parameterize ((%graft? (assoc-ref opts 'graft?)))
+ (with-status-report (if (memq command '(init reconfigure))
+ print-build-event/quiet
+ print-build-event)
+ (process-command command args opts))))))
;;; Local Variables:
;;; eval: (put 'call-with-service-upgrade-info 'scheme-indent-function 1)
diff --git a/guix/status.scm b/guix/status.scm
new file mode 100644
index 000000000..60727892f
--- /dev/null
+++ b/guix/status.scm
@@ -0,0 +1,463 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix status)
+ #:use-module (guix records)
+ #:use-module (guix i18n)
+ #:use-module ((guix ui) #:select (colorize-string))
+ #:use-module (guix progress)
+ #:autoload (guix build syscalls) (terminal-columns)
+ #:use-module ((guix store)
+ #:select (current-build-output-port log-file))
+ #:use-module (guix derivations)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-19)
+ #:use-module (srfi srfi-26)
+ #:use-module (ice-9 regex)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 format)
+ #:use-module (ice-9 binary-ports)
+ #:use-module (rnrs bytevectors)
+ #:use-module ((system foreign)
+ #:select (bytevector->pointer pointer->bytevector))
+ #:export (build-event-output-port
+ compute-status
+
+ build-status
+ build-status?
+ build-status-building
+ build-status-downloading
+ build-status-builds-completed
+ build-status-downloads-completed
+
+ download?
+ download
+ download-item
+ download-uri
+ download-size
+ download-start
+ download-end
+ download-transferred
+
+ build-status-updater
+ print-build-event
+ print-build-event/quiet
+ print-build-status
+
+ with-status-report))
+
+;;; Commentary:
+;;;
+;;; This module provides facilities to track the status of ongoing builds and
+;;; downloads in a given session, as well as tools to report about the current
+;;; status to user interfaces. It does so by analyzing the output of
+;;; 'current-build-output-port'. The build status is maintained in a
+;;; <build-status> record.
+;;;
+;;; Code:
+
+\f
+;;;
+;;; Build status tracking.
+;;;
+
+;; Builds and substitutions performed by the daemon.
+(define-record-type* <build-status> build-status make-build-status
+ build-status?
+ (building build-status-building ;list of drv
+ (default '()))
+ (downloading build-status-downloading ;list of <download>
+ (default '()))
+ (builds-completed build-status-builds-completed ;list of drv
+ (default '()))
+ (downloads-completed build-status-downloads-completed ;list of store items
+ (default '())))
+
+;; On-going or completed downloads. Downloads can be stem from substitutes
+;; and from "builtin:download" fixed-output derivations.
+(define-record-type <download>
+ (%download item uri size start end transferred)
+ download?
+ (item download-item) ;store item
+ (uri download-uri) ;string | #f
+ (size download-size) ;integer | #f
+ (start download-start) ;<time>
+ (end download-end) ;#f | <time>
+ (transferred download-transferred)) ;integer
+
+(define* (download item uri
+ #:key size
+ (start (current-time time-monotonic)) end
+ (transferred 0))
+ "Return a new download."
+ (%download item uri size start end transferred))
+
+(define (matching-download item)
+ "Return a predicate that matches downloads of ITEM."
+ (lambda (download)
+ (string=? item (download-item download))))
+
+(define* (compute-status event status
+ #:key (current-time current-time))
+ "Given EVENT, a tuple like (build-started \"/gnu/store/...-foo.drv\" ...),
+compute a new status based on STATUS."
+ (match event
+ (('build-started drv _ ...)
+ (build-status
+ (inherit status)
+ (building (cons drv (build-status-building status)))))
+ (((or 'build-succeeded 'build-failed) drv _ ...)
+ (build-status
+ (inherit status)
+ (building (delete drv (build-status-building status)))
+ (builds-completed (cons drv (build-status-builds-completed status)))))
+
+ ;; Note: Ignore 'substituter-started' and 'substituter-succeeded' because
+ ;; they're not as informative as 'download-started' and
+ ;; 'download-succeeded'.
+
+ (('download-started item uri (= string->number size))
+ ;; This is presumably a fixed-output derivation so move it from
+ ;; 'building' to 'downloading'. XXX: This doesn't work in 'check' mode
+ ;; because ITEM is different from DRV's output.
+ (build-status
+ (inherit status)
+ (building (remove (lambda (drv)
+ (equal? (false-if-exception
+ (derivation->output-path
+ (read-derivation-from-file drv)))
+ item))
+ (build-status-building status)))
+ (downloading (cons (download item uri #:size size
+ #:start (current-time time-monotonic))
+ (build-status-downloading status)))))
+ (('download-succeeded item uri (= string->number size))
+ (let ((current (find (matching-download item)
+ (build-status-downloading status))))
+ (build-status
+ (inherit status)
+ (downloading (delq current (build-status-downloading status)))
+ (downloads-completed
+ (cons (download item uri
+ #:size size
+ #:start (download-start current)
+ #:transferred size
+ #:end (current-time time-monotonic))
+ (build-status-downloads-completed status))))))
+ (('substituter-succeeded item _ ...)
+ (match (find (matching-download item)
+ (build-status-downloading status))
+ (#f
+ ;; Presumably we already got a 'download-succeeded' event for ITEM,
+ ;; everything is fine.
+ status)
+ (current
+ ;; Maybe the build process didn't emit a 'download-succeeded' event
+ ;; for ITEM, so remove CURRENT from the queue now.
+ (build-status
+ (inherit status)
+ (downloading (delq current (build-status-downloading status)))
+ (downloads-completed
+ (cons (download item (download-uri current)
+ #:size (download-size current)
+ #:start (download-start current)
+ #:transferred (download-size current)
+ #:end (current-time time-monotonic))
+ (build-status-downloads-completed status)))))))
+ (('download-progress item uri
+ (= string->number size)
+ (= string->number transferred))
+ (let ((downloads (remove (matching-download item)
+ (build-status-downloading status)))
+ (current (find (matching-download item)
+ (build-status-downloading status))))
+ (build-status
+ (inherit status)
+ (downloading (cons (download item uri
+ #:size size
+ #:start
+ (or (and current
+ (download-start current))
+ (current-time time-monotonic))
+ #:transferred transferred)
+ downloads)))))
+ (_
+ status)))
+
+(define (simultaneous-jobs status)
+ "Return the number of on-going builds and downloads for STATUS."
+ (+ (length (build-status-building status))
+ (length (build-status-downloading status))))
+
+(define spin!
+ (let ((steps (circular-list "\\" "|" "/" "-")))
+ (lambda (port)
+ "Display a spinner on PORT."
+ (match steps
+ ((first . rest)
+ (set! steps rest)
+ (display "\r\x1b[K" port)
+ (display first port)
+ (force-output port))))))
+
+(define (color-output? port)
+ "Return true if we should write colored output to PORT."
+ (and (not (getenv "INSIDE_EMACS"))
+ (not (getenv "NO_COLOR"))
+ (isatty? port)))
+
+(define-syntax color-rules
+ (syntax-rules ()
+ "Return a procedure that colorizes the string it is passed according to
+the given rules. Each rule has the form:
+
+ (REGEXP COLOR1 COLOR2 ...)
+
+where COLOR1 specifies how to colorize the first submatch of REGEXP, and so
+on."
+ ((_ (regexp colors ...) rest ...)
+ (let ((next (color-rules rest ...))
+ (rx (make-regexp regexp)))
+ (lambda (str)
+ (if (string-index str #\nul)
+ str
+ (match (regexp-exec rx str)
+ (#f (next str))
+ (m (let loop ((n 1)
+ (c '(colors ...))
+ (result '()))
+ (match c
+ (()
+ (string-concatenate-reverse result))
+ ((first . tail)
+ (loop (+ n 1) tail
+ (cons (colorize-string (match:substring m n)
+ first)
+ result)))))))))))
+ ((_)
+ (lambda (str)
+ str))))
+
+(define colorize-log-line
+ ;; Take a string and return a possibly colorized string according to the
+ ;; rules below.
+ (color-rules
+ ("^(phase)(.*)(succeeded after)(.*)(seconds)(.*)"
+ GREEN BOLD GREEN RESET GREEN BLUE)
+ ("^(phase)(.*)(failed after)(.*)(seconds)(.*)"
+ RED BLUE RED BLUE RED BLUE)
+ ("^(.*)(error|fail|failed|FAIL|FAILED)([[:blank:]]*)(:)(.*)"
+ RESET RED BOLD BOLD BOLD)
+ ("^(.*)(warning)([[:blank:]]*)(:)(.*)"
+ RESET ORANGE BOLD BOLD BOLD)))
+
+(define* (print-build-event event old-status status
+ #:optional (port (current-error-port))
+ #:key
+ (colorize? (color-output? port))
+ (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."
+ (define info
+ (if colorize?
+ (cut colorize-string <> 'BOLD)
+ identity))
+
+ (define success
+ (if colorize?
+ (cut colorize-string <> 'GREEN 'BOLD)
+ identity))
+
+ (define failure
+ (if colorize?
+ (cut colorize-string <> 'RED 'BOLD)
+ identity))
+
+ (define print-log-line
+ (if print-log?
+ (if colorize?
+ (lambda (line)
+ (display (colorize-log-line line) port))
+ (cut display <> port))
+ (lambda (line)
+ (spin! port))))
+
+ (display "\r" port) ;erase the spinner
+ (match event
+ (('build-started drv . _)
+ (format port (info (G_ "building ~a...")) drv)
+ (newline port))
+ (('build-succeeded drv . _)
+ (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))
+ ongoing))))
+ (('build-failed drv . _)
+ (format port (failure (G_ "build of ~a failed")) drv)
+ (newline port)
+ (format port (info (G_ "View build log at '~a'.~%"))
+ (log-file #f drv)))
+ (('substituter-started item _ ...)
+ (when print-log?
+ (format port (info (G_ "substituting ~a...")) item)
+ (newline port)))
+ (('download-started item uri _ ...)
+ (format port (info (G_ "downloading from ~a...")) uri)
+ (newline port))
+ (('download-progress item uri
+ (= string->number size)
+ (= string->number transferred))
+ ;; Print a progress bar, but only if there's only one on-going
+ ;; job--otherwise the output would be intermingled.
+ (when (= 1 (simultaneous-jobs status))
+ (match (find (matching-download item)
+ (build-status-downloading status))
+ (#f #f) ;shouldn't happen!
+ (download
+ (display-download-progress (basename uri) size
+ #:start-time
+ (download-start download)
+ #:transferred transferred)))))
+ (('substituter-succeeded item _ ...)
+ ;; If there are no jobs running, we already reported download completion
+ ;; sot there's nothing left to do.
+ (unless (zero? (simultaneous-jobs status))
+ (format port (success (G_ "substitution of ~a complete")) item)
+ (newline port)))
+ (('substituter-failed item _ ...)
+ (format port (failure (G_ "substitution of ~a failed")) item)
+ (newline port))
+ (('build-log line)
+ ;; The daemon prefixes early messages coming with 'guix substitute' with
+ ;; "substitute:". These are useful ("updating substitutes from URL"), so
+ ;; let them through.
+ (if (string-prefix? "substitute: " line)
+ (begin
+ (format port line)
+ (force-output port))
+ (print-log-line line)))
+ (_
+ event)))
+
+(define* (print-build-event/quiet 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-log? #f))
+
+(define* (build-status-updater #:optional (on-change (const #t)))
+ "Return a procedure that can be passed to 'build-event-output-port'. That
+procedure computes the new build status upon each even and call ON-CHANGE:
+
+ (ON-CHANGE event status new-status)
+
+ON-CHANGE can display the build status, build events, etc."
+ (lambda (event status)
+ (let ((new (compute-status event status)))
+ (on-change event status new)
+ new)))
+
+\f
+;;;
+;;; Build port.
+;;;
+
+(define %newline
+ (char-set #\return #\newline))
+
+(define* (build-event-output-port proc #:optional (seed (build-status)))
+ "Return an output port for use as 'current-build-output-port' that calls
+PROC with its current state value, initialized with SEED, on every build
+event. Build events passed to PROC are tuples corresponding to the \"build
+traces\" produced by the daemon:
+
+ (build-started \"/gnu/store/...-foo.drv\" ...)
+ (substituter-started \"/gnu/store/...-foo\" ...)
+
+and so on.
+
+The second return value is a thunk to retrieve the current state."
+ (define %fragments
+ ;; Line fragments received so far.
+ '())
+
+ (define %state
+ ;; Current state for PROC.
+ seed)
+
+ (define (process-line line)
+ (if (string-prefix? "@ " line)
+ (match (string-tokenize (string-drop line 2))
+ (((= string->symbol event-name) args ...)
+ (set! %state
+ (proc (cons event-name args)
+ %state))))
+ (set! %state (proc (list 'build-log line)
+ %state))))
+
+ (define (bytevector-range bv offset count)
+ (let ((ptr (bytevector->pointer bv offset)))
+ (pointer->bytevector ptr count)))
+
+ (define (write! bv offset count)
+ (let loop ((str (utf8->string (bytevector-range bv offset count))))
+ (match (string-index str %newline)
+ ((? integer? cr)
+ (let ((tail (string-take str (+ 1 cr))))
+ (process-line (string-concatenate-reverse
+ (cons tail %fragments)))
+ (set! %fragments '())
+ (loop (string-drop str (+ 1 cr)))))
+ (#f
+ (unless (string-null? str)
+ (set! %fragments (cons str %fragments)))
+ count))))
+
+ (define port
+ (make-custom-binary-output-port "filtering-input-port"
+ write!
+ #f #f
+ #f))
+
+ ;; The build port actually receives Unicode strings.
+ (set-port-encoding! port "UTF-8")
+ (setvbuf port (cond-expand (guile-2.2 'line) (else _IOLBF)))
+
+ (values port (lambda () %state)))
+
+(define (call-with-status-report on-event thunk)
+ (parameterize ((current-terminal-columns (terminal-columns))
+ (current-build-output-port
+ (build-event-output-port (build-status-updater on-event))))
+ (thunk)))
+
+(define-syntax-rule (with-status-report on-event exp ...)
+ "Set up build status reporting to the user using the ON-EVENT procedure;
+evaluate EXP... in that context."
+ (call-with-status-report on-event (lambda () exp ...)))
diff --git a/guix/store.scm b/guix/store.scm
index af7f6980c..3e9835d83 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -682,6 +682,13 @@ encoding conversion errors."
(build-verbosity 0)
(log-type 0)
(print-build-trace #t)
+
+ ;; When true, provide machine-readable "build
+ ;; traces" for use by (guix status). Old clients
+ ;; are unable to make sense, which is why it's
+ ;; disabled by default.
+ print-extended-build-trace?
+
build-cores
(use-substitutes? #t)
@@ -725,7 +732,12 @@ encoding conversion errors."
(when (>= (nix-server-minor-version server) 10)
(send (boolean use-substitutes?)))
(when (>= (nix-server-minor-version server) 12)
- (let ((pairs `(,@(if timeout
+ (let ((pairs `(;; This option is honored by 'guix substitute' et al.
+ ,@(if print-build-trace
+ `(("print-extended-build-trace"
+ . ,(if print-extended-build-trace? "1" "0")))
+ '())
+ ,@(if timeout
`(("build-timeout" . ,(number->string timeout)))
'())
,@(if max-silent-time
diff --git a/guix/ui.scm b/guix/ui.scm
index 1bbd37c25..96f403acf 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -119,7 +119,7 @@
warning
info
guix-main
- build-output-port))
+ colorize-string))
;;; Commentary:
;;;
@@ -1676,110 +1676,4 @@ be reset such that subsequent output will not have any colors in effect."
str
(color 'RESET)))
-(define* (build-output-port #:key
- (colorize? #t)
- verbose?
- (port (current-error-port)))
- "Return a soft port that processes build output. By default it colorizes
-phase announcements and replaces any other output with a spinner."
- (define spun? #f)
- (define spin!
- (let ((steps (circular-list "\\" "|" "/" "-")))
- (lambda ()
- (match steps
- ((first . rest)
- (set! steps rest)
- (set! spun? #t) ; remember to erase spinner
- first)))))
-
- (define use-color?
- (and colorize?
- (not (or (getenv "NO_COLOR")
- (getenv "INSIDE_EMACS")
- (not (isatty? port))))))
-
- (define handle-string
- (let* ((proc (if use-color?
- colorize-string
- (lambda (s . _) s)))
- (rules `(("^(@ build-started) (.*) (.*)"
- #:transform
- ,(lambda (m)
- (string-append
- (proc "Building " 'BLUE 'BOLD)
- (match:substring m 2) "\n")))
- ("^(@ build-failed) (.*) (.*)"
- #:transform
- ,(lambda (m)
- (string-append
- (proc "Build failed: " 'RED 'BOLD)
- (match:substring m 2) "\n")))
- ("^(@ build-succeeded) (.*) (.*)"
- #:transform
- ,(lambda (m)
- (string-append
- (proc "Built " 'GREEN 'BOLD)
- (match:substring m 2) "\n")))
- ("^(@ substituter-started) (.*) (.*)"
- #:transform
- ,(lambda (m)
- (string-append
- (proc "Substituting " 'BLUE 'BOLD)
- (match:substring m 2) "\n")))
- ("^(@ substituter-failed) (.*) (.*) (.*)"
- #:transform
- ,(lambda (m)
- (string-append
- (proc "Substituter failed: " 'RED 'BOLD)
- (match:substring m 2) "\n"
- (match:substring m 3) ": "
- (match:substring m 4) "\n")))
- ("^(@ substituter-succeeded) (.*)"
- #:transform
- ,(lambda (m)
- (string-append
- (proc "Substituted " 'GREEN 'BOLD)
- (match:substring m 2) "\n")))
- ("^(starting phase )(.*)"
- BLUE GREEN)
- ("^(phase)(.*)(succeeded after)(.*)(seconds)(.*)"
- GREEN BLUE GREEN BLUE GREEN BLUE)
- ("^(phase)(.*)(failed after)(.*)(seconds)(.*)"
- RED BLUE RED BLUE RED BLUE))))
- (lambda (str)
- (let ((processed
- (any (match-lambda
- ((pattern #:transform transform)
- (and=> (string-match pattern str)
- transform))
- ((pattern . colors)
- (and=> (string-match pattern str)
- (lambda (m)
- (let ((substrings
- (map (cut match:substring m <>)
- (iota (- (match:count m) 1) 1))))
- (string-join (map proc substrings colors) ""))))))
- rules)))
- (when spun?
- (display (string #\backspace) port))
- (if processed
- (begin
- (display processed port)
- (set! spun? #f))
- ;; Print unprocessed line, or replace with spinner
- (display (if verbose? str (spin!)) port))))))
- (make-soft-port
- (vector
- ;; procedure accepting one character for output
- (cut write <> port)
- ;; procedure accepting a string for output
- handle-string
- ;; thunk for flushing output
- (lambda () (force-output port))
- ;; thunk for getting one character
- (const #t)
- ;; thunk for closing port (not by garbage collection)
- (lambda () (close port)))
- "w"))
-
;;; ui.scm ends here
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index 2762ea078..df2cf12de 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -37,6 +37,7 @@ guix/scripts/container.scm
guix/scripts/container/exec.scm
guix/upstream.scm
guix/ui.scm
+guix/status.scm
guix/http-client.scm
guix/nar.scm
guix/channels.scm
diff --git a/tests/status.scm b/tests/status.scm
new file mode 100644
index 000000000..04dedb702
--- /dev/null
+++ b/tests/status.scm
@@ -0,0 +1,115 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-status)
+ #:use-module (guix status)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-64))
+
+(test-begin "status")
+
+(test-equal "compute-status, no-op"
+ (build-status)
+ (let-values (((port get-status)
+ (build-event-output-port compute-status)))
+ (display "foo\nbar\n\baz\n" port)
+ (get-status)))
+
+(test-equal "compute-status, builds + substitutes"
+ (list (build-status
+ (building '("foo.drv"))
+ (downloading (list (download "bar" "http://example.org/bar"
+ #:size 500
+ #:start 'now))))
+ (build-status
+ (building '("foo.drv"))
+ (downloading (list (download "bar" "http://example.org/bar"
+ #:size 500
+ #:transferred 42
+ #:start 'now))))
+ (build-status
+ (builds-completed '("foo.drv"))
+ (downloads-completed (list (download "bar" "http://example.org/bar"
+ #:size 500
+ #:transferred 500
+ #:start 'now
+ #:end 'now)))))
+ (let-values (((port get-status)
+ (build-event-output-port (lambda (event status)
+ (compute-status event status
+ #:current-time
+ (const 'now))))))
+ (display "@ build-started foo.drv\n" port)
+ (display "@ substituter-started bar\n" port)
+ (display "@ download-started bar http://example.org/bar 500\n" port)
+ (display "various\nthings\nget\nwritten\n" port)
+ (let ((first (get-status)))
+ (display "@ download-progress bar http://example.org/bar 500 42\n"
+ port)
+ (let ((second (get-status)))
+ (display "@ download-progress bar http://example.org/bar 500 84\n"
+ port)
+ (display "@ build-succeeded foo.drv\n" port)
+ (display "@ download-succeeded bar http://example.org/bar 500\n" port)
+ (display "Almost done!\n" port)
+ (display "@ substituter-succeeded bar\n" port)
+ (list first second (get-status))))))
+
+(test-equal "compute-status, missing events"
+ (list (build-status
+ (building '("foo.drv"))
+ (downloading (list (download "baz" "http://example.org/baz"
+ #:size 500
+ #:transferred 42
+ #:start 'now)
+ (download "bar" "http://example.org/bar"
+ #:size 999
+ #:transferred 0
+ #:start 'now))))
+ (build-status
+ (builds-completed '("foo.drv"))
+ (downloads-completed (list (download "baz" "http://example.org/baz"
+ #:size 500
+ #:transferred 500
+ #:start 'now
+ #:end 'now)
+ (download "bar" "http://example.org/bar"
+ #:size 999
+ #:transferred 999
+ #:start 'now
+ #:end 'now)))))
+ ;; Below we omit 'substituter-started' events and the like.
+ (let-values (((port get-status)
+ (build-event-output-port (lambda (event status)
+ (compute-status event status
+ #:current-time
+ (const 'now))))))
+ (display "@ build-started foo.drv\n" port)
+ (display "@ download-started bar http://example.org/bar 999\n" port)
+ (display "various\nthings\nget\nwritten\n" port)
+ (display "@ download-progress baz http://example.org/baz 500 42\n"
+ port)
+ (let ((first (get-status)))
+ (display "@ build-succeeded foo.drv\n" port)
+ (display "@ download-succeeded bar http://example.org/bar 999\n" port)
+ (display "Almost done!\n" port)
+ (display "@ substituter-succeeded baz\n" port)
+ (list first (get-status)))))
+
+(test-end "status")
--
2.19.0
^ permalink raw reply related [flat|nested] 12+ messages in thread
* [bug#32837] [PATCH 5/5] perform-download: Optionally report a "download-progress" trace.
2018-09-25 15:32 ` [bug#32837] [PATCH 1/5] progress: 'progress-reporter-report!' takes any number of arguments Ludovic Courtès
` (2 preceding siblings ...)
2018-09-25 15:32 ` [bug#32837] [PATCH 4/5] Add (guix status) and use it for pretty colored output Ludovic Courtès
@ 2018-09-25 15:32 ` Ludovic Courtès
2018-09-26 7:58 ` [bug#32837] [PATCH 1/5] progress: 'progress-reporter-report!' takes any number of arguments Danny Milosavljevic
4 siblings, 0 replies; 12+ messages in thread
From: Ludovic Courtès @ 2018-09-25 15:32 UTC (permalink / raw)
To: 32837; +Cc: Ricardo Wurmus
* guix/scripts/perform-download.scm (perform-download): Add
#:print-build-trace? and pass it to 'url-fetch'.
(guix-perform-download): Define 'print-build-trace?' and pass it to
'perform-download'.
* guix/build/download.scm (ftp-fetch): Add #:print-build-trace? and
honor it.
(url-fetch): Likewise.
* nix/libstore/builtins.cc (builtinDownload): Set _NIX_OPTIONS
environment variable.
---
guix/build/download.scm | 31 +++++++++++++++++++++----------
guix/scripts/perform-download.scm | 18 +++++++++++++-----
nix/libstore/builtins.cc | 5 ++++-
3 files changed, 38 insertions(+), 16 deletions(-)
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 315a3554e..54163849a 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -115,7 +115,7 @@ and 'guix publish', something like
(string-drop path 33)
path)))
-(define* (ftp-fetch uri file #:key timeout)
+(define* (ftp-fetch uri file #:key timeout print-build-trace?)
"Fetch data from URI and write it to FILE. Return FILE on success. Bail
out if the connection could not be established in less than TIMEOUT seconds."
(let* ((conn (match (and=> (uri-userinfo uri)
@@ -136,12 +136,17 @@ out if the connection could not be established in less than TIMEOUT seconds."
(lambda (out)
(dump-port* in out
#:buffer-size %http-receive-buffer-size
- #:reporter (progress-reporter/file
- (uri-abbreviation uri) size))))
+ #:reporter
+ (if print-build-trace?
+ (progress-reporter/trace
+ file (uri->string uri) size)
+ (progress-reporter/file
+ (uri-abbreviation uri) size)))))
- (ftp-close conn))
- (newline)
- file)
+ (ftp-close conn)
+ (unless print-build-trace?
+ (newline))
+ file))
;; Autoload GnuTLS so that this module can be used even when GnuTLS is
;; not available. At compile time, this yields "possibly unbound
@@ -723,7 +728,8 @@ Return a list of URIs."
#:key
(timeout 10) (verify-certificate? #t)
(mirrors '()) (content-addressed-mirrors '())
- (hashes '()))
+ (hashes '())
+ print-build-trace?)
"Fetch FILE from URL; URL may be either a single string, or a list of
string denoting alternate URLs for FILE. Return #f on failure, and FILE
on success.
@@ -759,13 +765,18 @@ otherwise simply ignore them."
(lambda (output)
(dump-port* port output
#:buffer-size %http-receive-buffer-size
- #:reporter (progress-reporter/file
- (uri-abbreviation uri) size))
+ #:reporter (if print-build-trace?
+ (progress-reporter/trace
+ file (uri->string uri) size)
+ (progress-reporter/file
+ (uri-abbreviation uri) size)))
(newline)))
file)))
((ftp)
(false-if-exception* (ftp-fetch uri file
- #:timeout timeout)))
+ #:timeout timeout
+ #:print-build-trace?
+ print-build-trace?)))
(else
(format #t "skipping URI with unsupported scheme: ~s~%"
uri)
diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm
index 9f6ecc00d..df787a994 100644
--- a/guix/scripts/perform-download.scm
+++ b/guix/scripts/perform-download.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -41,14 +41,14 @@
(module-use! module (resolve-interface '(guix base32)))
module))
-(define* (perform-download drv #:optional output)
+(define* (perform-download drv #:optional output
+ #:key print-build-trace?)
"Perform the download described by DRV, a fixed-output derivation, to
OUTPUT.
Note: Unless OUTPUT is #f, we don't read the value of 'out' in DRV since the
actual output is different from that when we're doing a 'bmCheck' or
'bmRepair' build."
- ;; TODO: Use 'trace-progress-proc' when possible.
(derivation-let drv ((url "url")
(output* "out")
(executable "executable")
@@ -68,6 +68,7 @@ actual output is different from that when we're doing a 'bmCheck' or
;; We're invoked by the daemon, which gives us write access to OUTPUT.
(when (url-fetch url output
+ #:print-build-trace? print-build-trace?
#:mirrors (if mirrors
(call-with-input-file mirrors read)
'())
@@ -99,6 +100,11 @@ allows us to sidestep bootstrapping problems, such downloading the source code
of GnuTLS over HTTPS, before we have built GnuTLS. See
<http://bugs.gnu.org/22774>."
+ (define print-build-trace?
+ (match (getenv "_NIX_OPTIONS")
+ (#f #f)
+ (str (string-contains str "print-extended-build-trace=1"))))
+
;; This program must be invoked by guix-daemon under an unprivileged UID to
;; prevent things downloading from 'file:///etc/shadow' or arbitrary code
;; execution via the content-addressed mirror procedures. (That means we
@@ -108,10 +114,12 @@ of GnuTLS over HTTPS, before we have built GnuTLS. See
(((? derivation-path? drv) (? store-path? output))
(assert-low-privileges)
(perform-download (read-derivation-from-file drv)
- output))
+ output
+ #:print-build-trace? print-build-trace?))
(((? derivation-path? drv)) ;backward compatibility
(assert-low-privileges)
- (perform-download (read-derivation-from-file drv)))
+ (perform-download (read-derivation-from-file drv)
+ #:print-build-trace? print-build-trace?))
(("--version")
(show-version-and-exit))
(x
diff --git a/nix/libstore/builtins.cc b/nix/libstore/builtins.cc
index a5ebb4773..1f52511c8 100644
--- a/nix/libstore/builtins.cc
+++ b/nix/libstore/builtins.cc
@@ -1,5 +1,5 @@
/* GNU Guix --- Functional package management for GNU
- Copyright (C) 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+ Copyright (C) 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
This file is part of GNU Guix.
@@ -47,6 +47,9 @@ static void builtinDownload(const Derivation &drv,
content-addressed mirrors) works correctly. */
setenv("NIX_STORE", settings.nixStore.c_str(), 1);
+ /* Tell it about options such as "print-extended-build-trace". */
+ setenv("_NIX_OPTIONS", settings.pack().c_str(), 1);
+
/* XXX: Hack our way to use the 'download' script from 'LIBEXECDIR/guix'
or just 'LIBEXECDIR', depending on whether we're running uninstalled or
not. */
--
2.19.0
^ permalink raw reply related [flat|nested] 12+ messages in thread
* [bug#32837] [PATCH 1/5] progress: 'progress-reporter-report!' takes any number of arguments.
2018-09-25 15:32 ` [bug#32837] [PATCH 1/5] progress: 'progress-reporter-report!' takes any number of arguments Ludovic Courtès
` (3 preceding siblings ...)
2018-09-25 15:32 ` [bug#32837] [PATCH 5/5] perform-download: Optionally report a "download-progress" trace Ludovic Courtès
@ 2018-09-26 7:58 ` Danny Milosavljevic
4 siblings, 0 replies; 12+ messages in thread
From: Danny Milosavljevic @ 2018-09-26 7:58 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 32837, Ricardo Wurmus
[-- Attachment #1: Type: text/plain, Size: 7 bytes --]
LGTM!
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]
^ permalink raw reply [flat|nested] 12+ messages in thread
* [bug#32837] [PATCH 2/5] substitute: Progress port really closes underlying port.
2018-09-25 15:32 ` [bug#32837] [PATCH 2/5] substitute: Progress port really closes underlying port Ludovic Courtès
@ 2018-09-26 7:58 ` Danny Milosavljevic
0 siblings, 0 replies; 12+ messages in thread
From: Danny Milosavljevic @ 2018-09-26 7:58 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 32837, Ricardo Wurmus
[-- Attachment #1: Type: text/plain, Size: 7 bytes --]
LGTM!
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]
^ permalink raw reply [flat|nested] 12+ messages in thread
* [bug#32837] [PATCH 3/5] progress: Add 'display-download-progress'.
2018-09-25 15:32 ` [bug#32837] [PATCH 3/5] progress: Add 'display-download-progress' Ludovic Courtès
@ 2018-09-26 7:59 ` Danny Milosavljevic
0 siblings, 0 replies; 12+ messages in thread
From: Danny Milosavljevic @ 2018-09-26 7:59 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 32837, Ricardo Wurmus
[-- Attachment #1: Type: text/plain, Size: 7 bytes --]
LGTM!
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]
^ permalink raw reply [flat|nested] 12+ messages in thread
* [bug#32837] [PATCH 0/5] Improvements to the UI with colors
2018-09-25 15:11 [bug#32837] [PATCH 0/5] Improvements to the UI with colors Ludovic Courtès
2018-09-25 15:32 ` [bug#32837] [PATCH 1/5] progress: 'progress-reporter-report!' takes any number of arguments Ludovic Courtès
@ 2018-09-27 9:59 ` Ludovic Courtès
2018-09-27 16:25 ` Ricardo Wurmus
1 sibling, 1 reply; 12+ messages in thread
From: Ludovic Courtès @ 2018-09-27 9:59 UTC (permalink / raw)
To: 32837; +Cc: Ricardo Wurmus
Hello,
Ludovic Courtès <ludo@gnu.org> skribis:
> Internally everything is handled by the (guix status) module.
> This module keeps track of the on-going and completed builds and
> downloads (substitutes and fixed-output derivations.) To do that
> the build side is modified to print additional machine-readable
> “build traces” (with the new #:print-extended-build-traces? option
> of ‘set-build-options’.)
>
> Old clients talking to the new daemon won’t see the difference
> because build-side code will produce the same output as before.
> New clients talking to an old daemon won’t be able to display
> progress bars and URLs for downloads because the build side
> won’t produce those “extended build traces”; IOW, it should be
> as on current ‘master’.
On IRC, Ricardo noted that the new ‘guix package’ would be very silent
when talking to an old daemon, because it wouldn’t show what gets
substituted.
As per Ricardo’s suggestion, I’ve pushed a fixup commit to ‘wip-ui’ that
(1) bumps the daemon protocol version, and (2) checks whether the
daemon supports “extended build traces.” If it does not support
extended build traces, then “substituting…” messages are displayed, as
is the case with ‘guix package’ on master.
Let me know what you think! I’d be happy to go ahead with this variant
soon. :-)
Ludo’.
^ permalink raw reply [flat|nested] 12+ messages in thread
* [bug#32837] [PATCH 0/5] Improvements to the UI with colors
2018-09-27 9:59 ` [bug#32837] [PATCH 0/5] Improvements to the UI with colors Ludovic Courtès
@ 2018-09-27 16:25 ` Ricardo Wurmus
2018-09-27 22:31 ` bug#32837: " Ludovic Courtès
0 siblings, 1 reply; 12+ messages in thread
From: Ricardo Wurmus @ 2018-09-27 16:25 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 32837
Hello!
> Let me know what you think! I’d be happy to go ahead with this variant
> soon. :-)
I really like this patch series. It implements a very flexible
mechanism that allows us to track the build state more accurately. In
fact, it would enable a GUI developer to display the build progress in
an intuitive way that is a few steps removed from the raw build log
style.
I noticed a few typos in patch 4/5:
> + ;; sot there's nothing left to do.
s/sot /so /
> +procedure computes the new build status upon each even and call ON-CHANGE:
s/even /event /
s/call /calls /
As to the way we display build progress: we can improve on that later.
The mechanism proposed in this patch series is very nice and I’d love to
see it merged soon.
Thank you!
--
Ricardo
^ permalink raw reply [flat|nested] 12+ messages in thread
* bug#32837: [PATCH 0/5] Improvements to the UI with colors
2018-09-27 16:25 ` Ricardo Wurmus
@ 2018-09-27 22:31 ` Ludovic Courtès
0 siblings, 0 replies; 12+ messages in thread
From: Ludovic Courtès @ 2018-09-27 22:31 UTC (permalink / raw)
To: Ricardo Wurmus; +Cc: 32837-done
Hello,
Ricardo Wurmus <rekado@elephly.net> skribis:
>> Let me know what you think! I’d be happy to go ahead with this variant
>> soon. :-)
>
> I really like this patch series. It implements a very flexible
> mechanism that allows us to track the build state more accurately. In
> fact, it would enable a GUI developer to display the build progress in
> an intuitive way that is a few steps removed from the raw build log
> style.
Yeah, that’s my hope too. We would need Fibers/coroutines to make a
neat (G)UI, and also better multiplexing of build logs when max-jobs > 1
(the “extended build traces” are not full proof: we can’t guarantee
they’ll appear at the beginning of a line currently), but it’s a first
step.
> I noticed a few typos in patch 4/5:
Fixed!
Thanks Danny for reviewing, and thank you Ricardo for reviewing,
testing, and for the suggestions, which led to a much improved patch!
> As to the way we display build progress: we can improve on that later.
> The mechanism proposed in this patch series is very nice and I’d love to
> see it merged soon.
I have a snippet here to estimate build time based on past build logs,
we’ll see…
I’ve pushed the patches as 240a9c69a6064544a616acc521c993542c364948,
with a daemon update in 5abcb1b0e6fe849d206b3683444c76d91f21a3d4.
Bug reports & suggestions welcome!
Ludo’.
^ permalink raw reply [flat|nested] 12+ messages in thread
end of thread, other threads:[~2018-09-27 22:33 UTC | newest]
Thread overview: 12+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2018-09-25 15:11 [bug#32837] [PATCH 0/5] Improvements to the UI with colors Ludovic Courtès
2018-09-25 15:32 ` [bug#32837] [PATCH 1/5] progress: 'progress-reporter-report!' takes any number of arguments Ludovic Courtès
2018-09-25 15:32 ` [bug#32837] [PATCH 2/5] substitute: Progress port really closes underlying port Ludovic Courtès
2018-09-26 7:58 ` Danny Milosavljevic
2018-09-25 15:32 ` [bug#32837] [PATCH 3/5] progress: Add 'display-download-progress' Ludovic Courtès
2018-09-26 7:59 ` Danny Milosavljevic
2018-09-25 15:32 ` [bug#32837] [PATCH 4/5] Add (guix status) and use it for pretty colored output Ludovic Courtès
2018-09-25 15:32 ` [bug#32837] [PATCH 5/5] perform-download: Optionally report a "download-progress" trace Ludovic Courtès
2018-09-26 7:58 ` [bug#32837] [PATCH 1/5] progress: 'progress-reporter-report!' takes any number of arguments Danny Milosavljevic
2018-09-27 9:59 ` [bug#32837] [PATCH 0/5] Improvements to the UI with colors Ludovic Courtès
2018-09-27 16:25 ` Ricardo Wurmus
2018-09-27 22:31 ` bug#32837: " Ludovic Courtès
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).