pull: Display new/upgraded packages upon completion.

* guix/scripts/pull.scm (display-profile-news): New procedure.
(build-and-install): Call it.
(display-new/upgraded-packages): Add #:heading and honor it.
master
Ludovic Courtès 2018-07-13 16:59:15 +02:00
parent dc733e6a12
commit bca302c67a
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 31 additions and 4 deletions

View File

@ -33,6 +33,7 @@
#:autoload (guix inferior) (open-inferior) #:autoload (guix inferior) (open-inferior)
#:use-module (guix scripts build) #:use-module (guix scripts build)
#:autoload (guix self) (whole-package) #:autoload (guix self) (whole-package)
#:use-module (gnu packages)
#:autoload (gnu packages ssh) (guile-ssh) #:autoload (gnu packages ssh) (guile-ssh)
#:autoload (gnu packages tls) (gnutls) #:autoload (gnu packages tls) (gnutls)
#:use-module ((guix scripts package) #:select (build-and-use-profile)) #:use-module ((guix scripts package) #:select (build-and-use-profile))
@ -234,12 +235,32 @@ URL, BRANCH, and COMMIT as a property in the manifest entry."
(branch ,branch) (branch ,branch)
(commit ,commit)))))))))) (commit ,commit))))))))))
(define (display-profile-news profile)
"Display what's up in PROFILE--new packages, and all that."
(match (memv (generation-number profile)
(reverse (profile-generations profile)))
((current previous _ ...)
(newline)
(let ((old (fold-packages (lambda (package result)
(alist-cons (package-name package)
(package-version package)
result))
'()))
(new (profile-package-alist
(generation-file-name profile current))))
(display-new/upgraded-packages old new
#:heading (G_ "New in this revision:\n"))))
(_ #t)))
(define* (build-and-install source config-dir (define* (build-and-install source config-dir
#:key verbose? url branch commit) #:key verbose? url branch commit)
"Build the tool from SOURCE, and install it in CONFIG-DIR." "Build the tool from SOURCE, and install it in CONFIG-DIR."
(define update-profile (define update-profile
(store-lift build-and-use-profile)) (store-lift build-and-use-profile))
(define profile
(string-append config-dir "/current"))
(mlet* %store-monad ((drv (build-from-source source (mlet* %store-monad ((drv (build-from-source source
#:commit commit #:commit commit
#:verbose? verbose?)) #:verbose? verbose?))
@ -247,8 +268,9 @@ URL, BRANCH, and COMMIT as a property in the manifest entry."
#:url url #:url url
#:branch branch #:branch branch
#:commit commit))) #:commit commit)))
(update-profile (string-append config-dir "/current") (mbegin %store-monad
(manifest (list entry))))) (update-profile profile (manifest (list entry)))
(return (display-profile-news profile)))))
(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."
@ -341,9 +363,11 @@ way and displaying details about the channel's source code."
(close-inferior inferior) (close-inferior inferior)
packages)))) packages))))
(define (display-new/upgraded-packages alist1 alist2) (define* (display-new/upgraded-packages alist1 alist2
#:key (heading ""))
"Given the two package name/version alists ALIST1 and ALIST2, display the "Given the two package name/version alists ALIST1 and ALIST2, display the
list of new and upgraded packages going from ALIST1 to ALIST2." list of new and upgraded packages going from ALIST1 to ALIST2. When ALIST1
and ALIST2 differ, display HEADING upfront."
(let* ((old (fold (match-lambda* (let* ((old (fold (match-lambda*
(((name . version) table) (((name . version) table)
(vhash-cons name version table))) (vhash-cons name version table)))
@ -363,6 +387,9 @@ list of new and upgraded packages going from ALIST1 to ALIST2."
(string-append name "@" (string-append name "@"
new-version)))))) new-version))))))
alist2))) alist2)))
(unless (and (null? new) (null? upgraded))
(display heading))
(match (length new) (match (length new)
(0 #t) (0 #t)
(count (count