summaryrefslogtreecommitdiff
path: root/guix/import
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-10-21 14:36:14 +0200
committerLudovic Courtès <ludo@gnu.org>2015-10-21 14:44:41 +0200
commitd882c235d9878b8f61376bd4b4f21be885489818 (patch)
treede5f184a8d255e06838acb2aea8fe19740575b9d /guix/import
parent577e75058066579bc66037c4ac08f3870520b79a (diff)
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.
Diffstat (limited to 'guix/import')
-rw-r--r--guix/import/cran.scm82
1 files changed, 68 insertions, 14 deletions
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 585cb9fec2..218d55787a 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -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