nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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:
Mark H Weaver 2013-02-12 01:24:21 -05:00
parent c2868b1e0c
commit dc5669cd65
4 changed files with 106 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
doc/guix.texi
View File

@ -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

26
gnu/packages.scm
View File

@ -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))

20
guix-build.in
View File

@ -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

63
guix-package.in
View File

@ -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)))
(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?)) (('install . (? store-path?))
#f) #f)
(('install . package) (('install . package)
(find-package package)) (find-package package))
(_ #f)) (_ #f))
opts)) 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)