~ruther/guix-local

ec0a2fc87bd651ebc8f253f6369ba4485912d9b2 — Ludovic Courtès 3 years ago 9f3ea03
upstream: 'update-package-source' edits input fields.

Previously, 'guix refresh r-ggplot2 -u' and similar commands would print
of list of input changes that would have to be made manually.  With this
change, 'guix refresh -u' takes care of updating input fields
automatically.

* guix/upstream.scm (update-package-inputs): New procedure.
(update-package-source): Call it when 'upstream-source-inputs' returns
true.
* guix/scripts/refresh.scm (update-package): Remove iteration over the
result of 'changed-inputs'.
* guix/import/test.scm (available-updates): Add support for input
lists.
* tests/guix-refresh.sh (GUIX_TEST_UPDATER_TARGETS): Add input list for
"the-test-package".
Make sure 'guix refresh -u' updates 'inputs' accordingly.
* doc/guix.texi (Invoking guix refresh): Mention it.
5 files changed, 72 insertions(+), 45 deletions(-)

M doc/guix.texi
M guix/import/test.scm
M guix/scripts/refresh.scm
M guix/upstream.scm
M tests/guix-refresh.sh
M doc/guix.texi => doc/guix.texi +3 -2
@@ 14309,8 14309,9 @@ to that effect:
@end lisp

When passed @option{--update}, it modifies distribution source files to
update the version numbers and source tarball hashes of those package
recipes (@pxref{Defining Packages}).  This is achieved by downloading
update the version numbers and source code hashes of those package
definitions, as well as possibly their inputs (@pxref{Defining Packages}).
This is achieved by downloading
each package's latest source tarball and its associated OpenPGP
signature, authenticating the downloaded tarball against its signature
using @command{gpgv}, and finally computing its hash---note that GnuPG must be

M guix/import/test.scm => guix/import/test.scm +12 -1
@@ 52,7 52,18 @@
                                        (upstream-source
                                         (package (package-name package))
                                         (version version)
                                         (urls (list url)))))
                                         (urls (list url))))
                                       ((version url (inputs ...))
                                        (upstream-source
                                         (package (package-name package))
                                         (version version)
                                         (urls (list url))
                                         (inputs
                                          (map (lambda (name)
                                                 (upstream-input
                                                  (name name)
                                                  (downstream-name name)))
                                               inputs)))))
                                     updates)
                                result)
                        result))))

M guix/scripts/refresh.scm => guix/scripts/refresh.scm +0 -36
@@ 369,42 369,6 @@ warn about packages that have no matching updater."
                      (G_ "~a: updating from version ~a to version ~a...~%")
                      (package-name package)
                      (package-version package) version)
                (for-each
                 (lambda (change)
                   (define field
                     (match (upstream-input-change-type change)
                       ('native 'native-inputs)
                       ('propagated 'propagated-inputs)
                       (_ 'inputs)))

                   (define name
                     (package-name package))
                   (define loc
                     (package-field-location package field))
                   (define change-name
                     (upstream-input-change-name change))

                   (match (list (upstream-input-change-action change)
                                (upstream-input-change-type change))
                     (('add 'regular)
                      (info loc (G_ "~a: consider adding this input: ~a~%")
                            name change-name))
                     (('add 'native)
                      (info loc (G_ "~a: consider adding this native input: ~a~%")
                            name change-name))
                     (('add 'propagated)
                      (info loc (G_ "~a: consider adding this propagated input: ~a~%")
                            name change-name))
                     (('remove 'regular)
                      (info loc (G_ "~a: consider removing this input: ~a~%")
                            name change-name))
                     (('remove 'native)
                      (info loc (G_ "~a: consider removing this native input: ~a~%")
                            name change-name))
                     (('remove 'propagated)
                      (info loc (G_ "~a: consider removing this propagated input: ~a~%")
                            name change-name))))
                 (changed-inputs package source))
                (let ((hash (file-hash* output)))
                  (update-package-source package source hash)))
              (warning (G_ "~a: version ~a could not be \

M guix/upstream.scm => guix/upstream.scm +52 -4
@@ 38,6 38,7 @@
  #:use-module (guix hash)
  #:use-module (guix store)
  #:use-module ((guix derivations) #:select (built-derivations derivation->output-path))
  #:autoload   (guix read-print) (object->string*)
  #:autoload   (gcrypt hash) (port-sha256)
  #:use-module (guix monads)
  #:use-module (srfi srfi-1)


@@ 583,6 584,52 @@ this method: ~s")
                  (package-name package)))
     (values #f #f #f))))

(define (update-package-inputs package source)
  "Update the input fields of the definition of PACKAGE according to those
specified in SOURCE, an <upstream-source>."
  (define (update-field field source-inputs package-inputs)
    (define loc
      (package-field-location package field))

    (define new
      (map (compose string->symbol upstream-input-downstream-name)
           (source-inputs source)))

    (define old
      (match (package-inputs package)
        (((labels (? package? packages)) ...)
         labels)
        (_
         '())))

    (define unchanged?
      (equal? new old))

    (if (and loc (not unchanged?))
        (edit-expression (location->source-properties
                          (absolute-location loc))
                         (lambda (str)
                           (object->string* `(list ,@new)
                                            (location-column loc))))
        (unless unchanged?
          ;; XXX: Bail out when FIELD isn't already present in the source.
          ;; TODO: Add the field if it's missing.
          (warning (package-location package)
                   (G_ "~a: '~a' field not found; leaving it unchanged~%")
                   (package-name package) field)
          (warning (package-location package)
                   (G_ "~a: expected '~a' value: ~s~%")
                   (package-name package) field new))))

  (for-each update-field
            '(inputs native-inputs propagated-inputs)
            (list upstream-source-regular-inputs
                  upstream-source-native-inputs
                  upstream-source-propagated-inputs)
            (list package-inputs
                  package-native-inputs
                  package-propagated-inputs)))

(define* (update-package-source package source hash)
  "Modify the source file that defines PACKAGE to refer to SOURCE, an
<upstream-source> whose tarball has SHA256 HASH (a bytevector).  Return the


@@ 637,9 684,7 @@ new version string if an update was made, and #f otherwise."
              ;; function of the person who uploads the package.  Note that
              ;; package definitions usually concatenate fragments of the URL,
              ;; which is why we only attempt to replace a subset of the URL.
              (let ((properties (location->source-properties
                                 (absolute-location loc)))
                    (replacements `((,old-version . ,version)
              (let ((replacements `((,old-version . ,version)
                                    (,old-hash . ,hash)
                                    ,@(if (and old-commit new-commit)
                                          `((,old-commit . ,new-commit))


@@ 648,8 693,11 @@ new version string if an update was made, and #f otherwise."
                                          `((,(dirname old-url) .
                                             ,(dirname new-url)))
                                          '()))))
                (and (edit-expression properties
                (and (edit-expression (location->source-properties
                                       (absolute-location loc))
                                      (cut update-expression <> replacements))
                     (or (not (upstream-source-inputs source))
                         (update-package-inputs package source))
                     version))
              (begin
                (warning (G_ "~a: could not locate source file")

M tests/guix-refresh.sh => tests/guix-refresh.sh +5 -2
@@ 34,7 34,8 @@ GUIX_TEST_UPDATER_TARGETS='
                 ("1.6.4" "file:///dev/null")))
   ("libreoffice" "" (("1.0" "file:///dev/null")))
   ("idutils" "" (("'$idutils_version'" "file:///dev/null")))
   ("the-test-package" "" (("5.5" "file://'$PWD/$module_dir'/source"))))'
   ("the-test-package" "" (("5.5" "file://'$PWD/$module_dir'/source"
                                   ("grep" "sed")))))'

# No newer version available.
guix refresh -t test idutils	# XXX: should return non-zero?


@@ 91,13 92,15 @@ cat > "$module_dir/sample.scm"<<EOF
                                  ".tar.gz"))
              (sha256
               (base32
                "086vqwk2wl8zfs47sq2xpjc9k066ilmb8z6dn0q6ymwjzlm196cd"))))))
                "086vqwk2wl8zfs47sq2xpjc9k066ilmb8z6dn0q6ymwjzlm196cd"))))
    (inputs (list coreutils tar))))
EOF
guix refresh -t test -L "$module_dir" the-test-package
guix refresh -t test -L "$module_dir" the-test-package -u \
     --keyring="$module_dir/keyring.kbx"  # so we don't create $HOME/.config
grep 'version "5.5"' "$module_dir/sample.scm"
grep "$(guix hash -H sha256 -f nix-base32 "$module_dir/source")" "$module_dir/sample.scm"
grep '(inputs (list grep sed))' "$module_dir/sample.scm"

# Specifying a target version.
guix refresh -t test guile=2.0.0 # XXX: should return non-zero?