From e95ae7c22373d2ba0e90ade2a46973ae9473d394 Mon Sep 17 00:00:00 2001 From: Roel Janssen Date: Wed, 26 Oct 2016 14:53:29 +0200 Subject: guix package: Display generation diffs. * guix/ui.scm (display-profile-content-diff): New variable. * guix/scripts/package.scm (process-query): Use display-profile-content-diff. In collaboration with Benz Schenk. --- guix/scripts/package.scm | 18 +++++++++++++----- guix/ui.scm | 28 ++++++++++++++++++++++++++++ 2 files changed, 41 insertions(+), 5 deletions(-) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index b87aee0be9..70ed0a7ea6 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -3,6 +3,8 @@ ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2013, 2015 Mark H Weaver ;;; Copyright © 2014, 2016 Alex Kost +;;; Copyright © 2016 Roel Janssen +;;; Copyright © 2016 Benz Schenk ;;; ;;; This file is part of GNU Guix. ;;; @@ -667,24 +669,30 @@ (define (process-query opts) ((head tail ...) head)))) (match (assoc-ref opts 'query) (('list-generations pattern) - (define (list-generation number) + (define (list-generation display-function number) (unless (zero? number) (display-generation profile number) - (display-profile-content profile number) + (display-function profile number) (newline))) - + (define (diff-profiles profile numbers) + (unless (null-list? (cdr numbers)) + (display-profile-content-diff profile (car numbers) (cadr numbers)) + (diff-profiles profile (cdr numbers)))) (cond ((not (file-exists? profile)) ; XXX: race condition (raise (condition (&profile-not-found-error (profile profile))))) ((string-null? pattern) - (for-each list-generation (profile-generations profile))) + (list-generation display-profile-content + (car (profile-generations profile))) + (diff-profiles profile (profile-generations profile))) ((matching-generations pattern profile) => (lambda (numbers) (if (null-list? numbers) (exit 1) (leave-on-EPIPE - (for-each list-generation numbers))))) + (list-generation display-profile-content (car numbers)) + (diff-profiles profile numbers))))) (else (leave (_ "invalid syntax: ~a~%") pattern))) diff --git a/guix/ui.scm b/guix/ui.scm index eb85df3b18..9af8648211 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -7,6 +7,8 @@ ;;; Copyright © 2014, 2015 Alex Kost ;;; Copyright © 2015 David Thompson ;;; Copyright © 2015, 2016 Mathieu Lirzin +;;; Copyright © 2016 Roel Janssen +;;; Copyright © 2016 Benz Schenk ;;; ;;; This file is part of GNU Guix. ;;; @@ -87,6 +89,7 @@ (define-module (guix ui) matching-generations display-generation display-profile-content + display-profile-content-diff roll-back* switch-to-generation* delete-generation* @@ -1070,6 +1073,31 @@ (define (display-generation profile number) (format #t (_ "~a\t(current)~%") header) (format #t "~a~%" header))))) +(define (display-profile-content-diff profile gen1 gen2) + "Display the changed packages in PROFILE GEN2 compared to generation GEN2." + + (define (equal-entry? first second) + (string= (manifest-entry-item first) (manifest-entry-item second))) + + (define (display-entry entry prefix) + (match entry + (($ name version output location _) + (format #t " ~a ~a\t~a\t~a\t~a~%" prefix name version output location)))) + + (define (list-entries number) + (manifest-entries (profile-manifest (generation-file-name profile number)))) + + (define (display-diff profile old new) + (display-generation profile new) + (let ((added (lset-difference + equal-entry? (list-entries new) (list-entries old))) + (removed (lset-difference + equal-entry? (list-entries old) (list-entries new)))) + (for-each (cut display-entry <> "+") added) + (for-each (cut display-entry <> "-") removed))) + + (display-diff profile gen1 gen2)) + (define (display-profile-content profile number) "Display the packages in PROFILE, generation NUMBER, in a human-readable way." -- cgit v1.2.3