futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

guix package, pull: Use 'with-build-handler'.

Browse Source 
* guix/scripts/package.scm (build-and-use-profile): Remove #:dry-run?
and #:use-substitutes?.  Remove call to 'show-what-to-build' and
'dry-run?' special case.
(process-actions): Adjust accordingly.
(guix-package*): Wrap 'parameterize' in 'with-build-handler'.
* guix/scripts/pull.scm (build-and-install): Remove #:use-substitutes?
and #:dry-run? and adjust 'update-profile' call accordingly.  Remove
'dry-run?' conditional.
(guix-pull): Wrap body in 'with-build-handler'.
This commit is contained in:
Ludovic Courtès 2020-03-19 10:42:28 +01:00
parent 5f5e9a5cd6
commit 65ffb9388c
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 71 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
guix/scripts/package.scm
View File

@ -132,8 +132,7 @@ denote ranges as interpreted by 'matching-generations'."
#:key #:key
(hooks %default-profile-hooks) (hooks %default-profile-hooks)
allow-collisions? allow-collisions?
bootstrap? use-substitutes? bootstrap?)
dry-run?)
"Build a new generation of PROFILE, a file name, using the packages "Build a new generation of PROFILE, a file name, using the packages
specified in MANIFEST, a manifest object. When ALLOW-COLLISIONS? is true, specified in MANIFEST, a manifest object. When ALLOW-COLLISIONS? is true,
do not treat collisions in MANIFEST as an error. HOOKS is a list of \"profile do not treat collisions in MANIFEST as an error. HOOKS is a list of \"profile
@ -144,12 +143,8 @@ hooks\" run when building the profile."
#:hooks (if bootstrap? '() hooks) #:hooks (if bootstrap? '() hooks)
#:locales? (not bootstrap?)))) #:locales? (not bootstrap?))))
(prof (derivation->output-path prof-drv))) (prof (derivation->output-path prof-drv)))
(show-what-to-build store (list prof-drv)
#:use-substitutes? use-substitutes?
#:dry-run? dry-run?)
(cond (cond
(dry-run? #t)
((and (file-exists? profile) ((and (file-exists? profile)
(and=> (readlink* profile) (cut string=? prof <>))) (and=> (readlink* profile) (cut string=? prof <>)))
(format (current-error-port) (G_ "nothing to be done~%"))) (format (current-error-port) (G_ "nothing to be done~%")))
@ -920,9 +915,7 @@ processed, #f otherwise."
#:dry-run? dry-run?) #:dry-run? dry-run?)
(build-and-use-profile store profile new (build-and-use-profile store profile new
#:allow-collisions? allow-collisions? #:allow-collisions? allow-collisions?
#:bootstrap? bootstrap? #:bootstrap? bootstrap?)))))
#:use-substitutes? substitutes?
#:dry-run? dry-run?)))))
;;; ;;;
@ -951,10 +944,14 @@ option processing with 'parse-command-line'."
(%graft? (assoc-ref opts 'graft?))) (%graft? (assoc-ref opts 'graft?)))
(with-status-verbosity (assoc-ref opts 'verbosity) (with-status-verbosity (assoc-ref opts 'verbosity)
(set-build-options-from-command-line (%store) opts) (set-build-options-from-command-line (%store) opts)
(parameterize ((%guile-for-build (with-build-handler (build-notifier #:use-substitutes?
(package-derivation (assoc-ref opts 'substitutes?)
(%store) #:dry-run?
(if (assoc-ref opts 'bootstrap?) (assoc-ref opts 'dry-run?))
%bootstrap-guile (parameterize ((%guile-for-build
(canonical-package guile-2.2))))) (package-derivation
(process-actions (%store) opts))))))) (%store)
(if (assoc-ref opts 'bootstrap?)
%bootstrap-guile
(canonical-package guile-2.2)))))
(process-actions (%store) opts))))))))

118
guix/scripts/pull.scm
View File

@ -389,8 +389,7 @@ previous generation. Return true if there are news to display."
(display-channel-news profile)) (display-channel-news profile))
(define* (build-and-install instances profile (define* (build-and-install instances profile)
#:key use-substitutes? dry-run?)
"Build the tool from SOURCE, and install it in PROFILE. When DRY-RUN? is "Build the tool from SOURCE, and install it in PROFILE. When DRY-RUN? is
true, display what would be built without actually building it." true, display what would be built without actually building it."
(define update-profile (define update-profile
@ -403,29 +402,27 @@ true, display what would be built without actually building it."
(mlet %store-monad ((manifest (channel-instances->manifest instances))) (mlet %store-monad ((manifest (channel-instances->manifest instances)))
(mbegin %store-monad (mbegin %store-monad
(update-profile profile manifest (update-profile profile manifest
#:use-substitutes? use-substitutes? #:hooks %channel-profile-hooks)
#:hooks %channel-profile-hooks
#:dry-run? dry-run?) (return
(munless dry-run? (let ((more? (list (display-profile-news profile #:concise? #t)
(return (newline)) (display-channel-news-headlines profile))))
(return (newline)
(let ((more? (list (display-profile-news profile #:concise? #t) (when (any ->bool more?)
(display-channel-news-headlines profile)))) (display-hint
(when (any ->bool more?) (G_ "Run @command{guix pull --news} to read all the news.")))))
(display-hint (if guix-command
(G_ "Run @command{guix pull --news} to read all the news."))))) (let ((new (map (cut string-append <> "/bin/guix")
(if guix-command (list (user-friendly-profile profile)
(let ((new (map (cut string-append <> "/bin/guix") profile))))
(list (user-friendly-profile profile) ;; Is the 'guix' command previously in $PATH the same as the new
profile)))) ;; one? If the answer is "no", then suggest 'hash guix'.
;; Is the 'guix' command previously in $PATH the same as the new (unless (member guix-command new)
;; one? If the answer is "no", then suggest 'hash guix'. (display-hint (format #f (G_ "After setting @code{PATH}, run
(unless (member guix-command new)
(display-hint (format #f (G_ "After setting @code{PATH}, run
@command{hash guix} to make sure your shell refers to @file{~a}.") @command{hash guix} to make sure your shell refers to @file{~a}.")
(first new)))) (first new))))
(return #f)) (return #f))
(return #f)))))) (return #f)))))
(define (honor-lets-encrypt-certificates! store) (define (honor-lets-encrypt-certificates! store)
"Tell Guile-Git to use the Let's Encrypt certificates." "Tell Guile-Git to use the Let's Encrypt certificates."
@ -760,10 +757,12 @@ Use '~/.config/guix/channels.scm' instead."))
(define (guix-pull . args) (define (guix-pull . args)
(with-error-handling (with-error-handling
(with-git-error-handling (with-git-error-handling
(let* ((opts (parse-command-line args %options (let* ((opts (parse-command-line args %options
(list %default-options))) (list %default-options)))
(channels (channel-list opts)) (substitutes? (assoc-ref opts 'substitutes?))
(profile (or (assoc-ref opts 'profile) %current-profile))) (dry-run? (assoc-ref opts 'dry-run?))
(channels (channel-list opts))
(profile (or (assoc-ref opts 'profile) %current-profile)))
(cond ((assoc-ref opts 'query) (cond ((assoc-ref opts 'query)
(process-query opts profile)) (process-query opts profile))
((assoc-ref opts 'generation) ((assoc-ref opts 'generation)
@ -773,38 +772,37 @@ Use '~/.config/guix/channels.scm' instead."))
(with-status-verbosity (assoc-ref opts 'verbosity) (with-status-verbosity (assoc-ref opts 'verbosity)
(parameterize ((%current-system (assoc-ref opts 'system)) (parameterize ((%current-system (assoc-ref opts 'system))
(%graft? (assoc-ref opts 'graft?))) (%graft? (assoc-ref opts 'graft?)))
(set-build-options-from-command-line store opts) (with-build-handler (build-notifier #:use-substitutes?
(ensure-default-profile) substitutes?
(honor-x509-certificates store) #:dry-run? dry-run?)
(set-build-options-from-command-line store opts)
(ensure-default-profile)
(honor-x509-certificates store)
(let ((instances (latest-channel-instances store channels))) (let ((instances (latest-channel-instances store channels)))
(format (current-error-port) (format (current-error-port)
(N_ "Building from this channel:~%" (N_ "Building from this channel:~%"
"Building from these channels:~%" "Building from these channels:~%"
(length instances))) (length instances)))
(for-each (lambda (instance) (for-each (lambda (instance)
(let ((channel (let ((channel
(channel-instance-channel instance))) (channel-instance-channel instance)))
(format (current-error-port) (format (current-error-port)
" ~10a~a\t~a~%" " ~10a~a\t~a~%"
(channel-name channel) (channel-name channel)
(channel-url channel) (channel-url channel)
(string-take (string-take
(channel-instance-commit instance) (channel-instance-commit instance)
7)))) 7))))
instances) instances)
(parameterize ((%guile-for-build (parameterize ((%guile-for-build
(package-derivation (package-derivation
store store
(if (assoc-ref opts 'bootstrap?) (if (assoc-ref opts 'bootstrap?)
%bootstrap-guile %bootstrap-guile
(canonical-package guile-2.2))))) (canonical-package guile-2.2)))))
(with-profile-lock profile (with-profile-lock profile
(run-with-store store (run-with-store store
(build-and-install instances profile (build-and-install instances profile)))))))))))))))
#:dry-run?
(assoc-ref opts 'dry-run?)
#:use-substitutes?
(assoc-ref opts 'substitutes?)))))))))))))))
;;; pull.scm ends here ;;; pull.scm ends here