aboutsummaryrefslogtreecommitdiff
path: root/guix/scripts/pull.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/scripts/pull.scm')
-rw-r--r--guix/scripts/pull.scm35
1 files changed, 31 insertions, 4 deletions
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index aa77434334..433502b5de 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -33,6 +33,7 @@
#:autoload (guix inferior) (open-inferior)
#:use-module (guix scripts build)
#:autoload (guix self) (whole-package)
+ #:use-module (gnu packages)
#:autoload (gnu packages ssh) (guile-ssh)
#:autoload (gnu packages tls) (gnutls)
#: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)
(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
#:key verbose? url branch commit)
"Build the tool from SOURCE, and install it in CONFIG-DIR."
(define update-profile
(store-lift build-and-use-profile))
+ (define profile
+ (string-append config-dir "/current"))
+
(mlet* %store-monad ((drv (build-from-source source
#:commit commit
#:verbose? verbose?))
@@ -247,8 +268,9 @@ URL, BRANCH, and COMMIT as a property in the manifest entry."
#:url url
#:branch branch
#:commit commit)))
- (update-profile (string-append config-dir "/current")
- (manifest (list entry)))))
+ (mbegin %store-monad
+ (update-profile profile (manifest (list entry)))
+ (return (display-profile-news profile)))))
(define (honor-lets-encrypt-certificates! store)
"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)
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
-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*
(((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 "@"
new-version))))))
alist2)))
+ (unless (and (null? new) (null? upgraded))
+ (display heading))
+
(match (length new)
(0 #t)
(count