summaryrefslogtreecommitdiff
path: root/guix/ui.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-03-18 22:19:05 +0100
committerLudovic Courtès <ludo@gnu.org>2020-03-22 12:42:51 +0100
commit07ce23e011d18460e7ff5553d4ff640f7073075b (patch)
tree5b836b7e59f31dffa0fa22a3aba14c330e2fb4ee /guix/ui.scm
parent041b340da409078951267b6a8c43b27716e6b7ec (diff)
ui: Add a notification build handler.
* guix/ui.scm (build-notifier): New variable.
Diffstat (limited to 'guix/ui.scm')
-rw-r--r--guix/ui.scm38
1 files changed, 38 insertions, 0 deletions
diff --git a/guix/ui.scm b/guix/ui.scm
index 6f1ca9c0b2..46286c183d 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -93,6 +93,7 @@
string->number*
size->number
show-derivation-outputs
+ build-notifier
show-what-to-build
show-what-to-build*
show-manifest-transaction
@@ -1045,6 +1046,43 @@ check and report what is prerequisites are available for download."
(define show-what-to-build*
(store-lift show-what-to-build))
+(define* (build-notifier #:key (dry-run? #f) (use-substitutes? #t))
+ "Return a procedure suitable for 'with-build-handler' that, when
+'build-things' is called, invokes 'show-what-to-build' to display the build
+plan. When DRY-RUN? is true, the 'with-build-handler' form returns without
+any build happening."
+ (define not-comma
+ (char-set-complement (char-set #\,)))
+
+ (define (read-derivation-from-file* item)
+ (catch 'system-error
+ (lambda ()
+ (read-derivation-from-file item))
+ (const #f)))
+
+ (lambda (continue store things mode)
+ (define inputs
+ ;; List of derivation inputs to build. Filter out non-existent '.drv'
+ ;; files because the daemon transparently tries to substitute them.
+ (filter-map (match-lambda
+ (((? derivation-path? drv) . output)
+ (let ((drv (read-derivation-from-file* drv))
+ (outputs (string-tokenize output not-comma)))
+ (and drv (derivation-input drv outputs))))
+ ((? derivation-path? drv)
+ (and=> (read-derivation-from-file* drv)
+ derivation-input))
+ (_
+ #f))
+ things))
+
+ (show-what-to-build store inputs
+ #:dry-run? dry-run?
+ #:use-substitutes? use-substitutes?
+ #:mode mode)
+ (unless dry-run?
+ (continue #t))))
+
(define (right-arrow port)
"Return either a string containing the 'RIGHT ARROW' character, or an ASCII
replacement if PORT is not Unicode-capable."