guix package: Inform about new upstream versions of GNU packages.

* guix/gnu-maintenance.scm (gnu-package?): New procedure.
* guix/scripts/package.scm (waiting): New macro.
  (check-package-freshness): New procedure.
  (guix-package)[process-actions]: Use it.
* doc/guix.texi (Invoking guix package): Mention the feature.

2 files changed, 48 insertions, 0 deletions

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 6475c386d3..981bb81919 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -29,7 +29,9 @@
   #:use-module (system foreign)
   #:use-module (guix ftp-client)
   #:use-module (guix utils)
+  #:use-module (guix packages)
   #:export (official-gnu-packages
+            gnu-package?
             releases
             latest-release
             gnu-package-name->name+version))
@@ -74,6 +76,18 @@
                   (and=> (regexp-exec %package-line-rx line)
                          (cut match:substring <> 1)))
                 lst)))
+
+(define gnu-package?
+  (memoize
+   (lambda (package)
+     "Return true if PACKAGE is a GNU package.  This procedure may access the
+network to check in GNU's database."
+     ;; TODO: Find a way to determine that a package is non-GNU without going
+     ;; through the network.
+     (let ((url (origin-uri (package-source package))))
+       (or (string-prefix? "mirror://gnu" url)
+           (member (package-name package) (official-gnu-packages)))))))
+
 
 ;;;
 ;;; Latest release.
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index ccca614d88..61b2f0570d 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -39,6 +39,7 @@
   #:use-module (gnu packages)
   #:use-module ((gnu packages base) #:select (guile-final))
   #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile))
+  #:use-module (guix gnu-maintenance)
   #:export (guix-package))
 
 (define %store
@@ -266,6 +267,38 @@ matching packages."
                        (assoc-ref (derivation-outputs drv) sub-drv))))
          `(,name ,out))))))
 
+(define-syntax-rule (waiting exp fmt rest ...)
+  "Display the given message while EXP is being evaluated."
+  (let* ((message (format #f fmt rest ...))
+         (blank   (make-string (string-length message) #\space)))
+    (display message (current-error-port))
+    (force-output (current-error-port))
+    (let ((result exp))
+      ;; Clear the line.
+      (display #\cr (current-error-port))
+      (display blank (current-error-port))
+      (display #\cr (current-error-port))
+      (force-output (current-error-port))
+      exp)))
+
+(define (check-package-freshness package)
+  "Check whether PACKAGE has a newer version available upstream, and report
+it."
+  ;; TODO: Automatically inject the upstream version when desired.
+  (when (gnu-package? package)
+    (let ((name      (package-name package))
+          (full-name (package-full-name package)))
+      (match (waiting (latest-release name)
+                      (_ "looking for the latest release of GNU ~a...") name)
+        ((latest-version . _)
+         (when (version>? latest-version full-name)
+           (format (current-error-port)
+                   (_ "~a: note: using ~a \
+but ~a is available upstream~%")
+                   (location->string (package-location package))
+                   full-name latest-version)))
+        (_ #t)))))
+
 
 ;;;
 ;;; Command-line options.
@@ -547,6 +580,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                                       ((name version sub-drv
                                              (? package? package)
                                              (deps ...))
+                                       (check-package-freshness package)
                                        (package-derivation (%store) package))
                                       (_ #f))
                                      install))