diff options
| -rw-r--r-- | .dir-locals.el | 1 | ||||
| -rw-r--r-- | build-aux/run-system-tests.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/environment.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/pack.scm | 2 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/pull.scm | 2 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 7 | ||||
| -rw-r--r-- | guix/status.scm | 17 |
8 files changed, 28 insertions, 13 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index 1a3a05f100..593c767d2b 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -61,6 +61,7 @@ (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 'with-status-verbosity 'scheme-indent-function 1)) (eval . (put 'mlambda 'scheme-indent-function 1)) (eval . (put 'mlambdaq 'scheme-indent-function 1)) diff --git a/build-aux/run-system-tests.scm b/build-aux/run-system-tests.scm index 953ba3e221..bcd7547704 100644 --- a/build-aux/run-system-tests.scm +++ b/build-aux/run-system-tests.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -64,7 +64,7 @@ (length tests)) (with-store store - (with-status-report print-build-event + (with-status-verbosity 2 (run-with-store store (mlet* %store-monad ((drv (mapm %store-monad system-test-value tests)) (out -> (map derivation->output-path drv))) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 86e1eb115f..9461d04976 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015, 2018 David Thompson <davet@gnu.org> -;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Mike Gerwitz <mtg@gnu.org> ;;; ;;; This file is part of GNU Guix. @@ -674,7 +674,7 @@ message if any test fails." (leave (G_ "'--user' cannot be used without '--container'~%"))) (with-store store - (with-status-report print-build-event + (with-status-verbosity 1 (define manifest (options/resolve-packages store opts)) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index e137fb136a..d9e0050159 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -772,7 +772,7 @@ Create a bundle of PACKAGE.\n")) (with-error-handling (with-store store - (with-status-report print-build-event + (with-status-verbosity 2 ;; Set the build options before we do anything else. (set-build-options-from-command-line store opts) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 5743816324..876787fbe2 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2013, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com> @@ -914,7 +914,7 @@ processed, #f otherwise." (or (process-query opts) (parameterize ((%store (open-connection)) (%graft? (assoc-ref opts 'graft?))) - (with-status-report print-build-event/quiet + (with-status-verbosity 1 (set-build-options-from-command-line (%store) opts) (parameterize ((%guile-for-build (package-derivation diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index e7ff44c0d5..6389d5ec09 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -510,7 +510,7 @@ Use '~/.config/guix/channels.scm' instead.")) (process-query opts profile)) (else (with-store store - (with-status-report print-build-event + (with-status-verbosity 2 (parameterize ((%current-system (assoc-ref opts 'system)) (%graft? (assoc-ref opts 'graft?)) (%repository-cache-directory cache)) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 6cda3ccbd6..9e31baaddb 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016, 2017, 2018 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> @@ -1267,9 +1267,8 @@ argument list and OPTS is the option alist." (args (option-arguments opts)) (command (assoc-ref opts 'action))) (parameterize ((%graft? (assoc-ref opts 'graft?))) - (with-status-report (if (memq command '(init reconfigure)) - print-build-event/quiet - print-build-event) + (with-status-verbosity (if (memq command '(init reconfigure)) + 1 2) (process-command command args opts)))))) ;;; Local Variables: diff --git a/guix/status.scm b/guix/status.scm index 1a7cb313ea..2928733257 100644 --- a/guix/status.scm +++ b/guix/status.scm @@ -63,7 +63,8 @@ print-build-event/quiet print-build-status - with-status-report)) + with-status-report + with-status-verbosity)) ;;; Commentary: ;;; @@ -649,3 +650,17 @@ The second return value is a thunk to retrieve the current state." "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 ...))) + +(define (logger-for-level level) + "Return the logging procedure that corresponds to LEVEL." + (cond ((<= level 0) (const #t)) + ((= level 1) print-build-event/quiet) + (else print-build-event))) + +(define (call-with-status-verbosity level thunk) + (call-with-status-report (logger-for-level level) thunk)) + +(define-syntax-rule (with-status-verbosity level exp ...) + "Set up build status reporting to the user at the given LEVEL: 0 means +silent, 1 means quiet, 2 means verbose. Evaluate EXP... in that context." + (call-with-status-verbosity level (lambda () exp ...))) |