pack: Use 'with-build-handler'.

* guix/scripts/pack.scm (guix-pack): Wrap 'parameterize' in
'with-build-handler'.  Remove explicit call to 'show-what-to-build'.
Call 'build-derivations' regardless of whether OPTS contains 'dry-run?'.
This commit is contained in:
Ludovic Courtès 2020-03-18 23:00:13 +01:00
parent bdda46a67d
commit 5f5e9a5cd6
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -1022,6 +1022,10 @@ (define with-provenance
;; Set the build options before we do anything else. ;; Set the build options before we do anything else.
(set-build-options-from-command-line store opts) (set-build-options-from-command-line store opts)
(with-build-handler (build-notifier #:dry-run?
(assoc-ref opts 'dry-run?)
#:use-substitutes?
(assoc-ref opts 'substitutes?))
(parameterize ((%graft? (assoc-ref opts 'graft?)) (parameterize ((%graft? (assoc-ref opts 'graft?))
(%guile-for-build (package-derivation (%guile-for-build (package-derivation
store store
@ -1030,8 +1034,7 @@ (define with-provenance
(canonical-package guile-2.2)) (canonical-package guile-2.2))
(assoc-ref opts 'system) (assoc-ref opts 'system)
#:graft? (assoc-ref opts 'graft?)))) #:graft? (assoc-ref opts 'graft?))))
(let* ((dry-run? (assoc-ref opts 'dry-run?)) (let* ((derivation? (assoc-ref opts 'derivation-only?))
(derivation? (assoc-ref opts 'derivation-only?))
(relocatable? (assoc-ref opts 'relocatable?)) (relocatable? (assoc-ref opts 'relocatable?))
(proot? (eq? relocatable? 'proot)) (proot? (eq? relocatable? 'proot))
(manifest (let ((manifest (manifest-from-args store opts))) (manifest (let ((manifest (manifest-from-args store opts)))
@ -1109,15 +1112,10 @@ (define (lookup-package package)
#:archiver #:archiver
archiver))) archiver)))
(mbegin %store-monad (mbegin %store-monad
(munless derivation?
(show-what-to-build* (list drv)
#:use-substitutes?
(assoc-ref opts 'substitutes?)
#:dry-run? dry-run?))
(mwhen derivation? (mwhen derivation?
(return (format #t "~a~%" (return (format #t "~a~%"
(derivation-file-name drv)))) (derivation-file-name drv))))
(munless (or derivation? dry-run?) (munless derivation?
(built-derivations (list drv)) (built-derivations (list drv))
(mwhen gc-root (mwhen gc-root
(register-root* (match (derivation->output-paths drv) (register-root* (match (derivation->output-paths drv)
@ -1126,4 +1124,4 @@ (define (lookup-package package)
gc-root)) gc-root))
(return (format #t "~a~%" (return (format #t "~a~%"
(derivation->output-path drv)))))) (derivation->output-path drv))))))
#:system (assoc-ref opts 'system)))))))) #:system (assoc-ref opts 'system)))))))))