[PATCH] Implement guix-package --upgrade

[Mark H Weaver]

Hello all,

Here's an implementation of the -u/--upgrade option for guix-package.

The one thing I'm not happy about is that it complains about ambiguous
package specifications when asked to upgrade packages such as guile,
though it seems to me that there's no way to avoid that.

Comments and suggestions solicited.

      Mark


>From 3436dd9460e1b7b85584a96df3bb57b022629651 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
Date: Tue, 12 Feb 2013 01:24:21 -0500
Subject: [PATCH] Implement guix-package --upgrade.

* guix-package.in (%options): Add -u/--upgrade option.
  (process-actions): Implement upgrade option.
---
 guix-package.in |   39 ++++++++++++++++++++++++++++-----------
 1 file changed, 28 insertions(+), 11 deletions(-)

diff --git a/guix-package.in b/guix-package.in
index 32d9afd..ec91581 100644
--- a/guix-package.in
+++ b/guix-package.in
@@ -356,6 +356,9 @@ Install, remove, or upgrade PACKAGES in a single 
transaction.\n"))
         (option '(#\r "remove") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'remove arg result)))
+        (option '(#\u "upgrade") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'upgrade arg result)))
         (option '("roll-back") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'roll-back? #t result)))
@@ -520,13 +523,30 @@ Install, remove, or upgrade PACKAGES in a single 
transaction.\n"))
         (begin
           (roll-back profile)
           (process-actions (alist-delete 'roll-back? opts)))
-        (let* ((install  (filter-map (match-lambda
-                                      (('install . (? store-path?))
-                                       #f)
-                                      (('install . package)
-                                       (find-package package))
-                                      (_ #f))
-                                     opts))
+        (let* ((installed (manifest-packages (profile-manifest profile)))
+               (upgrade-regexps (filter-map (match-lambda
+                                             (('upgrade . regexp)
+                                              (make-regexp regexp))
+                                             (_ #f))
+                                            opts))
+               (upgrade  (if (null? upgrade-regexps)
+                             '()
+                             (filter-map (match-lambda
+                                          ((name _ _ _ _)
+                                           (and (any (cut regexp-exec <> name)
+                                                     upgrade-regexps)
+                                                (find-package name)))
+                                          (_ #f))
+                                         installed)))
+               (install  (append
+                          upgrade
+                          (filter-map (match-lambda
+                                       (('install . (? store-path?))
+                                        #f)
+                                       (('install . package)
+                                        (find-package package))
+                                       (_ #f))
+                                      opts)))
                (drv      (filter-map (match-lambda
                                       ((name version sub-drv
                                              (? package? package)
@@ -563,10 +583,7 @@ Install, remove, or upgrade PACKAGES in a single 
transaction.\n"))
                                          (match package
                                            ((name _ ...)
                                             (alist-delete name result))))
-                                       (fold alist-delete
-                                             (manifest-packages
-                                              (profile-manifest profile))
-                                             remove)
+                                       (fold alist-delete installed remove)
                                        install*))))
 
           (when (equal? profile %current-profile)
-- 
1.7.10.4