~ruther/guix-local

bcb571cba499c29556d36f17554253d285d4d578 — Ludovic Courtès 10 years ago a7aac93
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.
2 files changed, 71 insertions(+), 20 deletions(-)

M doc/guix.texi
M guix/scripts/refresh.scm
M doc/guix.texi => doc/guix.texi +26 -2
@@ 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

M guix/scripts/refresh.scm => guix/scripts/refresh.scm +45 -18
@@ 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))))