~ruther/guix-local

d882c235d9878b8f61376bd4b4f21be885489818 — Ludovic Courtès 10 years ago 577e750
import: cran: Add updater.

* guix/import/cran.scm (downloads->url, nodes->text): New procedures.
  (cran-sxml->sexp): Use them.  Remove equivalent local code.
  (latest-release, cran-package?): New procedures.
  (%cran-updater): New variable.
* guix/scripts/refresh.scm (%updaters): Add %CRAN-UPDATER.
* doc/guix.texi (Invoking guix refresh): Mention CRAN.
3 files changed, 77 insertions(+), 18 deletions(-)

M doc/guix.texi
M guix/import/cran.scm
M guix/scripts/refresh.scm
M doc/guix.texi => doc/guix.texi +6 -3
@@ 4270,14 4270,17 @@ may be one of:
@item gnu
the updater for GNU packages;
@item elpa
the updater for @uref{http://elpa.gnu.org/, ELPA} packages.
the updater for @uref{http://elpa.gnu.org/, ELPA} packages;
@item cran
the updater fro @uref{http://cran.r-project.org/, CRAN} packages.
@end table

For instance, the following commands only checks for updates of Emacs
packages hosted at @code{elpa.gnu.org}:
packages hosted at @code{elpa.gnu.org} and updates of CRAN packages:

@example
$ guix refresh -t elpa
$ guix refresh -t elpa -t cran
gnu/packages/statistics.scm:819:13: r-testthat would be upgraded from 0.10.0 to 0.11.0
gnu/packages/emacs.scm:856:13: emacs-auctex would be upgraded from 11.88.6 to 11.88.9
@end example


M guix/import/cran.scm => guix/import/cran.scm +68 -14
@@ 20,6 20,7 @@
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (sxml simple)
  #:use-module (sxml match)
  #:use-module (sxml xpath)


@@ 29,7 30,10 @@
  #:use-module (guix base32)
  #:use-module ((guix download) #:select (download-to-store))
  #:use-module (guix import utils)
  #:export (cran->guix-package))
  #:use-module (guix upstream)
  #:use-module (guix packages)
  #:export (cran->guix-package
            %cran-updater))

;;; Commentary:
;;;


@@ 108,12 112,25 @@ or #f on failure.  NAME is case-sensitive."
                             name)
                     (symbol->string name))))))))

(define (downloads->url downloads)
  "Extract from DOWNLOADS, the downloads item of the CRAN sxml tree, the
download URL."
  (string-append "mirror://cran/"
                 ;; Remove double dots, because we want an
                 ;; absolute path.
                 (regexp-substitute/global
                  #f "\\.\\./"
                  (string-join ((sxpath '((xhtml:a 1) @ href *text*))
                                (table-datum downloads " Package source: ")))
                  'pre 'post)))

(define (nodes->text nodeset)
  "Return the concatenation of the text nodes among NODESET."
  (string-join ((sxpath '(// *text*)) nodeset) " "))

(define (cran-sxml->sexp sxml)
  "Return the `package' s-expression for a CRAN package from the SXML
representation of the package page."
  (define (nodes->text nodeset)
    (string-join ((sxpath '(// *text*)) nodeset) " "))

  (define (guix-name name)
    (if (string-prefix? "r-" name)
        (string-downcase name)


@@ 136,16 153,7 @@ representation of the package page."
                       (table-datum summary "License:")))
          (home-page  (nodes->text ((sxpath '((xhtml:a 1)))
                                    (table-datum summary "URL:"))))
          (source-url (string-append "mirror://cran/"
                                     ;; Remove double dots, because we want an
                                     ;; absolute path.
                                     (regexp-substitute/global
                                      #f "\\.\\./"
                                      (string-join
                                       ((sxpath '((xhtml:a 1) @ href *text*))
                                        (table-datum downloads
                                                     " Package source: ")))
                                      'pre 'post)))
          (source-url (downloads->url downloads))
          (tarball    (with-store store (download-to-store store source-url)))
          (sysdepends (map match:substring
                           (list-matches


@@ 186,3 194,49 @@ representation of the package page."
`package' s-expression corresponding to that package, or #f on failure."
  (let ((module-meta (cran-fetch package-name)))
    (and=> module-meta cran-sxml->sexp)))


;;;
;;; Updater.
;;;

(define (latest-release package)
  "Return an <upstream-source> for the latest release of PACKAGE."
  (define name
    (if (string-prefix? "r-" package)
        (string-drop package 2)
        package))

  (define sxml
    (cran-fetch name))

  (and sxml
       (sxml-match-let*
        (((*TOP* (xhtml:html
                  ,head
                  (xhtml:body
                   (xhtml:h2 ,name-and-synopsis)
                   (xhtml:p ,description)
                   ,summary
                   (xhtml:h4 "Downloads:") ,downloads
                   . ,rest)))
          sxml))
        (let ((version (nodes->text (table-datum summary "Version:")))
              (url     (downloads->url downloads)))
          ;; CRAN does not provide signatures.
          (upstream-source
           (package package)
           (version version)
           (urls (list url)))))))

(define (cran-package? package)
  "Return true if PACKAGE is an R package from CRAN."
  ;; Assume all R packages are available on CRAN.
  (string-prefix? "r-" (package-name package)))

(define %cran-updater
  (upstream-updater 'cran
                    cran-package?
                    latest-release))

;;; cran.scm ends here

M guix/scripts/refresh.scm => guix/scripts/refresh.scm +3 -1
@@ 28,6 28,7 @@
  #:use-module (guix upstream)
  #:use-module ((guix gnu-maintenance) #:select (%gnu-updater))
  #:use-module (guix import elpa)
  #:use-module (guix import cran)
  #:use-module (guix gnupg)
  #:use-module (gnu packages)
  #:use-module ((gnu packages commencement) #:select (%final-inputs))


@@ 139,7 140,8 @@ specified with `--select'.\n"))
(define %updaters
  ;; List of "updaters" used by default.  They are consulted in this order.
  (list %gnu-updater
        %elpa-updater))
        %elpa-updater
        %cran-updater))

(define (lookup-updater name)
  "Return the updater called NAME."