From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([209.51.188.92]:37010) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ghtLE-000657-0c for guix-patches@gnu.org; Fri, 11 Jan 2019 04:43:05 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ghtLC-0001m2-P1 for guix-patches@gnu.org; Fri, 11 Jan 2019 04:43:03 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:55345) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1ghtLC-0001lu-LK for guix-patches@gnu.org; Fri, 11 Jan 2019 04:43:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ghtLC-0006Pr-IU for guix-patches@gnu.org; Fri, 11 Jan 2019 04:43:02 -0500 Subject: [bug#34040] [PATCH 1/2] refresh: Suggest input changes when updating. References: <8736pzpnhg.fsf@elephly.net> In-Reply-To: <8736pzpnhg.fsf@elephly.net> Resent-Message-ID: From: Ricardo Wurmus Message-ID: <20190111094208.28327-1-rekado@elephly.net> Date: Fri, 11 Jan 2019 10:42:07 +0100 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 34040@debbugs.gnu.org Cc: Ricardo Wurmus * guix/upstream.scm ()[input-changes]: New field. (): 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 =C2=A9 2016 Ben Woodcroft ;;; Copyright =C2=A9 2017 Mathieu Othacehe ;;; Copyright =C2=A9 2018 Efraim Flashner +;;; Copyright =C2=A9 2019 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -224,7 +225,7 @@ KEY-DOWNLOAD specifies a download policy for missing Op= enPGP keys; allowed values: 'interactive' (default), 'always', and 'never'. When WARN? is tru= e, 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 chan= ge) + (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 inp= ut: ~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 i= nput: ~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 =C2=A9 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 = Ludovic Court=C3=A8s ;;; Copyright =C2=A9 2015 Alex Kost +;;; Copyright =C2=A9 2019 Ricardo Wurmus ;;; ;;; 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 =20 url-prefix-predicate coalesce-sources @@ -56,6 +58,12 @@ upstream-updater-predicate upstream-updater-latest =20 + upstream-input-change? + upstream-input-change-name + upstream-input-change-type + upstream-input-change-action + changed-inputs + %updaters lookup-updater =20 @@ -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 make-upstream-input-change + upstream-input-change? + (name upstream-input-change-name) ;string + (type upstream-input-change-type) ;symbol: regular | native | prop= agated + (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)) ...)))) la= bel) + (_ '()))) + (new-native + (match expr + ((path *** ('native-inputs + ('quasiquote ((label ('unquote sym)) ...)))) la= bel) + (_ '()))) + (new-propagated + (match expr + ((path *** ('propagated-inputs + ('quasiquote ((label ('unquote sym)) ...)))) la= bel) + (_ '()))) + (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)))))) + (_ '()))) =20 (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 tha= t match PRED." =20 (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 in= put +changes for PACKAGE, or #f and #f when PACKAGE is up-to-date. KEY-DOWNLOA= D +specifies a download policy for missing OpenPGP keys; allowed values: +'always', 'never', and 'interactive' (default)." (match (package-latest-release* package updaters) - (($ _ version urls signature-urls) + (($ _ 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)))) =20 (define (update-package-source package version hash) "Modify the source file that defines PACKAGE to refer to VERSION, --=20 2.20.1