01/01: import: gem: Add updater.

[Ben Woodcroft]

benwoodcroft pushed a commit to branch master
in repository guix.

commit fbc5b815cce85a6af75226ab16acf243fd7d22ce
Author: Ben Woodcroft <address@hidden>
Date:   Fri Jan 1 16:56:07 2016 +1000

    import: gem: Add updater.
    
    * guix/import/gem.scm (guix-package->gem-name,
      gem-package?, latest-release): New procedures.
      (%gem-updater): New variable.
      (rubygems-fetch): Wrap body in
      'call-with-output-file' and 'with-error-to-port'.
    * guix/scripts/refresh.scm (%updaters): Add %GEM-UPDATER.
    * doc/guix.texi (Invoking guix refresh): Mention RubyGems.
---
 doc/guix.texi            |    2 +
 guix/import/gem.scm      |   63 +++++++++++++++++++++++++++++++++++++++++++--
 guix/scripts/refresh.scm |    5 +++-
 3 files changed, 66 insertions(+), 4 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index c5a7de7..b991cc1 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4571,6 +4571,8 @@ the updater for @uref{http://cran.r-project.org/, CRAN} 
packages;
 the updater for @uref{http://www.bioconductor.org/, Bioconductor} R packages;
 @item pypi
 the updater for @uref{https://pypi.python.org, PyPI} packages.
address@hidden gem
+the updater for @uref{https://rubygems.org, RubyGems} packages.
 @end table
 
 For instance, the following command only checks for updates of Emacs
diff --git a/guix/import/gem.scm b/guix/import/gem.scm
index 4b2a253..b46622f 100644
--- a/guix/import/gem.scm
+++ b/guix/import/gem.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <address@hidden>
+;;; Copryight © 2016 Ben Woodcroft <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,21 +20,33 @@
 (define-module (guix import gem)
   #:use-module (ice-9 match)
   #:use-module (ice-9 pretty-print)
+  #:use-module (srfi srfi-1)
   #:use-module (rnrs bytevectors)
   #:use-module (json)
   #:use-module (web uri)
+  #:use-module ((guix download) #:prefix download:)
   #:use-module (guix import utils)
   #:use-module (guix import json)
   #:use-module (guix packages)
+  #:use-module (guix upstream)
   #:use-module (guix licenses)
   #:use-module (guix base32)
-  #:export (gem->guix-package))
+  #:use-module (guix build-system ruby)
+  #:use-module (gnu packages)
+  #:export (gem->guix-package
+            %gem-updater))
 
 (define (rubygems-fetch name)
   "Return an alist representation of the RubyGems metadata for the package 
NAME,
 or #f on failure."
-  (json-fetch
-   (string-append "https://rubygems.org/api/v1/gems/"; name ".json")))
+  ;; XXX: We want to silence the download progress report, which is especially
+  ;; annoying for 'guix refresh', but we have to use a file port.
+  (call-with-output-file "/dev/null"
+    (lambda (null)
+      (with-error-to-port null
+        (lambda ()
+          (json-fetch
+           (string-append "https://rubygems.org/api/v1/gems/"; name 
".json")))))))
 
 (define (ruby-package-name name)
   "Given the NAME of a package on RubyGems, return a Guix-compliant name for
@@ -132,3 +145,47 @@ VERSION, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES, and 
LICENSES."
                                   (assoc-ref package "licenses"))))
            (make-gem-sexp name version hash home-page synopsis
                           description dependencies licenses)))))
+
+(define (guix-package->gem-name package)
+  "Given a PACKAGE built from rubygems.org, return the name of the
+package on RubyGems."
+  (let ((source-url (and=> (package-source package) origin-uri)))
+    ;; The URL has the form:
+    ;; 'https://rubygems.org/downloads/' +
+    ;; package name + '-' + version + '.gem'
+    ;; e.g. "https://rubygems.org/downloads/hashery-2.1.1.gem";
+    (substring source-url 31 (string-rindex source-url #\-))))
+
+(define (gem-package? package)
+  "Return true if PACKAGE is a gem package from RubyGems."
+
+  (define (rubygems-url? url)
+    (string-prefix? "https://rubygems.org/downloads/"; url))
+
+  (let ((source-url (and=> (package-source package) origin-uri))
+        (fetch-method (and=> (package-source package) origin-method)))
+    (and (eq? fetch-method download:url-fetch)
+         (match source-url
+           ((? string?)
+            (rubygems-url? source-url))
+           ((source-url ...)
+            (any rubygems-url? source-url))))))
+
+(define (latest-release guix-package)
+  "Return an <upstream-source> for the latest release of GUIX-PACKAGE."
+  (let* ((gem-name (guix-package->gem-name
+                    (specification->package guix-package)))
+         (metadata (rubygems-fetch gem-name))
+         (version (assoc-ref metadata "version"))
+         (url (rubygems-uri gem-name version)))
+    (upstream-source
+     (package guix-package)
+     (version version)
+     (urls (list url)))))
+
+(define %gem-updater
+  (upstream-updater
+   (name 'gem)
+   (description "Updater for RubyGem packages")
+   (pred gem-package?)
+   (latest latest-release)))
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index f9e3f31..bb38f09 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2013 Nikita Karetnikov <address@hidden>
 ;;; Copyright © 2014 Eric Bavier <address@hidden>
 ;;; Copyright © 2015 Alex Kost <address@hidden>
+;;; Copyright © 2016 Ben Woodcroft <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -34,6 +35,7 @@
                 #:select (%gnu-updater %gnome-updater))
   #:use-module (guix import elpa)
   #:use-module (guix import cran)
+  #:use-module (guix import gem)
   #:use-module (guix gnupg)
   #:use-module (gnu packages)
   #:use-module ((gnu packages commencement) #:select (%final-inputs))
@@ -196,7 +198,8 @@ unavailable optional dependencies such as Guile-JSON."
                  %elpa-updater
                  %cran-updater
                  %bioconductor-updater
-                 ((guix import pypi) => %pypi-updater)))
+                 ((guix import pypi) => %pypi-updater)
+                 ((guix import gem) => %gem-updater)))
 
 (define (lookup-updater name)
   "Return the updater called NAME."