~ruther/guix-local

e95ae7c22373d2ba0e90ade2a46973ae9473d394 — Roel Janssen 9 years ago b2a2232
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.
2 files changed, 41 insertions(+), 5 deletions(-)

M guix/scripts/package.scm
M guix/ui.scm
M guix/scripts/package.scm => guix/scripts/package.scm +13 -5
@@ 3,6 3,8 @@
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2013, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Roel Janssen <roel@gnu.org>
;;; Copyright © 2016 Benz Schenk <benz.schenk@uzh.ch>
;;;
;;; This file is part of GNU Guix.
;;;


@@ 667,24 669,30 @@ processed, #f otherwise."
                     ((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)))

M guix/ui.scm => guix/ui.scm +28 -0
@@ 7,6 7,8 @@
;;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2016 Roel Janssen <roel@gnu.org>
;;; Copyright © 2016 Benz Schenk <benz.schenk@uzh.ch>
;;;
;;; This file is part of GNU Guix.
;;;


@@ 87,6 89,7 @@
            matching-generations
            display-generation
            display-profile-content
            display-profile-content-diff
            roll-back*
            switch-to-generation*
            delete-generation*


@@ 1070,6 1073,31 @@ DURATION-RELATION with the current time."
          (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
      (($ <manifest-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."