[PATCH] Implement guix-package --upgrade

[PATCH] Implement guix-package --upgrade

[Mark H Weaver]

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

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



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] Implement guix-package --upgrade --]
[-- Type: text/x-diff, Size: 3904 bytes --]

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

Re: [PATCH] Implement guix-package --upgrade

[Ludovic Courtès]

Hi Mark!

Mark H Weaver <mhw@netris.org> skribis:

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

Nice!

> +               (upgrade  (if (null? upgrade-regexps)
> +                             '()
> +                             (filter-map (match-lambda
> +                                          ((name _ _ _ _)
> +                                           (and (any (cut regexp-exec <> name)
> +                                                     upgrade-regexps)
> +                                                (find-package name)))
> +                                          (_ #f))
> +                                         installed)))

It’s actually slightly more complex: you need to select those packages
that are installed and for which either a newer version is available
(per ‘version-string>?’, see gnu-maintenance.scm; should be moved to
utils.scm), or the version is identical and the output path differs (for
instance because one of its dependencies has changed.)

There are tests in guix-package.sh, but this one is going to be
difficult to test without building the world.

I think guix-package needs a -e switch (as for guix-build), which would
allow us to write dummy packages for test purposes.

WDYT?

Ludo’.

Re: [PATCH] Implement guix-package --upgrade

[Andreas Enge]

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

Am Dienstag, 12. Februar 2013 schrieb Ludovic Courtès:
> It’s actually slightly more complex: you need to select those packages
> that are installed and for which either a newer version is available
> (per ‘version-string>?’, see gnu-maintenance.scm; should be moved to
> utils.scm)

This reminds me:
   guix-package -i libjpeg
still installs version 8d and not 9, so apparently, there is no check on 
the version number.

And
   guix-package -A jpeg
prints
   libjpeg 9       out     gnu/packages/libjpeg.scm:27:3
   libjpeg 8d      out     gnu/packages/libjpeg.scm:27:3
which is strange since libjpeg-9 is indeed defined around line 27, but 
libjpeg-8 comes later in the file.

Andreas

[-- Attachment #2: Type: text/html, Size: 3794 bytes --]

Re: [PATCH] Implement guix-package --upgrade

[Ludovic Courtès]

Andreas Enge <andreas@enge.fr> skribis:

> Am Dienstag, 12. Februar 2013 schrieb Ludovic Courtès:
>> It’s actually slightly more complex: you need to select those packages
>> that are installed and for which either a newer version is available
>> (per ‘version-string>?’, see gnu-maintenance.scm; should be moved to
>> utils.scm)
>
> This reminds me:
>    guix-package -i libjpeg
> still installs version 8d and not 9, so apparently, there is no check on 
> the version number.

Indeed, we should fix it.

> And
>    guix-package -A jpeg
> prints
>    libjpeg 9       out     gnu/packages/libjpeg.scm:27:3
>    libjpeg 8d      out     gnu/packages/libjpeg.scm:27:3
> which is strange since libjpeg-9 is indeed defined around line 27, but 
> libjpeg-8 comes later in the file.

Yes.  That’s because the record ‘libjpeg-8d’ “inherits” from the other
one, so it takes its ‘location’ field unchanged.  Currently you have to
explicitly add the ‘location’ field when inheriting:

  (location (source-properties->location (current-source-location)))

That’s inconvenient though, and perhaps ‘define-record-type*’ should be
extended to support non-inheritable fields.

Thoughts?

Ludo’.

Re: [PATCH] Implement guix-package --upgrade

[Mark H Weaver]

Hi Ludovic,

ludo@gnu.org (Ludovic Courtès) writes:

> Mark H Weaver <mhw@netris.org> skribis:
>> +               (upgrade  (if (null? upgrade-regexps)
>> +                             '()
>> +                             (filter-map (match-lambda
>> +                                          ((name _ _ _ _)
>> +                                           (and (any (cut regexp-exec <> name)
>> +                                                     upgrade-regexps)
>> +                                                (find-package name)))
>> +                                          (_ #f))
>> +                                         installed)))
>
> It’s actually slightly more complex: you need to select those packages
> that are installed and for which either a newer version is available
> (per ‘version-string>?’, see gnu-maintenance.scm; should be moved to
> utils.scm), or the version is identical and the output path differs (for
> instance because one of its dependencies has changed.)

Okay.  I was relying on the fact that attempts to install a derivation
that's already installed will ultimately be ignored, and my (admittedly
simple) tests seem to suggest that it works properly, but perhaps this
approach will be too inefficient when the profile contains a large
number of packages.

I'll do as you suggest and post an updated patch soon.

> There are tests in guix-package.sh, but this one is going to be
> difficult to test without building the world.

Would you be willing to write the tests?  I think that my knowledge of
Guix is still too weak to do this job properly.  (For that matter, it
was probably foolish of me to try to implement --upgrade at this early
stage in my explorations :)

> I think guix-package needs a -e switch (as for guix-build), which would
> allow us to write dummy packages for test purposes.

Makes sense.

   Thanks!
     Mark

Re: [PATCH] Implement guix-package --upgrade

[Ludovic Courtès]

Mark H Weaver <mhw@netris.org> skribis:

>> Mark H Weaver <mhw@netris.org> skribis:
>>> +               (upgrade  (if (null? upgrade-regexps)
>>> +                             '()
>>> +                             (filter-map (match-lambda
>>> +                                          ((name _ _ _ _)
>>> +                                           (and (any (cut regexp-exec <> name)
>>> +                                                     upgrade-regexps)
>>> +                                                (find-package name)))
>>> +                                          (_ #f))
>>> +                                         installed)))
>>
>> It’s actually slightly more complex: you need to select those packages
>> that are installed and for which either a newer version is available
>> (per ‘version-string>?’, see gnu-maintenance.scm; should be moved to
>> utils.scm), or the version is identical and the output path differs (for
>> instance because one of its dependencies has changed.)
>
> Okay.  I was relying on the fact that attempts to install a derivation
> that's already installed will ultimately be ignored, and my (admittedly
> simple) tests seem to suggest that it works properly, but perhaps this
> approach will be too inefficient when the profile contains a large
> number of packages.

More importantly, you don’t want upgrade to downgrade.

For instance, if guile-1.8.8 turns out to be before guile-2.0.7 in the
package list, users who’ve installed the latter shouldn’t suddenly
downgrade to the former.

>> There are tests in guix-package.sh, but this one is going to be
>> difficult to test without building the world.
>
> Would you be willing to write the tests?  I think that my knowledge of
> Guix is still too weak to do this job properly.  (For that matter, it
> was probably foolish of me to try to implement --upgrade at this early
> stage in my explorations :)

Well, you’re brave!  :-)

I’ll take care of the tests and -e.

Thanks!

Ludo’.

Re: [PATCH] Implement guix-package --upgrade

[Mark H Weaver]

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

ludo@gnu.org (Ludovic Courtès) writes:

> Mark H Weaver <mhw@netris.org> skribis:
>
>> Okay.  I was relying on the fact that attempts to install a derivation
>> that's already installed will ultimately be ignored, and my (admittedly
>> simple) tests seem to suggest that it works properly, but perhaps this
>> approach will be too inefficient when the profile contains a large
>> number of packages.
>
> More importantly, you don’t want upgrade to downgrade.

Ah, good point! :)

> For instance, if guile-1.8.8 turns out to be before guile-2.0.7 in the
> package list, users who’ve installed the latter shouldn’t suddenly
> downgrade to the former.

Would "guix-package -i guile" ever choose guile-1.8.8 over guile-2.0.7
if the latter was available?  Does it not automatically choose the
newest available version?  If not, should it?

> I’ll take care of the tests and -e.

Great, thanks!

I've attached a new implementation of --upgrade along the lines you
suggested.  Still remaining to be done: if there are multiple packages
with the same (newest) version number, choose intelligently between
them.

The first patch moves 'version-string>?' to (guix utils) and renames it
to 'version>?'.  It also adds 'version-compare'.  I needed these for the
improved upgrade implementation.

Comments and suggestions solicited.

     Mark



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH 1/2] Add version-compare and version>? to utils.scm --]
[-- Type: text/x-diff, Size: 3402 bytes --]

From bd192057c770ca3653828498591dbe4683b51545 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Tue, 12 Feb 2013 12:02:15 -0500
Subject: [PATCH 1/2] Add version-compare and version>? to utils.scm.

* guix/utils.scm (version-compare, version>?): New exported procedures,
  based on version-string>?, which was formerly in gnu-maintenance.scm.

* guix/gnu-maintenance.scm (version-string>?): Removed procedure.
  (latest-release): Use 'version>?' instead of 'version-string>?'.
---
 guix/gnu-maintenance.scm |   12 ++----------
 guix/utils.scm           |   20 ++++++++++++++++++++
 2 files changed, 22 insertions(+), 10 deletions(-)

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index c934694..6475c38 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -28,6 +28,7 @@
   #:use-module (srfi srfi-26)
   #:use-module (system foreign)
   #:use-module (guix ftp-client)
+  #:use-module (guix utils)
   #:export (official-gnu-packages
             releases
             latest-release
@@ -156,21 +157,12 @@ pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
                                files)
                    result)))))))
 
-(define version-string>?
-  (let ((strverscmp
-         (let ((sym (or (dynamic-func "strverscmp" (dynamic-link))
-                        (error "could not find `strverscmp' (from GNU libc)"))))
-           (pointer->procedure int sym (list '* '*)))))
-    (lambda (a b)
-      "Return #t when B denotes a newer version than A."
-      (> (strverscmp (string->pointer a) (string->pointer b)) 0))))
-
 (define (latest-release project)
   "Return (\"FOO-X.Y\" . \"/bar/foo\") or #f."
   (let ((releases (releases project)))
     (and (not (null? releases))
          (fold (lambda (release latest)
-                 (if (version-string>? (car release) (car latest))
+                 (if (version>? (car release) (car latest))
                      release
                      latest))
                '("" . "")
diff --git a/guix/utils.scm b/guix/utils.scm
index 7ab835e..d7c37e3 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -57,6 +57,8 @@
 
             gnu-triplet->nix-system
             %current-system
+            version-compare
+            version>?
             package-name->name+version))
 
 \f
@@ -422,6 +424,24 @@ returned by `config.guess'."
   ;; By default, this is equal to (gnu-triplet->nix-system %host-type).
   (make-parameter %system))
 
+(define version-compare
+  (let ((strverscmp
+         (let ((sym (or (dynamic-func "strverscmp" (dynamic-link))
+                        (error "could not find `strverscmp' (from GNU libc)"))))
+           (pointer->procedure int sym (list '* '*)))))
+    (lambda (a b)
+      "Return '> when A denotes a newer version than B,
+'< when A denotes a older version than B,
+or '= when they denote equal versions."
+      (let ((result (strverscmp (string->pointer a) (string->pointer b))))
+        (cond ((positive? result) '>)
+              ((negative? result) '<)
+              (else '=))))))
+
+(define (version>? a b)
+  "Return #t when A denotes a newer version than B."
+  (eq? '> (version-compare a b)))
+
 (define (package-name->name+version name)
   "Given NAME, a package name like \"foo-0.9.1b\", return two values:
 \"foo\" and \"0.9.1b\".  When the version part is unavailable, NAME and
-- 
1.7.10.4


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: [PATCH 2/2] Implement guix-package --upgrade --]
[-- Type: text/x-diff, Size: 6486 bytes --]

From 6a7f8cfd7373afe664b3f0412c02d7b1beeb5c7a 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 2/2] Implement guix-package --upgrade.

* guix-package.in (%options): Add --upgrade/-u option.
  (newest-available-packages, upgradeable?): New procedures.
  (process-actions): Implement upgrade option.
---
 guix-package.in |   78 +++++++++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 67 insertions(+), 11 deletions(-)

diff --git a/guix-package.in b/guix-package.in
index 32d9afd..f00b7e7 100644
--- a/guix-package.in
+++ b/guix-package.in
@@ -52,6 +52,7 @@ exec "${GUILE-@GUILE@}" -c "$startup" "@guilemoduledir@" "$0" "$@"
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
+  #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -356,6 +357,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)))
@@ -468,6 +472,41 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
         (()
          (leave (_ "~a: package not found~%") request)))))
 
+  (define (newest-available-packages)
+    ;; Return a vhash with elements of the form:
+    ;; (name newest-version newest-package ...)
+    ;; where the preferred package is listed first.
+
+    ;; FIXME: Currently, the preferred package is whichever one
+    ;; was found last by 'fold-packages'.  Find a better solution.
+    (fold-packages (lambda (p r)
+                     (let ((name    (package-name p))
+                           (version (package-version p)))
+                       (match (vhash-assoc name r)
+                         ((_ newest-so-far . pkgs)
+                          (case (version-compare version newest-so-far)
+                            ((>) (vhash-cons name `(,version ,p) r))
+                            ((=) (vhash-cons name `(,version ,p ,@pkgs) r))
+                            ((<) r)))
+                         (#f (vhash-cons name `(,version ,p) r)))))
+                   vlist-null))
+
+  (define (upgradeable? name current-version current-path newest)
+    ;; Return #t if there is a newer version available, or if the
+    ;; newest version if the same as the current one but the
+    ;; output path would be different than the current path.
+
+    ;; NEWEST must be the result of (newest-available-packages).
+    (match (vhash-assoc name newest)
+      ((_ candidate-version pkg . rest)
+       (case (version-compare candidate-version current-version)
+         ((>) #t)
+         ((<) #f)
+         ((=) (let* ((candidate-path (derivation-path->output-path
+                                      (package-derivation (%store) pkg))))
+                (not (string=? current-path candidate-path))))))
+      (#f #f)))
+
   (define (ensure-default-profile)
     ;; Ensure the default profile symlink and directory exist.
 
@@ -520,13 +559,33 @@ 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)
+                             '()
+                             (let ((newest (newest-available-packages)))
+                               (filter-map (match-lambda
+                                            ((name version output path _)
+                                             (and (any (cut regexp-exec <> name)
+                                                       upgrade-regexps)
+                                                  (upgradeable? name version path
+                                                                newest)
+                                                  (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 +622,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

Re: [PATCH] Implement guix-package --upgrade

[Mark H Weaver]

I wrote:
> Would "guix-package -i guile" ever choose guile-1.8.8 over guile-2.0.7
> if the latter was available?  Does it not automatically choose the
> newest available version?

Having now looked at the code, I see that it does not.

My latest upgrade implemention assumed that it did, so I'll have to fix
that.  Please hold off on reviewing the current patch.  Another is now
in the works.

> If not, should it?

For now, I'm going to assume that "guix-package -i guile" indeed
*should* choose from among the newest available versions, so I'm going
to work on fixing that.

Please let me know if you disagree.

     Mark

Re: [PATCH] Implement guix-package --upgrade

[Andreas Enge]

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

Am Dienstag, 12. Februar 2013 schrieb Mark H Weaver:
> For now, I'm going to assume that "guix-package -i guile" indeed
> *should* choose from among the newest available versions, so I'm going
> to work on fixing that.

Yes, that was exactly my point with libjpeg - we would like 9 to be 
installed by default instead of 8d.

Andreas

[-- Attachment #2: Type: text/html, Size: 1992 bytes --]

Re: [PATCH] Implement guix-package --upgrade

[Ludovic Courtès]

Mark H Weaver <mhw@netris.org> skribis:

> From bd192057c770ca3653828498591dbe4683b51545 Mon Sep 17 00:00:00 2001
> From: Mark H Weaver <mhw@netris.org>
> Date: Tue, 12 Feb 2013 12:02:15 -0500
> Subject: [PATCH 1/2] Add version-compare and version>? to utils.scm.
>
> * guix/utils.scm (version-compare, version>?): New exported procedures,
>   based on version-string>?, which was formerly in gnu-maintenance.scm.
>
> * guix/gnu-maintenance.scm (version-string>?): Removed procedure.
>   (latest-release): Use 'version>?' instead of 'version-string>?'.

Fine with me, please push.

Ludo’.

Re: [PATCH] Implement guix-package --upgrade

[Ludovic Courtès]

Andreas Enge <andreas@enge.fr> skribis:

> Am Dienstag, 12. Februar 2013 schrieb Mark H Weaver:
>> For now, I'm going to assume that "guix-package -i guile" indeed
>> *should* choose from among the newest available versions, so I'm going
>> to work on fixing that.
>
> Yes, that was exactly my point with libjpeg - we would like 9 to be 
> installed by default instead of 8d.

Yes, agreed.

Ludo’.

[PATCH] Build newest versions unless specified, and upgrades.

[Mark H Weaver]

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

Hello all,

Here's a preliminary patch that does two things:

* Changes 'guix-build' and 'guix-package --install' so that only the
  newest packages will be considered (unless a version number is
  specified).

* Implements 'guix-package --upgrade'.

Although I'm not aware of any functional problems with this code, I'm
not entirely pleased with its organization.  Nonetheless, I wanted to
make it available for early testing and comments.

I welcome suggestions on how to improve this code.

      Mark



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] Build newest versions unless specified, and implement upgrades --]
[-- Type: text/x-diff, Size: 10635 bytes --]

From 16cf486524502c1caebbd8831a8f6802640aeace 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] Build newest versions unless specified, and implement
 upgrades.

* gnu/packages.scm (find-newest-available-packages):
  New exported procedure.

* guix-build.in (newest-available-packages, find-best-packages-by-name):
  New procedures.
  (find-package): Use find-best-packages-by-name, to guarantee that
  if a version number is not specified, only the newest versions will
  be considered.

* guix-package.in (%options): Add --upgrade/-u option.
  (newest-available-packages, find-best-packages-by-name, upgradeable?):
  New procedures.
  (find-package): Use find-best-packages-by-name, to guarantee that
  if a version number is not specified, only the newest versions will
  be considered.
  (process-actions): Implement upgrade option.
---
 gnu/packages.scm |   24 +++++++++++++++++-
 guix-build.in    |   16 ++++++++++--
 guix-package.in  |   71 ++++++++++++++++++++++++++++++++++++++++++++----------
 3 files changed, 95 insertions(+), 16 deletions(-)

diff --git a/gnu/packages.scm b/gnu/packages.scm
index 792fe44..04ca840 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -20,6 +20,8 @@
   #:use-module (guix packages)
   #:use-module (guix utils)
   #:use-module (ice-9 ftw)
+  #:use-module (ice-9 vlist)
+  #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-39)
@@ -28,7 +30,8 @@
             %patch-directory
             %bootstrap-binaries-path
             fold-packages
-            find-packages-by-name))
+            find-packages-by-name
+            find-newest-available-packages))
 
 ;;; Commentary:
 ;;;
@@ -137,3 +140,22 @@ then only return packages whose version is equal to VERSION."
                        (cons package result)
                        result))
                  '()))
+
+(define (find-newest-available-packages)
+  "Return a vhash with elements of the form
+  (name newest-version newest-package ...)
+where the preferred package is listed first."
+
+  ;; FIXME: Currently, the preferred package is whichever one
+  ;; was found last by 'fold-packages'.  Find a better solution.
+  (fold-packages (lambda (p r)
+                   (let ((name    (package-name p))
+                         (version (package-version p)))
+                     (match (vhash-assoc name r)
+                       ((_ newest-so-far . pkgs)
+                        (case (version-compare version newest-so-far)
+                          ((>) (vhash-cons name `(,version ,p) r))
+                          ((=) (vhash-cons name `(,version ,p ,@pkgs) r))
+                          ((<) r)))
+                       (#f (vhash-cons name `(,version ,p) r)))))
+                 vlist-null))
diff --git a/guix-build.in b/guix-build.in
index 29241c7..3bfddeb 100644
--- a/guix-build.in
+++ b/guix-build.in
@@ -47,6 +47,7 @@ exec "${GUILE-@GUILE@}" -c "$startup" "@guilemoduledir@" "$0" "$@"
   #:use-module (guix utils)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -206,13 +207,24 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
                  root (strerror (system-error-errno args)))
          (exit 1)))))
 
+  (define newest-available-packages
+    (memoize find-newest-available-packages))
+
+  (define (find-best-packages-by-name name version)
+    (if version
+        (find-packages-by-name name version)
+        (match (vhash-assoc name (newest-available-packages))
+          ((_ version pkgs ...) pkgs)
+          (#f '()))))
+
   (define (find-package request)
     ;; Return a package matching REQUEST.  REQUEST may be a package
     ;; name, or a package name followed by a hyphen and a version
-    ;; number.
+    ;; number.  If the version number is not present, return the
+    ;; preferred newest version.
     (let-values (((name version)
                   (package-name->name+version request)))
-      (match (find-packages-by-name name version)
+      (match (find-best-packages-by-name name version)
         ((p)                                      ; one match
          p)
         ((p x ...)                                ; several matches
diff --git a/guix-package.in b/guix-package.in
index 32d9afd..28b919f 100644
--- a/guix-package.in
+++ b/guix-package.in
@@ -52,6 +52,7 @@ exec "${GUILE-@GUILE@}" -c "$startup" "@guilemoduledir@" "$0" "$@"
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
+  #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -356,6 +357,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)))
@@ -431,9 +435,20 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                       (length req*))
                   (null? req*) req*))))
 
+  (define newest-available-packages
+    (memoize find-newest-available-packages))
+
+  (define (find-best-packages-by-name name version)
+    (if version
+        (find-packages-by-name name version)
+        (match (vhash-assoc name (newest-available-packages))
+          ((_ version pkgs ...) pkgs)
+          (#f '()))))
+
   (define (find-package name)
     ;; Find the package NAME; NAME may contain a version number and a
-    ;; sub-derivation name.
+    ;; sub-derivation name.  If the version number is not present,
+    ;; return the preferred newest version.
     (define request name)
 
     (define (ensure-output p sub-drv)
@@ -451,7 +466,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                                     (substring name (+ 1 colon))))))
                   ((name version)
                    (package-name->name+version name)))
-      (match (find-packages-by-name name version)
+      (match (find-best-packages-by-name name version)
         ((p)
          (list name (package-version p) sub-drv (ensure-output p sub-drv)
                (package-transitive-propagated-inputs p)))
@@ -468,6 +483,20 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
         (()
          (leave (_ "~a: package not found~%") request)))))
 
+  (define (upgradeable? name current-version current-path)
+    ;; Return #t if there is a newer version available, or if the
+    ;; newest version if the same as the current one but the
+    ;; output path would be different than the current path.
+    (match (vhash-assoc name (newest-available-packages))
+      ((_ candidate-version pkg . rest)
+       (case (version-compare candidate-version current-version)
+         ((>) #t)
+         ((<) #f)
+         ((=) (let ((candidate-path (derivation-path->output-path
+                                     (package-derivation (%store) pkg))))
+                (not (string=? current-path candidate-path))))))
+      (#f #f)))
+
   (define (ensure-default-profile)
     ;; Ensure the default profile symlink and directory exist.
 
@@ -520,13 +549,32 @@ 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)
+                             '()
+                             (let ((newest (find-newest-available-packages)))
+                               (filter-map (match-lambda
+                                            ((name version output path _)
+                                             (and (any (cut regexp-exec <> name)
+                                                       upgrade-regexps)
+                                                  (upgradeable? name version path)
+                                                  (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 +611,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

Re: [PATCH] Build newest versions unless specified, and upgrades.

[Mark H Weaver]

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

I wrote:
> Here's a preliminary patch that does two things:
>
> * Changes 'guix-build' and 'guix-package --install' so that only the
>   newest packages will be considered (unless a version number is
>   specified).
>
> * Implements 'guix-package --upgrade'.
>
> Although I'm not aware of any functional problems with this code, I'm
> not entirely pleased with its organization.  Nonetheless, I wanted to
> make it available for early testing and comments.
>
> I welcome suggestions on how to improve this code.

Sorry, that patch had a problem in guix-build.  Here's a fixed version.

     Mark


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] Build newest versions unless specified, and implement upgrades --]
[-- Type: text/x-diff, Size: 10919 bytes --]

From c3820d291cdc40cc58abebf8ca10332e51ebead1 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] Build newest versions unless specified, and implement
 upgrades.

* gnu/packages.scm (find-newest-available-packages):
  New exported procedure.

* guix-build.in (newest-available-packages, find-best-packages-by-name):
  New procedures.
  (find-package): Use find-best-packages-by-name, to guarantee that
  if a version number is not specified, only the newest versions will
  be considered.

* guix-package.in (%options): Add --upgrade/-u option.
  (newest-available-packages, find-best-packages-by-name, upgradeable?):
  New procedures.
  (find-package): Use find-best-packages-by-name, to guarantee that
  if a version number is not specified, only the newest versions will
  be considered.
  (process-actions): Implement upgrade option.
---
 gnu/packages.scm |   24 +++++++++++++++++-
 guix-build.in    |   19 ++++++++++++---
 guix-package.in  |   71 ++++++++++++++++++++++++++++++++++++++++++++----------
 3 files changed, 97 insertions(+), 17 deletions(-)

diff --git a/gnu/packages.scm b/gnu/packages.scm
index 792fe44..04ca840 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -20,6 +20,8 @@
   #:use-module (guix packages)
   #:use-module (guix utils)
   #:use-module (ice-9 ftw)
+  #:use-module (ice-9 vlist)
+  #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-39)
@@ -28,7 +30,8 @@
             %patch-directory
             %bootstrap-binaries-path
             fold-packages
-            find-packages-by-name))
+            find-packages-by-name
+            find-newest-available-packages))
 
 ;;; Commentary:
 ;;;
@@ -137,3 +140,22 @@ then only return packages whose version is equal to VERSION."
                        (cons package result)
                        result))
                  '()))
+
+(define (find-newest-available-packages)
+  "Return a vhash with elements of the form
+  (name newest-version newest-package ...)
+where the preferred package is listed first."
+
+  ;; FIXME: Currently, the preferred package is whichever one
+  ;; was found last by 'fold-packages'.  Find a better solution.
+  (fold-packages (lambda (p r)
+                   (let ((name    (package-name p))
+                         (version (package-version p)))
+                     (match (vhash-assoc name r)
+                       ((_ newest-so-far . pkgs)
+                        (case (version-compare version newest-so-far)
+                          ((>) (vhash-cons name `(,version ,p) r))
+                          ((=) (vhash-cons name `(,version ,p ,@pkgs) r))
+                          ((<) r)))
+                       (#f (vhash-cons name `(,version ,p) r)))))
+                 vlist-null))
diff --git a/guix-build.in b/guix-build.in
index 29241c7..607a4bd 100644
--- a/guix-build.in
+++ b/guix-build.in
@@ -47,12 +47,14 @@ exec "${GUILE-@GUILE@}" -c "$startup" "@guilemoduledir@" "$0" "$@"
   #:use-module (guix utils)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-37)
-  #:autoload   (gnu packages) (find-packages-by-name)
+  #:autoload   (gnu packages) (find-packages-by-name
+                               find-newest-available-packages)
   #:export (guix-build))
 
 (define %store
@@ -206,13 +208,24 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
                  root (strerror (system-error-errno args)))
          (exit 1)))))
 
+  (define newest-available-packages
+    (memoize find-newest-available-packages))
+
+  (define (find-best-packages-by-name name version)
+    (if version
+        (find-packages-by-name name version)
+        (match (vhash-assoc name (newest-available-packages))
+          ((_ version pkgs ...) pkgs)
+          (#f '()))))
+
   (define (find-package request)
     ;; Return a package matching REQUEST.  REQUEST may be a package
     ;; name, or a package name followed by a hyphen and a version
-    ;; number.
+    ;; number.  If the version number is not present, return the
+    ;; preferred newest version.
     (let-values (((name version)
                   (package-name->name+version request)))
-      (match (find-packages-by-name name version)
+      (match (find-best-packages-by-name name version)
         ((p)                                      ; one match
          p)
         ((p x ...)                                ; several matches
diff --git a/guix-package.in b/guix-package.in
index 32d9afd..28b919f 100644
--- a/guix-package.in
+++ b/guix-package.in
@@ -52,6 +52,7 @@ exec "${GUILE-@GUILE@}" -c "$startup" "@guilemoduledir@" "$0" "$@"
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
+  #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -356,6 +357,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)))
@@ -431,9 +435,20 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                       (length req*))
                   (null? req*) req*))))
 
+  (define newest-available-packages
+    (memoize find-newest-available-packages))
+
+  (define (find-best-packages-by-name name version)
+    (if version
+        (find-packages-by-name name version)
+        (match (vhash-assoc name (newest-available-packages))
+          ((_ version pkgs ...) pkgs)
+          (#f '()))))
+
   (define (find-package name)
     ;; Find the package NAME; NAME may contain a version number and a
-    ;; sub-derivation name.
+    ;; sub-derivation name.  If the version number is not present,
+    ;; return the preferred newest version.
     (define request name)
 
     (define (ensure-output p sub-drv)
@@ -451,7 +466,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                                     (substring name (+ 1 colon))))))
                   ((name version)
                    (package-name->name+version name)))
-      (match (find-packages-by-name name version)
+      (match (find-best-packages-by-name name version)
         ((p)
          (list name (package-version p) sub-drv (ensure-output p sub-drv)
                (package-transitive-propagated-inputs p)))
@@ -468,6 +483,20 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
         (()
          (leave (_ "~a: package not found~%") request)))))
 
+  (define (upgradeable? name current-version current-path)
+    ;; Return #t if there is a newer version available, or if the
+    ;; newest version if the same as the current one but the
+    ;; output path would be different than the current path.
+    (match (vhash-assoc name (newest-available-packages))
+      ((_ candidate-version pkg . rest)
+       (case (version-compare candidate-version current-version)
+         ((>) #t)
+         ((<) #f)
+         ((=) (let ((candidate-path (derivation-path->output-path
+                                     (package-derivation (%store) pkg))))
+                (not (string=? current-path candidate-path))))))
+      (#f #f)))
+
   (define (ensure-default-profile)
     ;; Ensure the default profile symlink and directory exist.
 
@@ -520,13 +549,32 @@ 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)
+                             '()
+                             (let ((newest (find-newest-available-packages)))
+                               (filter-map (match-lambda
+                                            ((name version output path _)
+                                             (and (any (cut regexp-exec <> name)
+                                                       upgrade-regexps)
+                                                  (upgradeable? name version path)
+                                                  (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 +611,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

Re: [PATCH] Build newest versions unless specified, and upgrades.

[Ludovic Courtès]

Mark H Weaver <mhw@netris.org> skribis:

> I wrote:
>> Here's a preliminary patch that does two things:
>>
>> * Changes 'guix-build' and 'guix-package --install' so that only the
>>   newest packages will be considered (unless a version number is
>>   specified).
>>
>> * Implements 'guix-package --upgrade'.
>>
>> Although I'm not aware of any functional problems with this code, I'm
>> not entirely pleased with its organization.  Nonetheless, I wanted to
>> make it available for early testing and comments.
>>
>> I welcome suggestions on how to improve this code.
>
> Sorry, that patch had a problem in guix-build.  Here's a fixed version.

I haven’t actually tested, but it looks good to me!

I could have left ‘guix-build’ as is, because hackers should really use
-e when they want something specific, but I’m fine either way.

Could you update the doc, under “Invoking guix-package”, stating what
happens when giving a package name without a version number?

Minor remarks:

> +(define (find-newest-available-packages)
> +  "Return a vhash with elements of the form
> +  (name newest-version newest-package ...)
> +where the preferred package is listed first."

What about something like this:

  Return a vhash keyed by package names, and with associated values of
  the form

    (newest-version newest-package)

> +  (define (upgradeable? name current-version current-path)
> +    ;; Return #t if there is a newer version available, or if the
> +    ;; newest version if the same as the current one but the
> +    ;; output path would be different than the current path.

Try to mention the variables here, like:

  Return #t if there’s a version of package NAME newer than
  CURRENT-VERSION ...

Other than that, please push!

Thanks,
Ludo’.

Re: [PATCH] Build newest versions unless specified, and upgrades.

[Mark H Weaver]

ludo@gnu.org (Ludovic Courtès) writes:
> Other than that, please push!

Okay, I incorporated your suggestions and pushed it.

    Thanks,
      Mark