diff mbox

refresh: Suggest changes to inputs when updating.

Message ID 20161025195142.3299-1-rekado@elephly.net
State New
Headers show

Commit Message

Ricardo Wurmus Oct. 25, 2016, 7:51 p.m. UTC
* guix/scripts/refresh.scm (updater->importer-info): New procedure.
(mock): New syntax rule.
(update-package): Run matching importer to suggest changes to inputs.
---
 guix/scripts/refresh.scm | 98 +++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 97 insertions(+), 1 deletion(-)

Comments

Ludovic Courtès Oct. 28, 2016, 1:04 p.m. UTC | #1
Hello!

Thanks for tackling this, it’s more and more needed!

Ricardo Wurmus <rekado@elephly.net> skribis:

> * guix/scripts/refresh.scm (updater->importer-info): New procedure.
> (mock): New syntax rule.
> (update-package): Run matching importer to suggest changes to inputs.

Tests and a bit of documentation would be welcome for the final
revision.

> +(define (updater->importer-info updater-name)
> +  "Return a list containing an update procedure, a package name converter,
> +and, optionally, an archive symbol for the given UPDATER-NAME.  Return #F for
> +an unknown updater."
> +  (case updater-name
> +    ((gnu)
> +     (list gnu->guix-package
> +           package-name))
> +    ((elpa)
> +     (list elpa->guix-package
> +           package-name))
> +    ((cran)
> +     (list cran->guix-package
> +           (@@ (guix import cran) package->upstream-name)))
> +    ((bioconductor)
> +     (list cran->guix-package
> +           (@@ (guix import cran) package->upstream-name)
> +           'bioconductor))
> +    ((hackage)
> +     (list hackage->guix-package
> +           (@@ (guix import gem) guix-package->hackage-name)))
> +    ((pypi)
> +     (list pypi->guix-package
> +           guix-package->pypi-name))
> +    ((gem)
> +     (list gem->guix-package
> +           (@@ (guix import gem) guix-package->gem-name)))
> +    (else #f)))

This is not OK because it breaks the <upstream-updater> abstraction.

> +;; FIXME: copied from (guix tests)
> +(define-syntax-rule (mock (module proc replacement) body ...)
> +  "Within BODY, replace the definition of PROC from MODULE with the definition
> +given by REPLACEMENT."
> +  (let* ((m (resolve-module 'module))
> +         (original (module-ref m 'proc)))
> +    (dynamic-wind
> +      (lambda () (module-set! m 'proc replacement))
> +      (lambda () body ...)
> +      (lambda () (module-set! m 'proc original)))))

This is OK for tests but not for Real Code.  :-)

>  (define* (update-package store package updaters
>                           #:key (key-download 'interactive))
>    "Update the source file that defines PACKAGE with the new version.
> @@ -246,7 +287,62 @@ values: 'interactive' (default), 'always', and 'never'."
>                      (package-version package) version)
>              (let ((hash (call-with-input-file tarball
>                            port-sha256)))
> -              (update-package-source package version hash)))
> +              (update-package-source package version hash))
> +
> +            ;; Run importer to compare inputs and suggest changes.
> +            (let* ((updater (find (lambda (updater)
> +                                    ((upstream-updater-predicate updater) package))
> +                                  updaters))
> +                   (updater-name (upstream-updater-name updater)))
> +              (match (updater->importer-info updater-name)
> +                (#f #t) ; do nothing if there's no matching importer
> +                ((importer convert-name . archive)
> +                 ;; Replace "download-to-store" to avoid downloading the
> +                 ;; tarball again.
> +                 (match (mock ((guix download) download-to-store
> +                               (lambda _ tarball))
> +                         (apply importer (convert-name package) archive))
> +                   ((and expr ('package fields ...))
> +                    ;; FIXME: Is there a nicer way to match names in the
> +                    ;; package expression?  Could we compare actual packages
> +                    ;; instead of only their labels?
> +                    (let* ((imported-inputs
> +                            (append
> +                             (match expr
> +                               ((path *** ('inputs
> +                                           ('quasiquote ((label ('unquote sym)) ...)))) label)
> +                               (_ '()))

What if we first changed importers to return a <package> instead of an
sexp?

That way we could (1) factorize the ‘package->sexp’ machinery in (guix
upstream), and (2) simplify this specific use case.

A downside is that syntactic sugar, like when the importer returns an
sexp representing a call to ‘pypi-uri’, would be lost.  Hmm.

Anyway, I think the functionality (determining the set of inputs that
needs to be changed) should go to (guix upstream).  The user messages
(“consider removing these inputs”, etc.) should go to (guix refresh).

Concretely, ‘package-update-path’ could be changed to return not just an
<upstream-source> but also dependency information.  That could be
achieved by adding native/propagated/regular inputs to
<upstream-source>, or maybe preferably by creating a new
<upstream-dependency> record to carry that information.

WDYT?

That said, I can imagine that this patch has already been extremely
helpful for mass updates…

Thank you!

Ludo’.
diff mbox

Patch

diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index b81c69f..861972c 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -4,6 +4,7 @@ 
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
+;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -208,6 +209,35 @@  unavailable optional dependencies such as Guile-JSON."
                  ((guix import gem) => %gem-updater)
                  ((guix import github) => %github-updater)))
 
+(define (updater->importer-info updater-name)
+  "Return a list containing an update procedure, a package name converter,
+and, optionally, an archive symbol for the given UPDATER-NAME.  Return #F for
+an unknown updater."
+  (case updater-name
+    ((gnu)
+     (list gnu->guix-package
+           package-name))
+    ((elpa)
+     (list elpa->guix-package
+           package-name))
+    ((cran)
+     (list cran->guix-package
+           (@@ (guix import cran) package->upstream-name)))
+    ((bioconductor)
+     (list cran->guix-package
+           (@@ (guix import cran) package->upstream-name)
+           'bioconductor))
+    ((hackage)
+     (list hackage->guix-package
+           (@@ (guix import gem) guix-package->hackage-name)))
+    ((pypi)
+     (list pypi->guix-package
+           guix-package->pypi-name))
+    ((gem)
+     (list gem->guix-package
+           (@@ (guix import gem) guix-package->gem-name)))
+    (else #f)))
+
 (define (lookup-updater name)
   "Return the updater called NAME."
   (or (find (lambda (updater)
@@ -225,6 +255,17 @@  unavailable optional dependencies such as Guile-JSON."
             %updaters)
   (exit 0))
 
+;; FIXME: copied from (guix tests)
+(define-syntax-rule (mock (module proc replacement) body ...)
+  "Within BODY, replace the definition of PROC from MODULE with the definition
+given by REPLACEMENT."
+  (let* ((m (resolve-module 'module))
+         (original (module-ref m 'proc)))
+    (dynamic-wind
+      (lambda () (module-set! m 'proc replacement))
+      (lambda () body ...)
+      (lambda () (module-set! m 'proc original)))))
+
 (define* (update-package store package updaters
                          #:key (key-download 'interactive))
   "Update the source file that defines PACKAGE with the new version.
@@ -246,7 +287,62 @@  values: 'interactive' (default), 'always', and 'never'."
                     (package-version package) version)
             (let ((hash (call-with-input-file tarball
                           port-sha256)))
-              (update-package-source package version hash)))
+              (update-package-source package version hash))
+
+            ;; Run importer to compare inputs and suggest changes.
+            (let* ((updater (find (lambda (updater)
+                                    ((upstream-updater-predicate updater) package))
+                                  updaters))
+                   (updater-name (upstream-updater-name updater)))
+              (match (updater->importer-info updater-name)
+                (#f #t) ; do nothing if there's no matching importer
+                ((importer convert-name . archive)
+                 ;; Replace "download-to-store" to avoid downloading the
+                 ;; tarball again.
+                 (match (mock ((guix download) download-to-store
+                               (lambda _ tarball))
+                         (apply importer (convert-name package) archive))
+                   ((and expr ('package fields ...))
+                    ;; FIXME: Is there a nicer way to match names in the
+                    ;; package expression?  Could we compare actual packages
+                    ;; instead of only their labels?
+                    (let* ((imported-inputs
+                            (append
+                             (match expr
+                               ((path *** ('inputs
+                                           ('quasiquote ((label ('unquote sym)) ...)))) label)
+                               (_ '()))
+                             (match expr
+                               ((path *** ('native-inputs
+                                           ('quasiquote ((label ('unquote sym)) ...)))) label)
+                               (_ '()))
+                             (match expr
+                               ((path *** ('propagated-inputs
+                                           ('quasiquote ((label ('unquote sym)) ...)))) label)
+                               (_ '()))))
+                           (current-inputs
+                            (map (match-lambda ((name pkg) name))
+                                 (package-direct-inputs package)))
+                           (removed
+                            (lset-difference equal?
+                                             current-inputs
+                                             imported-inputs))
+                           (added
+                            (lset-difference equal?
+                                             imported-inputs
+                                             current-inputs)))
+                      (when (not (null? removed))
+                        (format (current-error-port)
+                                (_ "~a: consider removing these inputs:~{ ~a~}~%")
+                                (package-name package)
+                                removed))
+                      (when (not (null? added))
+                        (format (current-error-port)
+                                (_ "~a: consider adding these inputs:~{ ~a~}~%")
+                                (package-name package)
+                                added))))
+                   (x
+                    (leave (_ "'~a' import failed~%") importer)))))))
           (warning (_ "~a: version ~a could not be \
 downloaded and authenticated; not updating~%")
                    (package-name package) version)))))