[bug#63571] [PATCH 08/14] upstream: 'update-package-source' edits input fields.

["Ludovic Courtès" <ludo@gnu.org>]

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.
---
 guix/import/test.scm     | 13 +++++++++-
 guix/scripts/refresh.scm | 36 --------------------------
 guix/upstream.scm        | 56 +++++++++++++++++++++++++++++++++++++---
 tests/guix-refresh.sh    |  7 +++--
 4 files changed, 69 insertions(+), 43 deletions(-)

diff --git a/guix/import/test.scm b/guix/import/test.scm
index b1ed0b455d..4bd356bddc 100644
--- a/guix/import/test.scm
+++ b/guix/import/test.scm
@@ -52,7 +52,18 @@ (define (available-updates package)
                                         (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))))
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index e9e3eda9eb..7d74729a88 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -366,42 +366,6 @@ (define* (update-package store package version updaters
                       (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 \
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 29dd923e63..1a90a342ff 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -38,6 +38,7 @@ (define-module (guix upstream)
   #: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)
@@ -576,6 +577,52 @@ (define* (package-update store package
                   (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
@@ -630,9 +677,7 @@ (define* (update-package-source package source hash)
               ;; 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))
@@ -641,8 +686,11 @@ (define* (update-package-source package source hash)
                                           `((,(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")
diff --git a/tests/guix-refresh.sh b/tests/guix-refresh.sh
index 691020b031..9d7a57a36e 100644
--- a/tests/guix-refresh.sh
+++ b/tests/guix-refresh.sh
@@ -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?
-- 
2.40.1