refresh: Warn about packages that lack an updater.

* guix/upstream.scm (package-update-path): Rename to...
(package-latest-release): ... this.  Remove 'version>?' check.
(package-latest-release*): New procedure.
(package-update): Use it.
* guix/scripts/refresh.scm (lookup-updater): Rename to...
(lookup-updater-by-name): ... this.
(warn-no-updater): New procedure.
(update-package): Add #:warn? parameter and honor it.
(check-for-package-update): New procedure.
(guix-refresh)[warn?]: New variable.
Replace inline code when UPDATE? is false with a call to
'check-for-package-update'.
Pass WARN? to 'check-for-package-update' and 'update-package'.
* doc/guix.texi (Invoking guix refresh): Document it.  Fix a couple of
typos.

3 files changed, 95 insertions, 50 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index ce1e5d075a..4677e5cf79 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5250,10 +5250,19 @@ gnu/packages/gettext.scm:29:13: gettext would be upgraded from 0.18.1.1 to 0.18.
 gnu/packages/glib.scm:77:12: glib would be upgraded from 2.34.3 to 2.37.0
 @end example
 
-It does so by browsing the FTP directory of each package and determining
-the highest version number of the source tarballs therein.  The command
+Alternately, one can specify packages to consider, in which case a
+warning is emitted for packages that lack an updater:
+
+@example
+$ guix refresh coreutils guile guile-ssh
+gnu/packages/ssh.scm:205:2: warning: no updater for guile-ssh
+gnu/packages/guile.scm:136:12: guile would be upgraded from 2.0.12 to 2.0.13
+@end example
+
+@command{guix refresh} browses the upstream repository of each package and determines
+the highest version number of the releases therein.  The command
 knows how to update specific types of packages: GNU packages, ELPA
-packages, etc.---see the documentation for @option{--type} below.  The
+packages, etc.---see the documentation for @option{--type} below.  There
 are many packages, though, for which it lacks a method to determine
 whether a new upstream release is available.  However, the mechanism is
 extensible, so feel free to get in touch with us to add a new method!
@@ -5293,7 +5302,7 @@ usually run from a checkout of the Guix source tree (@pxref{Running
 Guix Before It Is Installed}):
 
 @example
-$ ./pre-inst-env guix refresh -s non-core
+$ ./pre-inst-env guix refresh -s non-core -u
 @end example
 
 @xref{Defining Packages}, for more information on package definitions.
@@ -5359,7 +5368,7 @@ In addition, @command{guix refresh} can be passed one or more package
 names, as in this example:
 
 @example
-$ ./pre-inst-env guix refresh -u emacs idutils gcc-4.8.4
+$ ./pre-inst-env guix refresh -u emacs idutils gcc@@4.8
 @end example
 
 @noindent
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index b81c69f9fe..ed28ed5fcb 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -208,7 +208,7 @@ unavailable optional dependencies such as Guile-JSON."
                  ((guix import gem) => %gem-updater)
                  ((guix import github) => %github-updater)))
 
-(define (lookup-updater name)
+(define (lookup-updater-by-name name)
   "Return the updater called NAME."
   (or (find (lambda (updater)
               (eq? name (upstream-updater-name updater)))
@@ -225,31 +225,60 @@ unavailable optional dependencies such as Guile-JSON."
             %updaters)
   (exit 0))
 
+(define (warn-no-updater package)
+  (format (current-error-port)
+          (_ "~a: warning: no updater for ~a~%")
+          (location->string (package-location package))
+          (package-name package)))
+
 (define* (update-package store package updaters
-                         #:key (key-download 'interactive))
+                         #:key (key-download 'interactive) warn?)
   "Update the source file that defines PACKAGE with the new version.
 KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
-values: 'interactive' (default), 'always', and 'never'."
-  (let-values (((version tarball)
-                (package-update store package updaters
-                                #:key-download key-download))
-               ((loc)
-                (or (package-field-location package 'version)
-                    (package-location package))))
-    (when version
-      (if (and=> tarball file-exists?)
-          (begin
-            (format (current-error-port)
-                    (_ "~a: ~a: updating from version ~a to version ~a...~%")
-                    (location->string loc)
-                    (package-name package)
-                    (package-version package) version)
-            (let ((hash (call-with-input-file tarball
-                          port-sha256)))
-              (update-package-source package version hash)))
-          (warning (_ "~a: version ~a could not be \
+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)
+                    (package-update store package updaters
+                                    #:key-download key-download))
+                   ((loc)
+                    (or (package-field-location package 'version)
+                        (package-location package))))
+        (when version
+          (if (and=> tarball file-exists?)
+              (begin
+                (format (current-error-port)
+                        (_ "~a: ~a: updating from version ~a to version ~a...~%")
+                        (location->string loc)
+                        (package-name package)
+                        (package-version package) version)
+                (let ((hash (call-with-input-file tarball
+                              port-sha256)))
+                  (update-package-source package version hash)))
+              (warning (_ "~a: version ~a could not be \
 downloaded and authenticated; not updating~%")
-                   (package-name package) version)))))
+                       (package-name package) version))))
+      (when warn?
+        (warn-no-updater package))))
+
+(define* (check-for-package-update package #:key warn?)
+  "Check whether an update is available for PACKAGE and print a message.  When
+WARN? is true and no updater exists for PACKAGE, print a warning."
+  (match (package-latest-release package %updaters)
+    ((? upstream-source? source)
+     (when (version>? (upstream-source-version source)
+                      (package-version package))
+       (let ((loc (or (package-field-location package 'version)
+                      (package-location package))))
+         (format (current-error-port)
+                 (_ "~a: ~a would be upgraded from ~a to ~a~%")
+                 (location->string loc)
+                 (package-name package) (package-version package)
+                 (upstream-source-version source)))))
+    (#f
+     (when warn?
+       (warn-no-updater package)))))
+
 
 
 ;;;
@@ -312,7 +341,7 @@ dependent packages are rebuilt: ~{~a~^ ~}~%"
     ;; Return the list of updaters to use.
     (match (filter-map (match-lambda
                          (('updaters . names)
-                          (map lookup-updater names))
+                          (map lookup-updater-by-name names))
                          (_ #f))
                        opts)
       (()
@@ -360,6 +389,12 @@ update would trigger a complete rebuild."
          (updaters        (options->updaters opts))
          (list-dependent? (assoc-ref opts 'list-dependent?))
          (key-download    (assoc-ref opts 'key-download))
+
+         ;; Warn about missing updaters when a package is explicitly given on
+         ;; the command line.
+         (warn?           (or (assoc-ref opts 'argument)
+                              (assoc-ref opts 'expression)))
+
          (packages
           (match (filter-map (match-lambda
                                (('argument . spec)
@@ -397,22 +432,13 @@ update would trigger a complete rebuild."
                                 (%gpg-command))))
               (for-each
                (cut update-package store <> updaters
-                    #:key-download key-download)
+                    #:key-download key-download
+                    #:warn? warn?)
                packages)
               (with-monad %store-monad
                 (return #t))))
            (else
-            (for-each (lambda (package)
-                        (match (package-update-path package updaters)
-                          ((? upstream-source? source)
-                           (let ((loc (or (package-field-location package 'version)
-                                          (package-location package))))
-                             (format (current-error-port)
-                                     (_ "~a: ~a would be upgraded from ~a to ~a~%")
-                                     (location->string loc)
-                                     (package-name package) (package-version package)
-                                     (upstream-source-version source))))
-                          (#f #f)))
+            (for-each (cut check-for-package-update <> #:warn? warn?)
                       packages)
             (with-monad %store-monad
               (return #t)))))))))
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 18157376d2..08992dc19e 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -49,8 +49,11 @@
             upstream-updater-predicate
             upstream-updater-latest
 
+            lookup-updater
+
             download-tarball
-            package-update-path
+            package-latest-release
+            package-latest-release*
             package-update
             update-package-source))
 
@@ -127,17 +130,24 @@ them matches."
           (and (pred package) latest)))
        updaters))
 
-(define (package-update-path package updaters)
+(define (package-latest-release package updaters)
   "Return an upstream source to update PACKAGE, a <package> object, or #f if
-no update is needed or known."
+none of UPDATERS matches PACKAGE.  It is the caller's responsibility to ensure
+that the returned source is newer than the current one."
   (match (lookup-updater package updaters)
     ((? procedure? latest-release)
-     (match (latest-release package)
-       ((and source ($ <upstream-source> name version))
-        (and (version>? version (package-version package))
-             source))
-       (_ #f)))
-    (#f #f)))
+     (latest-release package))
+    (_ #f)))
+
+(define (package-latest-release* package updaters)
+  "Like 'package-latest-release', but ensure that the return source is newer
+than that of PACKAGE."
+  (match (package-latest-release package updaters)
+    ((and source ($ <upstream-source> name version))
+     (and (version>? version (package-version package))
+          source))
+    (_
+     #f)))
 
 (define* (download-tarball store url signature-url
                            #:key (key-download 'interactive))
@@ -179,7 +189,7 @@ values: the item from LST1 and the item from LST2 that match PRED."
 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-update-path package updaters)
+  (match (package-latest-release* package updaters)
     (($ <upstream-source> _ version urls signature-urls)
      (let*-values (((name)
                     (package-name package))