From bcb571cba499c29556d36f17554253d285d4d578 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 21 Oct 2015 13:04:34 +0200 Subject: [PATCH] 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. --- doc/guix.texi | 28 ++++++++++++++++-- guix/scripts/refresh.scm | 63 ++++++++++++++++++++++++++++------------ 2 files changed, 71 insertions(+), 20 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 3222a64085..6f26568a7a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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 diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 8e461ce380..bbfdf240d0 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -65,6 +65,9 @@ (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 @@ specified with `--select'.\n")) -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 @@ specified with `--select'.\n")) (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 @@ downloaded and authenticated; not updating~%") (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 @@ downloaded and authenticated; not updating~%") (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 @@ update would trigger a complete rebuild." (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 @@ update would trigger a complete rebuild." (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 @@ dependent packages are rebuilt: ~{~a~^ ~}~%" (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))))