09/09: gnu-maintenance: Add GNOME updater.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit e80c0f85ba3429d0a43830247a2212ed93f67d49
Author: Ludovic Courtès <address@hidden>
Date:   Mon Dec 7 23:23:46 2015 +0100

    gnu-maintenance: Add GNOME updater.
    
    * guix/gnu-maintenance.scm (ftp-server/directory)[quirks]: Remove glib.
    (false-if-ftp-error): New macro.
    (latest-release*): Use it.
    (non-emacs-gnu-package?): Rename to...
    (pure-gnu-package?): ... this.  Add call to 'gnome-package?'.
    (%gnu-updater): Adjust accordingly.
    (gnome-package?, latest-gnome-release): New procedures.
    (%gnome-updater): New variable.
    * guix/scripts/refresh.scm (%updaters): Add %GNOME-UPDATER.
    * doc/guix.texi (Invoking guix refresh): Mention it.
---
 doc/guix.texi            |    2 +
 guix/gnu-maintenance.scm |   62 +++++++++++++++++++++++++++++++++++++--------
 guix/scripts/refresh.scm |    4 ++-
 3 files changed, 56 insertions(+), 12 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 4c525a6..309548b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4342,6 +4342,8 @@ list of updaters).  Currently, @var{updater} may be one 
of:
 @table @code
 @item gnu
 the updater for GNU packages;
address@hidden gnome
+the updater for GNOME packages;
 @item elpa
 the updater for @uref{http://elpa.gnu.org/, ELPA} packages;
 @item cran
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 7e990a5..5ca2923 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -56,7 +56,8 @@
             gnu-release-archive-types
             gnu-package-name->name+version
 
-            %gnu-updater))
+            %gnu-updater
+            %gnome-updater))
 
 ;;; Commentary:
 ;;;
@@ -221,7 +222,6 @@ stored."
       ("mit-scheme"   "ftp.gnu.org" "/gnu/mit-scheme/stable.pkg")
       ("icecat"       "ftp.gnu.org" "/gnu/gnuzilla")
       ("source-highlight" "ftp.gnu.org" "/gnu/src-highlite")
-      ("glib"         "ftp.gnome.org" "/pub/gnome/sources/glib")
       ("gnutls"       "ftp.gnutls.org" "/gcrypt/gnutls")
 
       ;; FIXME: ftp.texmacs.org is currently outdated; texmacs.org refers to
@@ -406,19 +406,24 @@ right FTP server and directory for PACKAGE."
            #:directory directory
            rest)))
 
-(define (latest-release* package)
-  "Like 'latest-release', but ignore FTP errors that might occur when PACKAGE
-is not actually a GNU package, or not hosted on ftp.gnu.org, or not under that
-name (this is the case for \"emacs-auctex\", for instance.)"
+(define-syntax-rule (false-if-ftp-error exp)
+  "Return #f if an FTP error is raise while evaluating EXP; return the result
+of EXP otherwise."
   (catch 'ftp-error
     (lambda ()
-      (latest-release package))
+      exp)
     (lambda (key port . rest)
       (if (ftp-connection? port)
           (ftp-close port)
           (close-port port))
       #f)))
 
+(define (latest-release* package)
+  "Like 'latest-release', but ignore FTP errors that might occur when PACKAGE
+is not actually a GNU package, or not hosted on ftp.gnu.org, or not under that
+name (this is the case for \"emacs-auctex\", for instance.)"
+  (false-if-ftp-error (latest-release package)))
+
 (define %package-name-rx
   ;; Regexp for a package name, e.g., "foo-X.Y".  Since TeXmacs uses
   ;; "TeXmacs-X.Y-src", the `-src' suffix is allowed.
@@ -431,17 +436,52 @@ name (this is the case for \"emacs-auctex\", for 
instance.)"
         (values name+version #f)
         (values (match:substring match 1) (match:substring match 2)))))
 
-(define (non-emacs-gnu-package? package)
-  "Return true if PACKAGE is a non-Emacs GNU package.  This excludes AucTeX,
-for instance, whose releases are now uploaded to elpa.gnu.org."
+(define (pure-gnu-package? package)
+  "Return true if PACKAGE is a non-Emacs and non-GNOME GNU package.  This
+excludes AucTeX, for instance, whose releases are now uploaded to
+elpa.gnu.org, and all the GNOME packages."
   (and (not (string-prefix? "emacs-" (package-name package)))
+       (not (gnome-package? package))
        (gnu-package? package)))
 
+(define (gnome-package? package)
+  "Return true if PACKAGE is a GNOME package, hosted on gnome.org."
+  (define gnome-uri?
+    (match-lambda
+      ((? string? uri)
+       (string-prefix? "mirror://gnome/" uri))
+      (_
+       #f)))
+
+  (match (package-source package)
+    ((? origin? origin)
+     (match (origin-uri origin)
+       ((? gnome-uri?) #t)
+       (_              #f)))
+    (_ #f)))
+
+(define (latest-gnome-release package)
+  "Return the latest release of PACKAGE, the name of a GNOME package."
+  (false-if-ftp-error
+   (latest-ftp-release package
+                       #:server "ftp.gnome.org"
+                       #:directory (string-append "/pub/gnome/sources/"
+                                                  (match package
+                                                    ("gconf" "GConf")
+                                                    (x       x))))))
+
 (define %gnu-updater
   (upstream-updater
    (name 'gnu)
    (description "Updater for GNU packages")
-   (pred non-emacs-gnu-package?)
+   (pred pure-gnu-package?)
    (latest latest-release*)))
 
+(define %gnome-updater
+  (upstream-updater
+   (name 'gnome)
+   (description "Updater for GNOME packages")
+   (pred gnome-package?)
+   (latest latest-gnome-release)))
+
 ;;; gnu-maintenance.scm ends here
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 2341ae6..a5834d1 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -30,7 +30,8 @@
   #:use-module (guix graph)
   #:use-module (guix scripts graph)
   #:use-module (guix monads)
-  #:use-module ((guix gnu-maintenance) #:select (%gnu-updater))
+  #:use-module ((guix gnu-maintenance)
+                #:select (%gnu-updater %gnome-updater))
   #:use-module (guix import elpa)
   #:use-module (guix import cran)
   #:use-module (guix gnupg)
@@ -191,6 +192,7 @@ unavailable optional dependencies such as Guile-JSON."
 (define %updaters
   ;; List of "updaters" used by default.  They are consulted in this order.
   (list-updaters %gnu-updater
+                 %gnome-updater
                  %elpa-updater
                  %cran-updater
                  ((guix import pypi) => %pypi-updater)))