nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2019-01-09 11:25:11 +01:00
parent 7489207ff7
commit 7804c45b9c
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
8 changed files with 28 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.dir-locals.el
View File

@ -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))

4
build-aux/run-system-tests.scm
View File

@ -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)))

4
guix/scripts/environment.scm
View File

@ -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))

2
guix/scripts/pack.scm
View File

@ -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)

4
guix/scripts/package.scm
View File

@ -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

2
guix/scripts/pull.scm
View File

@ -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))

7
guix/scripts/system.scm
View File

@ -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:

17
guix/status.scm
View File

@ -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 ...)))