* 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(-)
Toggle diff (188 lines)
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