From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:35003) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fcvp3-0005U2-VJ for guix-patches@gnu.org; Tue, 10 Jul 2018 12:49:07 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fcvp2-0000E8-4X for guix-patches@gnu.org; Tue, 10 Jul 2018 12:49:06 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:46366) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1fcvp2-0000Dx-1y for guix-patches@gnu.org; Tue, 10 Jul 2018 12:49:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1fcvp1-0001dw-SD for guix-patches@gnu.org; Tue, 10 Jul 2018 12:49:03 -0400 Subject: [bug#32115] [PATCH 2/2] pull: Use (guix inferior) to display new and upgraded packages. Resent-Message-ID: From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Tue, 10 Jul 2018 18:48:08 +0200 Message-Id: <20180710164809.20285-5-ludo@gnu.org> In-Reply-To: <20180710164809.20285-1-ludo@gnu.org> References: <20180710164809.20285-1-ludo@gnu.org> List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 32115@debbugs.gnu.org * guix/scripts/pull.scm (display-profile-content): Call 'display-generation'. (display-profile-content-diff): New procedure. (process-query)[list-generation]: Remove. [list-generations]: New procedure. Adjust accordingly. * doc/guix.texi (Invoking guix pull): Update example of '-l'. --- doc/guix.texi | 6 +++ guix/scripts/pull.scm | 91 +++++++++++++++++++++++++++++++++++++------ 2 files changed, 86 insertions(+), 11 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index e93b320e8..3e4bceb8a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2786,12 +2786,18 @@ Generation 2 Jun 11 2018 11:02:49 repository URL: https://git.savannah.gnu.org/git/guix.git branch: origin/master commit: e0cc7f669bec22c37481dd03a7941c7d11a64f1d + 2 new packages: keepalived, libnfnetlink + 6 packages upgraded: emacs-nix-mode@@2.0.4, + guile2.0-guix@@0.14.0-12.77a1aac, guix@@0.14.0-12.77a1aac, + heimdal@@7.5.0, milkytracker@@1.02.00, nix@@2.0.4 Generation 3 Jun 13 2018 23:31:07 (current) guix 844cc1c repository URL: https://git.savannah.gnu.org/git/guix.git branch: origin/master commit: 844cc1c8f394f03b404c5bb3aee086922373490c + 28 new packages: emacs-helm-ls-git, emacs-helm-mu, @dots{} + 69 packages upgraded: borg@@1.1.6, cheese@@3.28.0, @dots{} @end example This @code{~/.config/guix/current} profile works like any other profile diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 7202e3cc1..c61432b04 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -29,6 +29,7 @@ #:use-module (guix gexp) #:use-module (guix grafts) #:use-module (guix monads) + #:autoload (guix inferior) (open-inferior) #:use-module (guix scripts build) #:autoload (guix self) (whole-package) #:autoload (gnu packages ssh) (guile-ssh) @@ -45,9 +46,11 @@ #:use-module ((gnu packages certs) #:select (le-certs)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-35) #:use-module (srfi srfi-37) #:use-module (ice-9 match) + #:use-module (ice-9 vlist) #:export (guix-pull)) (module-autoload! (resolve-module '(guix scripts pull)) @@ -289,6 +292,7 @@ certificates~%")) (define (display-profile-content profile number) "Display the packages in PROFILE, generation NUMBER, in a human-readable way and displaying details about the channel's source code." + (display-generation profile number) (for-each (lambda (entry) (format #t " ~a ~a~%" (manifest-entry-name entry) @@ -310,6 +314,68 @@ way and displaying details about the channel's source code." (manifest-entries (profile-manifest (generation-file-name profile number)))))) +(define (indented-string str indent) + "Return STR with each newline preceded by IDENT spaces." + (define indent-string + (make-list indent #\space)) + + (list->string + (string-fold-right (lambda (chr result) + (if (eqv? chr #\newline) + (cons chr (append indent-string result)) + (cons chr result))) + '() + str))) + +(define (display-profile-content-diff profile gen1 gen2) + "Display the changes in PROFILE GEN2 compared to generation GEN1." + (define (package-alist generation) + (fold (lambda (package lst) + (alist-cons (inferior-package-name package) + (inferior-package-version package) + lst)) + '() + (let* ((directory (generation-file-name profile generation)) + (inferior (open-inferior directory)) + (packages (inferior-packages inferior))) + (close-inferior inferior) + packages))) + + (display-profile-content profile gen2) + (let* ((gen1 (fold (match-lambda* + (((name . version) table) + (vhash-cons name version table))) + vlist-null + (package-alist gen1))) + (gen2 (package-alist gen2)) + (new (remove (match-lambda + ((name . _) + (vhash-assoc name gen1))) + gen2)) + (upgraded (filter-map (match-lambda + ((name . new-version) + (match (vhash-fold* cons '() name gen1) + (() #f) + ((= (cut sort <> version>?) old-versions) + (and (version>? new-version + (first old-versions)) + (string-append name "@" + new-version)))))) + gen2))) + (unless (null? new) + (format #t (G_ " ~h new packages: ~a~%") (length new) + (indented-string + (fill-paragraph (string-join (sort (map first new) string (match-lambda (() (exit 1)) ((numbers ...) - (for-each (lambda (generation) - (list-generation display-profile-content generation)) - numbers))))))))) + (list-generations profile numbers))))))))) (define (guix-pull . args) -- 2.18.0