[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [PATCH] Implement guix-package --upgrade
From: |
Mark H Weaver |
Subject: |
Re: [PATCH] Implement guix-package --upgrade |
Date: |
Tue, 12 Feb 2013 14:29:07 -0500 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.2 (gnu/linux) |
address@hidden (Ludovic Courtès) writes:
> Mark H Weaver <address@hidden> 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
>From bd192057c770ca3653828498591dbe4683b51545 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
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))
@@ -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
>From 6a7f8cfd7373afe664b3f0412c02d7b1beeb5c7a Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
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 "address@hidden@}" -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
- [PATCH] Implement guix-package --upgrade, Mark H Weaver, 2013/02/12
- Re: [PATCH] Implement guix-package --upgrade, Ludovic Courtès, 2013/02/12
- Re: [PATCH] Implement guix-package --upgrade, Andreas Enge, 2013/02/12
- Re: [PATCH] Implement guix-package --upgrade, Mark H Weaver, 2013/02/12
- Re: [PATCH] Implement guix-package --upgrade, Ludovic Courtès, 2013/02/12
- Re: [PATCH] Implement guix-package --upgrade,
Mark H Weaver <=
- Re: [PATCH] Implement guix-package --upgrade, Mark H Weaver, 2013/02/12
- Re: [PATCH] Implement guix-package --upgrade, Andreas Enge, 2013/02/12
- Re: [PATCH] Implement guix-package --upgrade, Ludovic Courtès, 2013/02/12
- [PATCH] Build newest versions unless specified, and upgrades., Mark H Weaver, 2013/02/13
- Re: [PATCH] Build newest versions unless specified, and upgrades., Mark H Weaver, 2013/02/13
- Re: [PATCH] Build newest versions unless specified, and upgrades., Ludovic Courtès, 2013/02/13
- Re: [PATCH] Build newest versions unless specified, and upgrades., Mark H Weaver, 2013/02/13
- Re: [PATCH] Implement guix-package --upgrade, Ludovic Courtès, 2013/02/12