refresh: Add '--type' option.

* guix/scripts/refresh.scm (%options, show-help): Add --type.
  (lookup-updater): New procedure.
  (update-package): Add 'updaters' parameter and honor it.
  (guix-refresh)[options->updaters]: New procedure.
  Use it, and honor --type.
This commit is contained in:
Ludovic Courtès 2015-10-21 13:04:34 +02:00
parent a7aac93625
commit bcb571cba4
2 changed files with 71 additions and 20 deletions

View file

@ -4211,8 +4211,12 @@ gnu/packages/glib.scm:77:12: glib would be upgraded from 2.34.3 to 2.37.0
@end example
It does so by browsing each package's FTP directory and determining the
highest version number of the source tarballs
therein@footnote{Currently, this only works for GNU packages.}.
highest version number of the source tarballs therein. The command
knows how to update specific types of packages: GNU packages, ELPA
packages, etc.---see the documentation for @option{--type} below. The
are many packages, though, for which it lacks a method to determine
whether a new upstream release is available. However, the mechanism is
extensible, so feel free to get in touch with us to add a new method!
When passed @code{--update}, it modifies distribution source files to
update the version numbers and source tarball hashes of those packages'
@ -4257,6 +4261,26 @@ The @code{non-core} subset refers to the remaining packages. It is
typically useful in cases where an update of the core packages would be
inconvenient.
@item --type=@var{updater}
@itemx -t @var{updater}
Select only packages handled by @var{updater}. Currently, @var{updater}
may be one of:
@table @code
@item gnu
the updater for GNU packages;
@item elpa
the updater for @uref{http://elpa.gnu.org/, ELPA} packages.
@end table
For instance, the following commands only checks for updates of Emacs
packages hosted at @code{elpa.gnu.org}:
@example
$ guix refresh -t elpa
gnu/packages/emacs.scm:856:13: emacs-auctex would be upgraded from 11.88.6 to 11.88.9
@end example
@end table
In addition, @command{guix refresh} can be passed one or more package

View file

@ -65,6 +65,9 @@ (define %options
(x
(leave (_ "~a: invalid selection; expected `core' or `non-core'~%")
arg)))))
(option '(#\t "type") #t #f
(lambda (opt name arg result)
(alist-cons 'updater (string->symbol arg) result)))
(option '(#\l "list-dependent") #f #f
(lambda (opt name arg result)
(alist-cons 'list-dependent? #t result)))
@ -106,6 +109,8 @@ (define (show-help)
-s, --select=SUBSET select all the packages in SUBSET, one of
`core' or `non-core'"))
(display (_ "
-t, --type=UPDATER restrict to updates from UPDATER--e.g., 'gnu'"))
(display (_ "
-l, --list-dependent list top-level dependent packages that would need to
be rebuilt as a result of upgrading PACKAGE..."))
(newline)
@ -136,14 +141,21 @@ (define %updaters
(list %gnu-updater
%elpa-updater))
(define* (update-package store package #:key (key-download 'interactive))
(define (lookup-updater name)
"Return the updater called NAME."
(find (lambda (updater)
(eq? name (upstream-updater-name updater)))
%updaters))
(define* (update-package store package updaters
#:key (key-download 'interactive))
"Update the source file that defines PACKAGE with the new version.
KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
values: 'interactive' (default), 'always', and 'never'."
(let-values (((version tarball)
(catch #t
(lambda ()
(package-update store package %updaters
(package-update store package updaters
#:key-download key-download))
(lambda _
(values #f #f))))
@ -180,6 +192,19 @@ (define (parse-options)
(alist-cons 'argument arg result))
%default-options))
(define (options->updaters opts)
;; Return the list of updaters to use.
(match (filter-map (match-lambda
(('updater . name)
(lookup-updater name))
(_ #f))
opts)
(()
;; Use the default updaters.
%updaters)
(lst
lst)))
(define (keep-newest package lst)
;; If a newer version of PACKAGE is already in LST, return LST; otherwise
;; return LST minus the other version of PACKAGE in it, plus PACKAGE.
@ -196,8 +221,8 @@ (define (keep-newest package lst)
(define core-package?
(let* ((input->package (match-lambda
((name (? package? package) _ ...) package)
(_ #f)))
((name (? package? package) _ ...) package)
(_ #f)))
(final-inputs (map input->package %final-inputs))
(core (append final-inputs
(append-map (compose (cut filter-map input->package <>)
@ -216,6 +241,7 @@ (define core-package?
(let* ((opts (parse-options))
(update? (assoc-ref opts 'update?))
(updaters (options->updaters opts))
(list-dependent? (assoc-ref opts 'list-dependent?))
(key-download (assoc-ref opts 'key-download))
(packages
@ -226,18 +252,18 @@ (define core-package?
(specification->package spec))
(_ #f))
opts)
(() ; default to all packages
(let ((select? (match (assoc-ref opts 'select)
('core core-package?)
('non-core (negate core-package?))
(_ (const #t)))))
(fold-packages (lambda (package result)
(if (select? package)
(keep-newest package result)
result))
'())))
(some ; user-specified packages
some))))
(() ; default to all packages
(let ((select? (match (assoc-ref opts 'select)
('core core-package?)
('non-core (negate core-package?))
(_ (const #t)))))
(fold-packages (lambda (package result)
(if (select? package)
(keep-newest package result)
result))
'())))
(some ; user-specified packages
some))))
(with-error-handling
(cond
(list-dependent?
@ -269,11 +295,12 @@ (define core-package?
(or (assoc-ref opts 'gpg-command)
(%gpg-command))))
(for-each
(cut update-package store <> #:key-download key-download)
(cut update-package store <> updaters
#:key-download key-download)
packages))))
(else
(for-each (lambda (package)
(match (package-update-path package %updaters)
(match (package-update-path package updaters)
((? upstream-source? source)
(let ((loc (or (package-field-location package 'version)
(package-location package))))