gnu-maintenance: Introduce <gnu-release> data type.

* guix/gnu-maintenance.scm (<gnu-release>): New record type.
  (release-file): Rename to...
  (release-file?): ... this.  Return a Boolean.
  (tarball->version, coalesce-releases): New procedures.
  (releases): Call 'coalesce-releases' on RESULT.  Return <gnu-release>
  objects instead of pairs.
  (latest-release): Likewise.
  (package-update-path): Adjust accordingly.
* gnu/packages.scm (check-package-freshness): Adjust accordingly.

2 files changed, 84 insertions, 26 deletions

diff --git a/gnu/packages.scm b/gnu/packages.scm
index 281d0d297d..c9efd0d691 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -348,13 +348,16 @@ it."
                                           #:ftp-open ftp-open*
                                           #:ftp-close (const #f))
                           (_ "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 \
+            ((? gnu-release? release)
+             (let ((latest-version
+                    (string-append (gnu-release-package release) "-"
+                                   (gnu-release-version release))))
+              (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)))
+                        (location->string (package-location package))
+                        full-name latest-version))))
             (_ #t)))))
     (lambda (key . args)
       ;; Silently ignore networking errors rather than preventing
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 7b608daea2..bfc03359ac 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -56,6 +56,12 @@
             find-packages
             gnu-package?
 
+            gnu-release?
+            gnu-release-package
+            gnu-release-version
+            gnu-release-directory
+            gnu-release-files
+
             releases
             latest-release
             gnu-package-name->name+version
@@ -189,6 +195,13 @@ network to check in GNU's database."
 ;;; Latest release.
 ;;;
 
+(define-record-type* <gnu-release> gnu-release make-gnu-release
+  gnu-release?
+  (package    gnu-release-package)
+  (version    gnu-release-version)
+  (directory  gnu-release-directory)
+  (files      gnu-release-files))
+
 (define (ftp-server/directory project)
   "Return the FTP server and directory where PROJECT's tarball are
 stored."
@@ -227,9 +240,9 @@ stored."
 (define %alpha-tarball-rx
   (make-regexp "^.*-.*[0-9](-|~)?(alpha|beta|rc|cvs|svn|git)-?[0-9\\.]*\\.tar\\."))
 
-(define (release-file project file)
+(define (release-file? project file)
   "Return #f if FILE is not a release tarball of PROJECT, otherwise return
-PACKAGE-VERSION."
+true."
   (and (not (string-suffix? ".sig" file))
        (and=> (regexp-exec %tarball-rx file)
               (lambda (match)
@@ -237,7 +250,37 @@ PACKAGE-VERSION."
                 (equal? project (match:substring match 1))))
        (not (regexp-exec %alpha-tarball-rx file))
        (let ((s (sans-extension file)))
-         (and (regexp-exec %package-name-rx s) s))))
+         (regexp-exec %package-name-rx s))))
+
+(define (tarball->version tarball)
+  "Return the version TARBALL corresponds to.  TARBALL is a file name like
+\"coreutils-8.23.tar.xz\"."
+  (let-values (((name version)
+                (gnu-package-name->name+version (sans-extension tarball))))
+    version))
+
+(define (coalesce-releases releases)
+  "Coalesce the elements of RELEASES that correspond to the same version."
+  (define (same-version? r1 r2)
+    (string=? (gnu-release-version r1) (gnu-release-version r2)))
+
+  (define (release>? r1 r2)
+    (version>? (gnu-release-version r1) (gnu-release-version r2)))
+
+  (fold (lambda (release result)
+          (match result
+            ((head . tail)
+             (if (same-version? release head)
+                 (cons (gnu-release
+                        (inherit release)
+                        (files (append (gnu-release-files release)
+                                       (gnu-release-files head))))
+                       tail)
+                 (cons release result)))
+            (()
+             (list release))))
+        '()
+        (sort releases release>?)))
 
 (define (releases project)
   "Return the list of releases of PROJECT as a list of release name/directory
@@ -251,7 +294,7 @@ pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
       (match directories
         (()
          (ftp-close conn)
-         result)
+         (coalesce-releases result))
         ((directory rest ...)
          (let* ((files   (ftp-list conn directory))
                 (subdirs (filter-map (match-lambda
@@ -267,10 +310,15 @@ pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
                   ;; in /gnu/guile, filter out guile-oops and
                   ;; guile-www; in mit-scheme, filter out binaries.
                   (filter-map (match-lambda
-                                ((file 'file . _)
-                                 (and=> (release-file project file)
-                                        (cut cons <> directory)))
-                                (_ #f))
+                               ((file 'file . _)
+                                (if (release-file? project file)
+                                    (gnu-release
+                                     (package project)
+                                     (version (tarball->version file))
+                                     (directory directory)
+                                     (files (list file)))
+                                    #f))
+                               (_ #f))
                               files)
                   result))))))))
 
@@ -281,6 +329,10 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
   (define (latest a b)
     (if (version>? a b) a b))
 
+  (define (latest-release a b)
+    (if (version>? (gnu-release-version a) (gnu-release-version b))
+        a b))
+
   (define contains-digit?
     (cut string-any char-set:digit <>))
 
@@ -307,14 +359,19 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
         (match subdirs
           (()
            ;; No sub-directories, so assume that tarballs are here.
-           (let ((files (filter-map (match-lambda
-                                     ((file 'file . _)
-                                      (release-file project file))
-                                     (_ #f))
-                                    entries)))
+           (let ((releases (filter-map (match-lambda
+                                        ((file 'file . _)
+                                         (and (release-file? project file)
+                                              (gnu-release
+                                               (package project)
+                                               (version
+                                                (tarball->version file))
+                                               (directory directory)
+                                               (files (list file)))))
+                                        (_ #f))
+                                       entries)))
              (ftp-close conn)
-             (and=> (reduce latest #f files)
-                    (cut cons <> directory))))
+             (reduce latest-release #f (coalesce-releases releases))))
           ((subdirs ...)
            ;; Assume that SUBDIRS correspond to versions, and jump into the
            ;; one with the highest version number.
@@ -346,11 +403,9 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
   "Return an update path for PACKAGE, or #f if no update is needed."
   (and (gnu-package? package)
        (match (latest-release (package-name package))
-         ((name+version . directory)
-          (let-values (((_ new-version)
-                        (package-name->name+version name+version)))
-            (and (version>? name+version (package-full-name package))
-                 `(,new-version . ,directory))))
+         (($ <gnu-release> name version directory)
+          (and (version>? version (package-version package))
+               `(,version . ,directory)))
          (_ #f))))
 
 (define* (download-tarball store project directory version