From a65177a657b0cb36d45f2e8db574ea9c10f89a1f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 6 Jan 2019 22:02:40 +0100 Subject: maint: Remove 'cond-expand' forms for Guile 2.0. Note: Leave 'cond-expand' forms used in the build-side modules that can run on %BOOTSTRAP-GUILE, which is currently Guile 2.0. * guix/build/compile.scm: Move 'use-modules' clause from 'cond-expand' to 'define-module' form. (%default-optimizations): Remove 'cond-expand'. * guix/build/download.scm (tls-wrap): Remove 'cond-expand'. * guix/build/syscalls.scm: Remove 'cond-expand' form around '%set-automatic-finalization-enabled?!' and 'without-automatic-finalization'. * guix/inferior.scm (port->inferior): Remove 'cond-expand'. * guix/scripts/pack.scm (wrapped-package)[build]: Remove 'cond-expand'. * guix/status.scm (build-event-output-port): Remove 'cond-expand'. * guix/store.scm (open-inet-socket): Remove 'cond-expand'. * guix/ui.scm (install-locale): Remove 'cond-expand'. * tests/status.scm ("current-build-output-port, UTF-8 + garbage"): Remove 'cond-expand'. * tests/store.scm ("current-build-output-port, UTF-8 + garbage"): Remove 'cond-expand'. --- guix/scripts/pack.scm | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) (limited to 'guix/scripts/pack.scm') diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 98b06971bd..e137fb136a 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2017, 2018 Ludovic Courtès +;;; Copyright © 2015, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2017, 2018 Ricardo Wurmus ;;; Copyright © 2018 Konrad Hinsen ;;; Copyright © 2018 Chris Marusich @@ -553,9 +553,7 @@ (define (build-wrapper program) "run.c" "-o" result) (delete-file "run.c"))) - (setvbuf (current-output-port) - (cond-expand (guile-2.2 'line) - (else _IOLBF))) + (setvbuf (current-output-port) 'line) ;; Link the top-level files of PACKAGE so that search paths are ;; properly defined in PROFILE/etc/profile. -- cgit v1.2.3 From 7804c45b9ce5a8edd06452d828249e588ae26263 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 9 Jan 2019 11:25:11 +0100 Subject: status: Add 'with-status-verbosity'. * guix/status.scm (logger-for-level, call-with-status-verbosity): New procedures. (with-status-verbosity): New macro. * guix/scripts/environment.scm (guix-environment): Use 'with-status-verbosity' instead of 'with-status-report'. * guix/scripts/pack.scm (guix-pack): Likewise. * guix/scripts/package.scm (guix-package): Likewise. * guix/scripts/pull.scm (guix-pull): Likewise. * guix/scripts/system.scm (guix-system): Likewise. * build-aux/run-system-tests.scm (run-system-tests): Likewise. --- .dir-locals.el | 1 + build-aux/run-system-tests.scm | 4 ++-- guix/scripts/environment.scm | 4 ++-- guix/scripts/pack.scm | 2 +- guix/scripts/package.scm | 4 ++-- guix/scripts/pull.scm | 2 +- guix/scripts/system.scm | 7 +++---- guix/status.scm | 17 ++++++++++++++++- 8 files changed, 28 insertions(+), 13 deletions(-) (limited to 'guix/scripts/pack.scm') 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 +;;; Copyright © 2016, 2018, 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -64,7 +64,7 @@ (define tests (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 -;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2018 Mike Gerwitz ;;; ;;; This file is part of GNU Guix. @@ -674,7 +674,7 @@ (define (guix-environment . args) (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 @@ (define (manifest-from-args store opts) (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 +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2013, 2015 Mark H Weaver ;;; Copyright © 2014, 2016 Alex Kost @@ -914,7 +914,7 @@ (define verbose? (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 @@ (define (guix-pull . args) (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 +;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2016 Alex Kost ;;; Copyright © 2016, 2017, 2018 Chris Marusich ;;; Copyright © 2017 Mathieu Othacehe @@ -1267,9 +1267,8 @@ (define (fail) (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 @@ (define-module (guix status) print-build-event/quiet print-build-status - with-status-report)) + with-status-report + with-status-verbosity)) ;;; Commentary: ;;; @@ -649,3 +650,17 @@ (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 ...))) + +(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 ...))) -- cgit v1.2.3 From f1de676ea82c2bed9a435fce37ade0186296bfc9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 9 Jan 2019 14:17:19 +0100 Subject: guix build: Re-purpose '--verbosity' and add '--debug'. The previous '--verbosity' option was misleading and rarely what users were looking for. The new option provides a consistent way to choose whether or not to display the build log. * guix/scripts/build.scm (show-build-options-help): Remove "--verbosity" and add "--debug". (set-build-options-from-command-line): Use the 'debug key of OPTS for #:verbosity. (%standard-build-options): Change "verbosity" to "debug". Use 'string->number*' instead of 'string->number'. (%default-options): Change 'verbosity to 'debug and add a 'verbosity key. (show-help): Add '--verbosity'. (%options): Likewise, and change '--quiet' to set the 'verbosity key of RESULT. (guix-build): Use 'with-status-verbosity' instead of parameterizing CURRENT-BUILD-OUTPUT-PORT, honor the 'verbosity key of OPTS, and remove 'quiet?'. * guix/scripts/environment.scm (show-help, %options): Add '--verbosity'. (%default-options): Add 'debug'. (guix-environment): Honor the 'verbosity key of OPTS. * guix/scripts/pack.scm (%default-options): Add 'debug. (%options, show-help): Add '--verbosity'. (guix-pack): Honor the 'verbosity key of OPTS. * guix/scripts/package.scm (%default-options): Add 'debug. (show-help, %options): Add '--verbosity'. Mark '--verbose' as deprecated and change it to set 'verbosity. (guix-package): Honor the 'verbosity key of OPTS and remove 'verbose?'. * guix/scripts/pull.scm (%default-options): Add 'debug. (show-help, %options): Add '--verbosity'. (guix-pull): Honor the 'verbosity key of OPTS. * guix/scripts/system.scm (show-help, %options): Add '--verbosity'. (%default-options): Add 'debug. (guix-system): Honor the 'verbosity key of OPTS. * guix/scripts/archive.scm (%default-options): Add 'debug, 'print-build-trace?, 'print-extended-build-trace?, and 'multiplexed-build-output?. (show-help, %options): Add '--verbosity'. (export-from-store): Remove call to 'set-build-options-from-command-line'. (guix-archive): Wrap body in 'with-status-verbosity'. Add call to 'set-build-options-from-command-line. * doc/guix.texi (Common Build Options): Document '--verbosity' and '--debug'. (Additional Build Options): Adjust description of '--quiet'. --- doc/guix.texi | 28 +++++---- guix/scripts/archive.scm | 55 ++++++++++------- guix/scripts/build.scm | 140 ++++++++++++++++++++++--------------------- guix/scripts/environment.scm | 12 +++- guix/scripts/pack.scm | 12 +++- guix/scripts/package.scm | 21 ++++--- guix/scripts/pull.scm | 12 +++- guix/scripts/system.scm | 15 ++++- 8 files changed, 178 insertions(+), 117 deletions(-) (limited to 'guix/scripts/pack.scm') diff --git a/doc/guix.texi b/doc/guix.texi index ed7723c00b..2039ff67cf 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2101,10 +2101,6 @@ By default, @command{guix package} reports as an error @dfn{collisions} in the profile. Collisions happen when two or more different versions or variants of a given package end up in the profile. -@item --verbose -Produce verbose output. In particular, emit the build log of the -environment on the standard error port. - @item --bootstrap Use the bootstrap Guile to build the profile. This option is only useful to distribution developers. @@ -6363,10 +6359,15 @@ Likewise, when the build or substitution process lasts for more than By default, the daemon's setting is honored (@pxref{Invoking guix-daemon, @code{--timeout}}). -@item --verbosity=@var{level} -Use the given verbosity level. @var{level} must be an integer between 0 -and 5; higher means more verbose output. Setting a level of 4 or more -may be helpful when debugging setup issues with the build daemon. +@c Note: This option is actually not part of %standard-build-options but +@c most programs honor it. +@cindex verbosity, of the command-line tools +@cindex build logs, verbosity +@item -v @var{level} +@itemx --verbosity=@var{level} +Use the given verbosity @var{level}, an integer. Choosing 0 means that no +output is produced, 1 is for quiet output, and 2 shows all the build log +output on standard error. @item --cores=@var{n} @itemx -c @var{n} @@ -6379,6 +6380,11 @@ Allow at most @var{n} build jobs in parallel. @xref{Invoking guix-daemon, @code{--max-jobs}}, for details about this option and the equivalent @command{guix-daemon} option. +@item --debug=@var{level} +Produce debugging output coming from the build daemon. @var{level} must be an +integer between 0 and 5; higher means more verbose output. Setting a level of +4 or more may be helpful when debugging setup issues with the build daemon. + @end table Behind the scenes, @command{guix build} is essentially an interface to @@ -6547,9 +6553,9 @@ build}. @item --quiet @itemx -q -Build quietly, without displaying the build log. Upon completion, the -build log is kept in @file{/var} (or similar) and can always be -retrieved using the @option{--log-file} option. +Build quietly, without displaying the build log; this is equivalent to +@code{--verbosity=0}. Upon completion, the build log is kept in @file{/var} +(or similar) and can always be retrieved using the @option{--log-file} option. @item --file=@var{file} @itemx -f @var{file} diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index fb2f61ce30..950f0f41d8 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,6 +23,7 @@ (define-module (guix scripts archive) #:use-module ((guix build utils) #:select (mkdir-p)) #:use-module ((guix serialization) #:select (restore-file)) #:use-module (guix store) + #:use-module (guix status) #:use-module (guix grafts) #:use-module (guix packages) #:use-module (guix derivations) @@ -55,7 +56,11 @@ (define %default-options (substitutes? . #t) (build-hook? . #t) (graft? . #t) - (verbosity . 0))) + (print-build-trace? . #t) + (print-extended-build-trace? . #t) + (multiplexed-build-output? . #t) + (verbosity . 2) + (debug . 0))) (define (show-help) (display (G_ "Usage: guix archive [OPTION]... PACKAGE... @@ -85,6 +90,8 @@ (define (show-help) -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) (display (G_ " --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\"")) + (display (G_ " + -v, --verbosity=LEVEL use the given verbosity LEVEL")) (newline) (show-build-options-help) @@ -161,6 +168,11 @@ (define %options (option '(#\e "expression") #t #f (lambda (opt name arg result) (alist-cons 'expression arg result))) + (option '(#\v "verbosity") #t #f + (lambda (opt name arg result) + (let ((level (string->number* arg))) + (alist-cons 'verbosity level + (alist-delete 'verbosity result))))) (option '(#\n "dry-run") #f #f (lambda (opt name arg result) (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) @@ -239,7 +251,6 @@ (define (export-from-store store opts) resulting archive to the standard output port." (let-values (((drv files) (options->derivations+files store opts))) - (set-build-options-from-command-line store opts) (show-what-to-build store drv #:use-substitutes? (assoc-ref opts 'substitutes?) #:dry-run? (assoc-ref opts 'dry-run?)) @@ -329,21 +340,23 @@ (define (lines port) ((assoc-ref opts 'authorize) (authorize-key)) (else - (with-store store - (cond ((assoc-ref opts 'export) - (export-from-store store opts)) - ((assoc-ref opts 'import) - (import-paths store (current-input-port))) - ((assoc-ref opts 'missing) - (let* ((files (lines (current-input-port))) - (missing (remove (cut valid-path? store <>) - files))) - (format #t "~{~a~%~}" missing))) - ((assoc-ref opts 'extract) - => - (lambda (target) - (restore-file (current-input-port) target))) - (else - (leave - (G_ "either '--export' or '--import' \ -must be specified~%")))))))))))) + (with-status-verbosity (assoc-ref opts 'verbosity) + (with-store store + (set-build-options-from-command-line store opts) + (cond ((assoc-ref opts 'export) + (export-from-store store opts)) + ((assoc-ref opts 'import) + (import-paths store (current-input-port))) + ((assoc-ref opts 'missing) + (let* ((files (lines (current-input-port))) + (missing (remove (cut valid-path? store <>) + files))) + (format #t "~{~a~%~}" missing))) + ((assoc-ref opts 'extract) + => + (lambda (target) + (restore-file (current-input-port) target))) + (else + (leave + (G_ "either '--export' or '--import' \ +must be specified~%"))))))))))))) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 564bdf0ced..5a158799ae 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -449,14 +449,14 @@ (define (show-build-options-help) mark the build as failed after SECONDS of silence")) (display (G_ " --timeout=SECONDS mark the build as failed after SECONDS of activity")) - (display (G_ " - --verbosity=LEVEL use the given verbosity LEVEL")) (display (G_ " --rounds=N build N times in a row to detect non-determinism")) (display (G_ " -c, --cores=N allow the use of up to N CPU cores for the build")) (display (G_ " - -M, --max-jobs=N allow at most N build jobs"))) + -M, --max-jobs=N allow at most N build jobs")) + (display (G_ " + --debug=LEVEL produce debugging output at LEVEL"))) (define (set-build-options-from-command-line store opts) "Given OPTS, an alist as returned by 'args-fold' given @@ -479,7 +479,7 @@ (define (set-build-options-from-command-line store opts) (assoc-ref opts 'print-extended-build-trace?) #:multiplexed-build-output? (assoc-ref opts 'multiplexed-build-output?) - #:verbosity (assoc-ref opts 'verbosity))) + #:verbosity (assoc-ref opts 'debug))) (define set-build-options-from-command-line* (store-lift set-build-options-from-command-line)) @@ -553,12 +553,12 @@ (define %standard-build-options (apply values (alist-cons 'timeout (string->number* arg) result) rest))) - (option '("verbosity") #t #f + (option '("debug") #t #f (lambda (opt name arg result . rest) - (let ((level (string->number arg))) + (let ((level (string->number* arg))) (apply values - (alist-cons 'verbosity level - (alist-delete 'verbosity result)) + (alist-cons 'debug level + (alist-delete 'debug result)) rest)))) (option '(#\c "cores") #t #f (lambda (opt name arg result . rest) @@ -590,7 +590,8 @@ (define %default-options (print-build-trace? . #t) (print-extended-build-trace? . #t) (multiplexed-build-output? . #t) - (verbosity . 0))) + (verbosity . 2) + (debug . 0))) (define (show-help) (display (G_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION... @@ -619,6 +620,8 @@ (define (show-help) -r, --root=FILE make FILE a symlink to the result, and register it as a garbage collector root")) (display (G_ " + -v, --verbosity=LEVEL use the given verbosity LEVEL")) + (display (G_ " -q, --quiet do not show the build log")) (display (G_ " --log-file return the log file names for the given derivations")) @@ -694,9 +697,15 @@ (define %options (option '(#\r "root") #t #f (lambda (opt name arg result) (alist-cons 'gc-root arg result))) + (option '(#\v "verbosity") #t #f + (lambda (opt name arg result) + (let ((level (string->number* arg))) + (alist-cons 'verbosity level + (alist-delete 'verbosity result))))) (option '(#\q "quiet") #f #f (lambda (opt name arg result) - (alist-cons 'quiet? #t result))) + (alist-cons 'verbosity 0 + (alist-delete 'verbosity result)))) (option '("log-file") #f #f (lambda (opt name arg result) (alist-cons 'log-file? #t result))) @@ -819,66 +828,59 @@ (define opts (parse-command-line args %options (list %default-options))) - (define quiet? - (assoc-ref opts 'quiet?)) - (with-error-handling ;; Ask for absolute file names so that .drv file names passed from the ;; user to 'read-derivation' are absolute when it returns. (with-fluids ((%file-port-name-canonicalization 'absolute)) - (with-store store - ;; Set the build options before we do anything else. - (set-build-options-from-command-line store opts) - - (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") - (if (assoc-ref opts 'substitutes?) - (or (assoc-ref opts 'substitute-urls) - ;; XXX: This does not necessarily match the - ;; daemon's substitute URLs. - %default-substitute-urls) - '()))) - (items (filter-map (match-lambda - (('argument . (? store-path? file)) - file) - (_ #f)) - opts)) - (roots (filter-map (match-lambda - (('gc-root . root) root) - (_ #f)) - opts))) - - (unless (or (assoc-ref opts 'log-file?) - (assoc-ref opts 'derivations-only?)) - (show-what-to-build store drv - #:use-substitutes? - (assoc-ref opts 'substitutes?) - #:dry-run? (assoc-ref opts 'dry-run?) - #:mode mode)) - - (cond ((assoc-ref opts 'log-file?) - (for-each (cut show-build-log store <> urls) - (delete-duplicates - (append (map derivation-file-name drv) - items)))) - ((assoc-ref opts 'derivations-only?) - (format #t "~{~a~%~}" (map derivation-file-name drv)) - (for-each (cut register-root store <> <>) - (map (compose list derivation-file-name) drv) - roots)) - ((not (assoc-ref opts 'dry-run?)) - (and (build-derivations store drv mode) - (for-each show-derivation-outputs drv) - (for-each (cut register-root store <> <>) - (map (lambda (drv) - (map cdr - (derivation->output-paths drv))) - drv) - roots)))))))))) + (with-status-verbosity (assoc-ref opts 'verbosity) + (with-store store + ;; Set the build options before we do anything else. + (set-build-options-from-command-line store opts) + + (parameterize ((current-terminal-columns (terminal-columns))) + (let* ((mode (assoc-ref opts 'build-mode)) + (drv (options->derivations store opts)) + (urls (map (cut string-append <> "/log") + (if (assoc-ref opts 'substitutes?) + (or (assoc-ref opts 'substitute-urls) + ;; XXX: This does not necessarily match the + ;; daemon's substitute URLs. + %default-substitute-urls) + '()))) + (items (filter-map (match-lambda + (('argument . (? store-path? file)) + file) + (_ #f)) + opts)) + (roots (filter-map (match-lambda + (('gc-root . root) root) + (_ #f)) + opts))) + + (unless (or (assoc-ref opts 'log-file?) + (assoc-ref opts 'derivations-only?)) + (show-what-to-build store drv + #:use-substitutes? + (assoc-ref opts 'substitutes?) + #:dry-run? (assoc-ref opts 'dry-run?) + #:mode mode)) + + (cond ((assoc-ref opts 'log-file?) + (for-each (cut show-build-log store <> urls) + (delete-duplicates + (append (map derivation-file-name drv) + items)))) + ((assoc-ref opts 'derivations-only?) + (format #t "~{~a~%~}" (map derivation-file-name drv)) + (for-each (cut register-root store <> <>) + (map (compose list derivation-file-name) drv) + roots)) + ((not (assoc-ref opts 'dry-run?)) + (and (build-derivations store drv mode) + (for-each show-derivation-outputs drv) + (for-each (cut register-root store <> <>) + (map (lambda (drv) + (map cdr + (derivation->output-paths drv))) + drv) + roots))))))))))) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 9461d04976..116b8dcbce 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -157,6 +157,8 @@ (define (show-help) (display (G_ " --expose=SPEC for containers, expose read-only host file system according to SPEC")) + (display (G_ " + -v, --verbosity=LEVEL use the given verbosity LEVEL")) (display (G_ " --bootstrap use bootstrap binaries to build the environment")) (newline) @@ -179,7 +181,8 @@ (define %default-options (print-build-trace? . #t) (print-extended-build-trace? . #t) (multiplexed-build-output? . #t) - (verbosity . 0))) + (debug . 0) + (verbosity . 2))) (define (tag-package-arg opts arg) "Return a two-element list with the form (TAG ARG) that tags ARG with either @@ -260,6 +263,11 @@ (define %options (option '(#\r "root") #t #f (lambda (opt name arg result) (alist-cons 'gc-root arg result))) + (option '(#\v "verbosity") #t #f + (lambda (opt name arg result) + (let ((level (string->number* arg))) + (alist-cons 'verbosity level + (alist-delete 'verbosity result))))) (option '("bootstrap") #f #f (lambda (opt name arg result) (alist-cons 'bootstrap? #t result))) @@ -674,7 +682,7 @@ (define (guix-environment . args) (leave (G_ "'--user' cannot be used without '--container'~%"))) (with-store store - (with-status-verbosity 1 + (with-status-verbosity (assoc-ref opts 'verbosity) (define manifest (options/resolve-packages store opts)) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index d9e0050159..b19a4ae1b1 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -598,7 +598,8 @@ (define %default-options (print-build-trace? . #t) (print-extended-build-trace? . #t) (multiplexed-build-output? . #t) - (verbosity . 0) + (debug . 0) + (verbosity . 2) (symlinks . ()) (compressor . ,(first %compressors)))) @@ -685,6 +686,11 @@ (define %options (alist-cons 'profile-name arg result)) (_ (leave (G_ "~a: unsupported profile name~%") arg))))) + (option '(#\v "verbosity") #t #f + (lambda (opt name arg result) + (let ((level (string->number* arg))) + (alist-cons 'verbosity level + (alist-delete 'verbosity result))))) (option '("bootstrap") #f #f (lambda (opt name arg result) (alist-cons 'bootstrap? #t result))) @@ -722,6 +728,8 @@ (define (show-help) (display (G_ " --profile-name=NAME populate /var/guix/profiles/.../NAME")) + (display (G_ " + -v, --verbosity=LEVEL use the given verbosity LEVEL")) (display (G_ " --bootstrap use the bootstrap binaries to build the pack")) (newline) @@ -772,7 +780,7 @@ (define (manifest-from-args store opts) (with-error-handling (with-store store - (with-status-verbosity 2 + (with-status-verbosity (assoc-ref opts 'verbosity) ;; 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 876787fbe2..7ff6bfd6d8 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -293,7 +293,8 @@ (define* (display-search-paths entries profiles (define %default-options ;; Alist of default option values. - `((verbosity . 0) + `((verbosity . 1) + (debug . 0) (graft? . #t) (substitutes? . #t) (build-hook? . #t) @@ -346,7 +347,7 @@ (define (show-help) (display (G_ " --bootstrap use the bootstrap Guile to build the profile")) (display (G_ " - --verbose produce verbose output")) + -v, --verbosity=LEVEL use the given verbosity LEVEL")) (newline) (display (G_ " -s, --search=REGEXP search in synopsis and description using REGEXP")) @@ -472,13 +473,21 @@ (define %options (values (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)) #f))) + (option '(#\v "verbosity") #t #f + (lambda (opt name arg result arg-handler) + (let ((level (string->number* arg))) + (values (alist-cons 'verbosity level + (alist-delete 'verbosity result)) + #f)))) (option '("bootstrap") #f #f (lambda (opt name arg result arg-handler) (values (alist-cons 'bootstrap? #t result) #f))) - (option '("verbose") #f #f + (option '("verbose") #f #f ;deprecated (lambda (opt name arg result arg-handler) - (values (alist-cons 'verbose? #t result) + (values (alist-cons 'verbosity 2 + (alist-delete 'verbosity + result)) #f))) (option '("allow-collisions") #f #f (lambda (opt name arg result arg-handler) @@ -907,14 +916,12 @@ (define (handle-argument arg result arg-handler) (define opts (parse-command-line args %options (list %default-options #f) #:argument-handler handle-argument)) - (define verbose? - (assoc-ref opts 'verbose?)) (with-error-handling (or (process-query opts) (parameterize ((%store (open-connection)) (%graft? (assoc-ref opts 'graft?))) - (with-status-verbosity 1 + (with-status-verbosity (assoc-ref opts 'verbosity) (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 6389d5ec09..6d1914f7c2 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -66,7 +66,8 @@ (define %default-options (print-extended-build-trace? . #t) (multiplexed-build-output? . #t) (graft? . #t) - (verbosity . 0))) + (debug . 0) + (verbosity . 2))) (define (show-help) (display (G_ "Usage: guix pull [OPTION]... @@ -89,6 +90,8 @@ (define (show-help) (display (G_ " -n, --dry-run show what would be pulled and built")) (display (G_ " + -v, --verbosity=LEVEL use the given verbosity LEVEL")) + (display (G_ " -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) (display (G_ " --bootstrap use the bootstrap Guile to build the new Guix")) @@ -135,6 +138,11 @@ (define %options (option '(#\n "dry-run") #f #f (lambda (opt name arg result) (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) + (option '(#\v "verbosity") #t #f + (lambda (opt name arg result) + (let ((level (string->number* arg))) + (alist-cons 'verbosity level + (alist-delete 'verbosity result))))) (option '("bootstrap") #f #f (lambda (opt name arg result) (alist-cons 'bootstrap? #t result))) @@ -510,7 +518,7 @@ (define (guix-pull . args) (process-query opts profile)) (else (with-store store - (with-status-verbosity 2 + (with-status-verbosity (assoc-ref opts 'verbosity) (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 9e31baaddb..569b826acd 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -1015,6 +1015,8 @@ (define (show-help) --full-boot for 'vm', make a full boot sequence")) (display (G_ " --skip-checks skip file system and initrd module safety checks")) + (display (G_ " + -v, --verbosity=LEVEL use the given verbosity LEVEL")) (newline) (display (G_ " -h, --help display this help and exit")) @@ -1074,6 +1076,11 @@ (define %options (option '(#\n "dry-run") #f #f (lambda (opt name arg result) (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) + (option '(#\v "verbosity") #t #f + (lambda (opt name arg result) + (let ((level (string->number* arg))) + (alist-cons 'verbosity level + (alist-delete 'verbosity result))))) (option '(#\s "system") #t #f (lambda (opt name arg result) (alist-cons 'system arg @@ -1092,7 +1099,8 @@ (define %default-options (print-extended-build-trace? . #t) (multiplexed-build-output? . #t) (graft? . #t) - (verbosity . 0) + (debug . 0) + (verbosity . #f) ;default (file-system-type . "ext4") (image-size . guess) (install-bootloader? . #t))) @@ -1267,8 +1275,9 @@ (define (fail) (args (option-arguments opts)) (command (assoc-ref opts 'action))) (parameterize ((%graft? (assoc-ref opts 'graft?))) - (with-status-verbosity (if (memq command '(init reconfigure)) - 1 2) + (with-status-verbosity (or (assoc-ref opts 'verbosity) + (if (memq command '(init reconfigure)) + 1 2)) (process-command command args opts)))))) ;;; Local Variables: -- cgit v1.2.3