summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2013-02-12 01:24:21 -0500
committerMark H Weaver <mhw@netris.org>2013-02-13 22:05:19 -0500
commitdc5669cd654019994fa59ab26db59c292332ae55 (patch)
treec288dbbba737db6b71ca42da37b700b28caa6fac
parentc2868b1e0c4155fbeffac9860d69a1ed6041156a (diff)
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. * doc/guix.texi (Invoking guix-package): In the description of --install, mention that if no version number is specified, the newest available version will be selected.
-rw-r--r--doc/guix.texi7
-rw-r--r--gnu/packages.scm26
-rw-r--r--guix-build.in20
-rw-r--r--guix-package.in73
4 files changed, 106 insertions, 20 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 9cb1431bf1..80149326c1 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -491,9 +491,10 @@ Install @var{package}.
@var{package} may specify either a simple package name, such as
@code{guile}, or a package name followed by a hyphen and version number,
-such as @code{guile-1.8.8}. In addition, @var{package} may contain a
-colon, followed by the name of one of the outputs of the package, as in
-@code{gcc:doc} or @code{binutils-2.22:lib}.
+such as @code{guile-1.8.8}. If no version number is specified, the
+newest available version will be selected. In addition, @var{package}
+may contain a colon, followed by the name of one of the outputs of the
+package, as in @code{gcc:doc} or @code{binutils-2.22:lib}.
@cindex propagated inputs
Sometimes packages have @dfn{propagated inputs}: these are dependencies
diff --git a/gnu/packages.scm b/gnu/packages.scm
index f2f98de476..b639541788 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -22,6 +22,7 @@
#: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)
@@ -30,7 +31,8 @@
%patch-directory
%bootstrap-binaries-path
fold-packages
- find-packages-by-name))
+ find-packages-by-name
+ find-newest-available-packages))
;;; Commentary:
;;;
@@ -153,3 +155,25 @@ then only return packages whose version is equal to VERSION."
(cons package result)
result))
'()))
+
+(define (find-newest-available-packages)
+ "Return a vhash keyed by package names, and with
+associated values of the form
+
+ (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 f8c7115999..35ddb00861 100644
--- a/guix-build.in
+++ b/guix-build.in
@@ -13,6 +13,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \
!#
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -37,12 +38,14 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$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
@@ -196,13 +199,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 ae3d2cd70e..584481acd5 100644
--- a/guix-package.in
+++ b/guix-package.in
@@ -14,6 +14,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -42,6 +43,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$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)
@@ -346,6 +348,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)))
@@ -421,9 +426,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)
@@ -441,7 +457,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)))
@@ -458,6 +474,21 @@ 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's a version of package NAME newer than
+ ;; CURRENT-VERSION, or if the newest available version is equal to
+ ;; CURRENT-VERSION but would have an output path different than
+ ;; 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.
@@ -510,13 +541,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)
@@ -553,10 +603,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)