summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2023-05-17 16:52:54 +0200
committerLudovic Courtès <ludo@gnu.org>2023-05-31 23:25:25 +0200
commitec0a2fc87bd651ebc8f253f6369ba4485912d9b2 (patch)
tree1aff0cf18ee1ba57147b3c3bd972d1118cf51d2b /guix
parent9f3ea03516b506d7c0440867b9db08898390a981 (diff)
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.
Diffstat (limited to 'guix')
-rw-r--r--guix/import/test.scm13
-rw-r--r--guix/scripts/refresh.scm36
-rw-r--r--guix/upstream.scm56
3 files changed, 64 insertions, 41 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 @@
(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 d838a4aca2..9676271542 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -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 \
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 4ae2d1c8c8..7d9ae70eda 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -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")