[bug#34040] [PATCH 1/2] refresh: Suggest input changes when updating.

[Ricardo Wurmus <rekado@elephly.net>]

* guix/upstream.scm (<upstream-source>)[input-changes]: New field.
(<upstream-input-change>): New record.
(upstream-input-change?, upstream-input-change-name,
upstream-input-change-type, upstream-input-change-action, changed-inputs): New
procedures.
(package-update): Pass along input changes.
* guix/script/refresh.scm (update-package): Process input changes.
---
 guix/scripts/refresh.scm | 23 +++++++++-
 guix/upstream.scm        | 90 ++++++++++++++++++++++++++++++++++++----
 2 files changed, 104 insertions(+), 9 deletions(-)

diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 003c915da..15cf385fb 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -224,7 +225,7 @@ KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
 values: 'interactive' (default), 'always', and 'never'.  When WARN? is true,
 warn about packages that have no matching updater."
   (if (lookup-updater package updaters)
-      (let-values (((version tarball)
+      (let-values (((version tarball changes)
                     (package-update store package updaters
                                     #:key-download key-download))
                    ((loc)
@@ -238,6 +239,26 @@ warn about packages that have no matching updater."
                         (location->string loc)
                         (package-name package)
                         (package-version package) version)
+                (for-each
+                 (lambda (change)
+                   (format (current-error-port)
+                           (match (list (upstream-input-change-action change)
+                                        (upstream-input-change-type change))
+                             (('add 'regular)
+                              (G_ "~a: consider adding this input: ~a~%"))
+                             (('add 'native)
+                              (G_ "~a: consider adding this native input: ~a~%"))
+                             (('add 'propagated)
+                              (G_ "~a: consider adding this propagated input: ~a~%"))
+                             (('remove 'regular)
+                              (G_ "~a: consider removing this input: ~a~%"))
+                             (('remove 'native)
+                              (G_ "~a: consider removing this native input: ~a~%"))
+                             (('remove 'propagated)
+                              (G_ "~a: consider removing this propagated input: ~a~%")))
+                           (package-name package)
+                           (upstream-input-change-name change)))
+                 (changes))
                 (let ((hash (call-with-input-file tarball
                               port-sha256)))
                   (update-package-source package version hash)))
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 9e1056f7a..880cb9094 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
+;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -45,6 +46,7 @@
             upstream-source-urls
             upstream-source-signature-urls
             upstream-source-archive-types
+            upstream-source-input-changes
 
             url-prefix-predicate
             coalesce-sources
@@ -56,6 +58,12 @@
             upstream-updater-predicate
             upstream-updater-latest
 
+            upstream-input-change?
+            upstream-input-change-name
+            upstream-input-change-type
+            upstream-input-change-action
+            changed-inputs
+
             %updaters
             lookup-updater
 
@@ -82,7 +90,73 @@
   (version        upstream-source-version)        ;string
   (urls           upstream-source-urls)           ;list of strings
   (signature-urls upstream-source-signature-urls  ;#f | list of strings
-                  (default #f)))
+                  (default #f))
+  (input-changes  upstream-source-input-changes
+                  (default '()) (thunked)))
+
+;; Representation of an upstream input change.
+(define-record-type* <upstream-input-change>
+  upstream-input-change make-upstream-input-change
+  upstream-input-change?
+  (name    upstream-input-change-name)    ;string
+  (type    upstream-input-change-type)    ;symbol: regular | native | propagated
+  (action  upstream-input-change-action)) ;symbol: add | remove
+
+(define (changed-inputs package package-sexp)
+  "Return a list of input changes for PACKAGE based on the newly imported
+S-expression PACKAGE-SEXP."
+  (match package-sexp
+    ((and expr ('package fields ...))
+     (let* ((input->name (match-lambda ((name pkg . out) name)))
+            (new-regular
+             (match expr
+               ((path *** ('inputs
+                           ('quasiquote ((label ('unquote sym)) ...)))) label)
+               (_ '())))
+            (new-native
+             (match expr
+               ((path *** ('native-inputs
+                           ('quasiquote ((label ('unquote sym)) ...)))) label)
+               (_ '())))
+            (new-propagated
+             (match expr
+               ((path *** ('propagated-inputs
+                           ('quasiquote ((label ('unquote sym)) ...)))) label)
+               (_ '())))
+            (current-regular
+             (map input->name (package-inputs package)))
+            (current-native
+             (map input->name (package-native-inputs package)))
+            (current-propagated
+             (map input->name (package-propagated-inputs package))))
+       (append-map
+        (match-lambda
+          ((action type names)
+           (map (lambda (name)
+                  (upstream-input-change
+                   (name name)
+                   (type type)
+                   (action action)))
+                names)))
+        `((add regular
+           ,(lset-difference equal?
+                             new-regular current-regular))
+          (remove regular
+           ,(lset-difference equal?
+                             current-regular new-regular))
+          (add native
+           ,(lset-difference equal?
+                             new-native current-native))
+          (remove native
+           ,(lset-difference equal?
+                             current-native new-native))
+          (add propagated
+           ,(lset-difference equal?
+                             new-propagated current-propagated))
+          (remove propagated
+           ,(lset-difference equal?
+                             current-propagated new-propagated))))))
+    (_ '())))
 
 (define (url-prefix-predicate prefix)
   "Return a predicate that returns true when passed a package where one of its
@@ -268,12 +342,12 @@ values: the item from LST1 and the item from LST2 that match PRED."
 
 (define* (package-update store package updaters
                          #:key (key-download 'interactive))
-  "Return the new version and the file name of the new version tarball for
-PACKAGE, or #f and #f when PACKAGE is up-to-date.  KEY-DOWNLOAD specifies a
-download policy for missing OpenPGP keys; allowed values: 'always', 'never',
-and 'interactive' (default)."
+  "Return the new version, the file name of the new version tarball and input
+changes for PACKAGE, or #f and #f when PACKAGE is up-to-date.  KEY-DOWNLOAD
+specifies a download policy for missing OpenPGP keys; allowed values:
+'always', 'never', and 'interactive' (default)."
   (match (package-latest-release* package updaters)
-    (($ <upstream-source> _ version urls signature-urls)
+    (($ <upstream-source> _ version urls signature-urls changes)
      (let*-values (((name)
                     (package-name package))
                    ((archive-type)
@@ -299,9 +373,9 @@ and 'interactive' (default)."
                            (or signature-urls (circular-list #f)))))
        (let ((tarball (download-tarball store url signature-url
                                         #:key-download key-download)))
-         (values version tarball))))
+         (values version tarball changes))))
     (#f
-     (values #f #f))))
+     (values #f #f #f))))
 
 (define (update-package-source package version hash)
   "Modify the source file that defines PACKAGE to refer to VERSION,
-- 
2.20.1