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.
This commit is contained in:
parent
c2868b1e0c
commit
dc5669cd65
|
@ -491,9 +491,10 @@ Install @var{package}.
|
||||||
|
|
||||||
@var{package} may specify either a simple package name, such as
|
@var{package} may specify either a simple package name, such as
|
||||||
@code{guile}, or a package name followed by a hyphen and version number,
|
@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
|
such as @code{guile-1.8.8}. If no version number is specified, the
|
||||||
colon, followed by the name of one of the outputs of the package, as in
|
newest available version will be selected. In addition, @var{package}
|
||||||
@code{gcc:doc} or @code{binutils-2.22:lib}.
|
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
|
@cindex propagated inputs
|
||||||
Sometimes packages have @dfn{propagated inputs}: these are dependencies
|
Sometimes packages have @dfn{propagated inputs}: these are dependencies
|
||||||
|
|
|
@ -22,6 +22,7 @@
|
||||||
#:use-module (guix utils)
|
#:use-module (guix utils)
|
||||||
#:use-module (ice-9 ftw)
|
#:use-module (ice-9 ftw)
|
||||||
#:use-module (ice-9 vlist)
|
#:use-module (ice-9 vlist)
|
||||||
|
#:use-module (ice-9 match)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-39)
|
#:use-module (srfi srfi-39)
|
||||||
|
@ -30,7 +31,8 @@
|
||||||
%patch-directory
|
%patch-directory
|
||||||
%bootstrap-binaries-path
|
%bootstrap-binaries-path
|
||||||
fold-packages
|
fold-packages
|
||||||
find-packages-by-name))
|
find-packages-by-name
|
||||||
|
find-newest-available-packages))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
;;;
|
;;;
|
||||||
|
@ -153,3 +155,25 @@ then only return packages whose version is equal to VERSION."
|
||||||
(cons package result)
|
(cons package result)
|
||||||
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))
|
||||||
|
|
|
@ -13,6 +13,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \
|
||||||
!#
|
!#
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
||||||
|
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -37,12 +38,14 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \
|
||||||
#:use-module (guix utils)
|
#:use-module (guix utils)
|
||||||
#:use-module (ice-9 format)
|
#:use-module (ice-9 format)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
|
#:use-module (ice-9 vlist)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-34)
|
#:use-module (srfi srfi-34)
|
||||||
#:use-module (srfi srfi-37)
|
#: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))
|
#:export (guix-build))
|
||||||
|
|
||||||
(define %store
|
(define %store
|
||||||
|
@ -196,13 +199,24 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
|
||||||
root (strerror (system-error-errno args)))
|
root (strerror (system-error-errno args)))
|
||||||
(exit 1)))))
|
(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)
|
(define (find-package request)
|
||||||
;; Return a package matching REQUEST. REQUEST may be a package
|
;; Return a package matching REQUEST. REQUEST may be a package
|
||||||
;; name, or a package name followed by a hyphen and a version
|
;; 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)
|
(let-values (((name version)
|
||||||
(package-name->name+version request)))
|
(package-name->name+version request)))
|
||||||
(match (find-packages-by-name name version)
|
(match (find-best-packages-by-name name version)
|
||||||
((p) ; one match
|
((p) ; one match
|
||||||
p)
|
p)
|
||||||
((p x ...) ; several matches
|
((p x ...) ; several matches
|
||||||
|
|
|
@ -14,6 +14,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
||||||
|
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; 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 format)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 regex)
|
#:use-module (ice-9 regex)
|
||||||
|
#:use-module (ice-9 vlist)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
|
@ -346,6 +348,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
||||||
(option '(#\r "remove") #t #f
|
(option '(#\r "remove") #t #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'remove 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
|
(option '("roll-back") #f #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'roll-back? #t result)))
|
(alist-cons 'roll-back? #t result)))
|
||||||
|
@ -421,9 +426,20 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
||||||
(length req*))
|
(length req*))
|
||||||
(null? req*) 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)
|
(define (find-package name)
|
||||||
;; Find the package NAME; NAME may contain a version number and a
|
;; 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 request name)
|
||||||
|
|
||||||
(define (ensure-output p sub-drv)
|
(define (ensure-output p sub-drv)
|
||||||
|
@ -441,7 +457,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
||||||
(substring name (+ 1 colon))))))
|
(substring name (+ 1 colon))))))
|
||||||
((name version)
|
((name version)
|
||||||
(package-name->name+version name)))
|
(package-name->name+version name)))
|
||||||
(match (find-packages-by-name name version)
|
(match (find-best-packages-by-name name version)
|
||||||
((p)
|
((p)
|
||||||
(list name (package-version p) sub-drv (ensure-output p sub-drv)
|
(list name (package-version p) sub-drv (ensure-output p sub-drv)
|
||||||
(package-transitive-propagated-inputs p)))
|
(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)))))
|
(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)
|
(define (ensure-default-profile)
|
||||||
;; Ensure the default profile symlink and directory exist.
|
;; Ensure the default profile symlink and directory exist.
|
||||||
|
|
||||||
|
@ -510,13 +541,32 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
||||||
(begin
|
(begin
|
||||||
(roll-back profile)
|
(roll-back profile)
|
||||||
(process-actions (alist-delete 'roll-back? opts)))
|
(process-actions (alist-delete 'roll-back? opts)))
|
||||||
(let* ((install (filter-map (match-lambda
|
(let* ((installed (manifest-packages (profile-manifest profile)))
|
||||||
(('install . (? store-path?))
|
(upgrade-regexps (filter-map (match-lambda
|
||||||
#f)
|
(('upgrade . regexp)
|
||||||
(('install . package)
|
(make-regexp regexp))
|
||||||
(find-package package))
|
(_ #f))
|
||||||
(_ #f))
|
opts))
|
||||||
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
|
(drv (filter-map (match-lambda
|
||||||
((name version sub-drv
|
((name version sub-drv
|
||||||
(? package? package)
|
(? package? package)
|
||||||
|
@ -553,10 +603,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
||||||
(match package
|
(match package
|
||||||
((name _ ...)
|
((name _ ...)
|
||||||
(alist-delete name result))))
|
(alist-delete name result))))
|
||||||
(fold alist-delete
|
(fold alist-delete installed remove)
|
||||||
(manifest-packages
|
|
||||||
(profile-manifest profile))
|
|
||||||
remove)
|
|
||||||
install*))))
|
install*))))
|
||||||
|
|
||||||
(when (equal? profile %current-profile)
|
(when (equal? profile %current-profile)
|
||||||
|
|
Loading…
Reference in New Issue