[PATCH] profiles: Report about upgrades.

[Alex Kost <alezost@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 2029 bytes --]

Ludovic Courtès (2014-08-16 13:27 +0400) wrote:

> Alex Kost <alezost@gmail.com> skribis:
>
>> (define* (manifest-show-transaction manifest transaction #:key dry-run?)
>>   "Display what will/would be installed/removed from MANIFEST by TRANSACTION."
>
> [...]
>
>>          (format (current-error-port)
>>                  (N_ "The following package ~:[will~;would~] be ~a:~%~{~a~%~}~%"
>>                      "The following packages ~:[will~;would~] be ~a:~%~{~a~%~}~%"
>>                      len)
>>                  dry-run? action-string package-strings)))
>
> [...]
>
>>     (display-entries upgrade "upgraded (removed)")
>>     (display-entries install "installed")
>>     (display-entries remove "removed")))
>
> Computed strings like impede correct internationalization.  The whole
> sentences must be kept intact, to make sure people can translate them
> correctly.  So that means repeating things a bit, but that’s
> unavoidable.
>
>> I tried to avoid the code duplicating, so it became more compact and
>> perhaps less readable.  Also I added reporting about the packages to
>> upgrade: I thought as they are going to be replaced by the packages to
>> install, it is ok to add “(removed)” there.  So an output should look
>> like this (assuming "file-5.17" and "guile-2.0.9" are installed and are
>> being upgraded):
>>
>> The following packages will be upgraded (removed):
>>    file-5.17	out	/gnu/store/...
>>    guile-2.0.9	out	/gnu/store/...
>>
>> The following packages will be installed:
>>    file-5.18	out
>>    guile-2.0.11	out
>
> Ideally, I would just like to see:
>
>  The following packages will be upgraded:
>     file-5.17	out	/gnu/store/...
>     guile-2.0.9	out	/gnu/store/...
>
> and not see them listed under “will be installed.”
>
> I would just keep the current messages for this patch series, and come
> up with an improved message format in a separate patch.

Here is my try to add messages about upgraded packages.  Is it OK?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-profiles-Report-about-upgrades.patch --]
[-- Type: text/x-diff, Size: 4371 bytes --]

From 54c027a227d91acccee68202c24e6ebc27c828fb Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Wed, 20 Aug 2014 15:52:36 +0400
Subject: [PATCH] profiles: Report about upgrades.

* guix/profiles.scm (manifest-show-transaction): Report about upgrades.
---
 guix/profiles.scm | 56 ++++++++++++++++++++++++++++++++++++++++++-------------
 1 file changed, 43 insertions(+), 13 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 7fff25a..d2d9b9e 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -275,15 +275,34 @@ Remove MANIFEST entries that have the same name and output as ENTRIES."
 (define* (manifest-show-transaction store manifest transaction
                                     #:key dry-run?)
   "Display what will/would be installed/removed from MANIFEST by TRANSACTION."
-  ;; TODO: Report upgrades more clearly.
-  (let ((install (manifest-transaction-install transaction))
-        (remove  (manifest-matching-entries
-                  manifest (manifest-transaction-remove transaction))))
+  (define (package-strings name version output item)
+    (map (lambda (name version output item)
+           (format #f "   ~a-~a\t~a\t~a" name version output
+                   (if (package? item)
+                       (package-output store item output)
+                       item)))
+         name version output item))
+
+  (let* ((remove (manifest-matching-entries
+                  manifest (manifest-transaction-remove transaction)))
+         (install/upgrade (manifest-transaction-install transaction))
+         (install '())
+         (upgrade (append-map
+                   (lambda (entry)
+                     (let ((matching
+                            (manifest-matching-entries
+                             manifest
+                             (list (manifest-pattern
+                                    (name   (manifest-entry-name entry))
+                                    (output (manifest-entry-output entry)))))))
+                       (when (null? matching)
+                         (set! install (cons entry install)))
+                       matching))
+                   install/upgrade)))
     (match remove
-      ((($ <manifest-entry> name version output path _) ..1)
+      ((($ <manifest-entry> name version output item _) ..1)
        (let ((len    (length name))
-             (remove (map (cut format #f "   ~a-~a\t~a\t~a" <> <> <> <>)
-                          name version output path)))
+             (remove (package-strings name version output item)))
          (if dry-run?
              (format (current-error-port)
                      (N_ "The following package would be removed:~%~{~a~%~}~%"
@@ -296,15 +315,26 @@ Remove MANIFEST entries that have the same name and output as ENTRIES."
                          len)
                      remove))))
       (_ #f))
+    (match upgrade
+      ((($ <manifest-entry> name version output item _) ..1)
+       (let ((len     (length name))
+             (upgrade (package-strings name version output item)))
+         (if dry-run?
+             (format (current-error-port)
+                     (N_ "The following package would be upgraded:~%~{~a~%~}~%"
+                         "The following packages would be upgraded:~%~{~a~%~}~%"
+                         len)
+                     upgrade)
+             (format (current-error-port)
+                     (N_ "The following package will be upgraded:~%~{~a~%~}~%"
+                         "The following packages will be upgraded:~%~{~a~%~}~%"
+                         len)
+                     upgrade))))
+      (_ #f))
     (match install
       ((($ <manifest-entry> name version output item _) ..1)
        (let ((len     (length name))
-             (install (map (lambda (name version output item)
-                             (format #f "   ~a-~a\t~a\t~a" name version output
-                                     (if (package? item)
-                                         (package-output store item output)
-                                         item)))
-                           name version output item)))
+             (install (package-strings name version output item)))
          (if dry-run?
              (format (current-error-port)
                      (N_ "The following package would be installed:~%~{~a~%~}~%"
-- 
2.0.3