From 3436dd9460e1b7b85584a96df3bb57b022629651 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
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