From mboxrd@z Thu Jan 1 00:00:00 1970 From: Ricardo Wurmus Subject: Re: [PATCH] R build system and CRAN importer (updated) Date: Wed, 26 Aug 2015 18:05:51 +0200 Message-ID: References: Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:36508) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZUdDG-00062c-VG for guix-devel@gnu.org; Wed, 26 Aug 2015 12:06:17 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ZUdD8-000763-Bx for guix-devel@gnu.org; Wed, 26 Aug 2015 12:06:10 -0400 Received: from pegasus.bbbm.mdc-berlin.de ([141.80.25.20]:59896) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZUdD7-00075f-Qe for guix-devel@gnu.org; Wed, 26 Aug 2015 12:06:02 -0400 In-Reply-To: List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: "Thompson, David" Cc: guix-devel --=-=-= Content-Type: text/plain; charset="utf-8" Content-Transfer-Encoding: quoted-printable > I=E2=80=99ll send a new patch once I=E2=80=99ve written a couple of tes= ts > for all this. Attached is the latest version of this patch set. I tried to incorporate all suggestions and also added tests for the CRAN importer. I have not implemented the suggested procedure =E2=80=98cran-uri=E2=80=99= that generates URLs for tarballs offered through CRAN, because I couldn=E2=80=99t determ= ine whether all packages really use the same URL prefix. ~~ Ricardo --=-=-= Content-Type: text/x-patch; charset="utf-8" Content-Disposition: inline; filename="0001-import-Add-cran-importer.patch" Content-Transfer-Encoding: quoted-printable >From 1c726be7746021f5d967d12154c057391e24585d Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Fri, 24 Jul 2015 16:49:57 +0200 Subject: [PATCH 1/2] import: Add 'cran' importer. * guix/import/cran.scm: New file. * guix/scripts/import.scm: Add "cran" to 'importers'. * guix/scripts/import/cran.scm: New file. * tests/cran.scm: New file. * Makefile.am (MODULES): Add 'guix/import/cran.scm' and 'guix/scripts/import/cran.scm'. (SCM_TESTS): Add 'tests/cran.scm'. * doc/guix.texi (Invoking guix import): Document it. * po/guix/POTFILES.in: Add 'guix/scripts/import/cran.scm'. --- Makefile.am | 3 + doc/guix.texi | 15 ++++ guix/import/cran.scm | 193 +++++++++++++++++++++++++++++++++++++= ++++++ guix/scripts/import.scm | 2 +- guix/scripts/import/cran.scm | 92 +++++++++++++++++++++ tests/cran.scm | 178 +++++++++++++++++++++++++++++++++++++= ++ 6 files changed, 482 insertions(+), 1 deletion(-) create mode 100644 guix/import/cran.scm create mode 100644 guix/scripts/import/cran.scm create mode 100644 tests/cran.scm diff --git a/Makefile.am b/Makefile.am index ada4cbe..8f25145 100644 --- a/Makefile.am +++ b/Makefile.am @@ -98,6 +98,7 @@ MODULES =3D \ guix/import/gnu.scm \ guix/import/snix.scm \ guix/import/cabal.scm \ + guix/import/cran.scm \ guix/import/hackage.scm \ guix/import/elpa.scm \ guix/scripts/download.scm \ @@ -113,6 +114,7 @@ MODULES =3D \ guix/scripts/refresh.scm \ guix/scripts/system.scm \ guix/scripts/lint.scm \ + guix/scripts/import/cran.scm \ guix/scripts/import/gnu.scm \ guix/scripts/import/nix.scm \ guix/scripts/import/hackage.scm \ @@ -191,6 +193,7 @@ SCM_TESTS =3D \ tests/packages.scm \ tests/snix.scm \ tests/hackage.scm \ + tests/cran.scm \ tests/elpa.scm \ tests/store.scm \ tests/monads.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index f05376e..8774607 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3891,6 +3891,21 @@ Perl module: guix import cpan Acme::Boolean @end example =20 +@item cran +@cindex CRAN +Import meta-data from @uref{http://cran.r-project.org/, CRAN}, the +central repository for the @uref{http://r-project.org, GNU@tie{}R +statistical and graphical environment}. + +Information is extracted from the HTML package description. + +The command command below imports meta-data for the @code{Cairo} +R package: + +@example +guix import cran Cairo +@end example + @item nix Import meta-data from a local copy of the source of the @uref{http://nixos.org/nixpkgs/, Nixpkgs distribution}@footnote{This diff --git a/guix/import/cran.scm b/guix/import/cran.scm new file mode 100644 index 0000000..7d5a82f --- /dev/null +++ b/guix/import/cran.scm @@ -0,0 +1,193 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2015 Ricardo Wurmus +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (a= t +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix import cran) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (srfi srfi-1) + #:use-module (sxml simple) + #:use-module (sxml match) + #:use-module (sxml xpath) + #:use-module (guix http-client) + #:use-module (guix hash) + #:use-module (guix store) + #:use-module (guix base32) + #:use-module ((guix download) #:select (download-to-store)) + #:use-module (guix import utils) + #:export (cran->guix-package)) + +;;; Commentary: +;;; +;;; Generate a package declaration template for the latest version of an= R +;;; package on CRAN, using the HTML description downloaded from +;;; cran.r-project.org. +;;; +;;; Code: + +(define string->license + (match-lambda + ("AGPL-3" 'agpl3) + ("Artistic-2.0" 'artistic2.0) + ("Apache License 2.0" 'asl2.0) + ("BSD_2_clause" 'bsd-2) + ("BSD_3_clause" 'bsd-3) + ("GPL-2" 'gpl2) + ("GPL-3" 'GPL3) + ("LGPL-2" 'lgpl2.0) + ("LGPL-2.1" 'lgpl2.1) + ("LGPL-3" 'lgpl3) + ("MIT" 'x11) + ((x) (string->license x)) + ((lst ...) `(list ,@(map string->license lst))) + (_ #f))) + +(define (format-inputs names) + "Generate a sorted list of package inputs from a list of package NAMES= ." + (sort + (map (lambda (name) + (list name (list 'unquote (string->symbol name)))) + names) + (lambda args + (match args + (((a _ ...) (b _ ...)) + (string-cisxml (http-fetch cran-url) + #:trim-whitespace? #t + #:namespaces '((xhtml . "http://www.w3.org/1999/xhtml")) + #:default-entity-handler + (lambda (port name) + (case name + ((nbsp) " ") + ((ge) ">=3D") + ((gt) ">") + ((lt) "<") + (else + (format (current-warning-port) + "~a:~a:~a: undefined entitity: ~a\n" + cran-url (port-line port) (port-column port= ) + name) + (symbol->string name)))))))) + +(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) + (string-append "r-" (string-downcase name)))) + + (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* ((name (match:prefix (string-match ": " name-and-synopsis= ))) + (synopsis (match:suffix (string-match ": " name-and-synopsis= ))) + (version (nodes->text (table-datum summary "Version:"))) + (license ((compose string->license nodes->text) + (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 w= ant an + ;; absolute path. + (regexp-substitute/global + #f "\\.\\./" + (string-join + ((sxpath '((xhtml:a 1) @ href *te= xt*)) + (table-datum downloads + " Package source: "= ))) + 'pre 'post))) + (tarball (with-store store (download-to-store store source-= url))) + (sysdepends (map match:substring + (list-matches + "[^ ]+" + ;; Strip off comma and parenthetical + ;; expressions. + (regexp-substitute/global + #f "(,|\\([^\\)]+\\))" + (nodes->text (table-datum summary + "SystemRequiremen= ts:")) + 'pre 'post)))) + (imports (map guix-name + ((sxpath '(// xhtml:a *text*)) + (table-datum summary "Imports:"))))) + `(package + (name ,(guix-name name)) + (version ,version) + (source (origin + (method url-fetch) + (uri (string-append ,@(factorize-uri source-url versio= n))) + (sha256 + (base32 + ,(bytevector->nix-base32-string (file-sha256 tarball= )))))) + (build-system r-build-system) + ,@(maybe-inputs sysdepends) + ,@(maybe-inputs imports 'propagated-inputs) + (home-page ,(if (string-null? home-page) + (string-append %cran-url name) + home-page)) + (synopsis ,synopsis) + ;; Use double spacing + (description ,(regexp-substitute/global #f "\\. \\b" description + 'pre ". " 'post)) + (license ,license))))) + +(define (cran->guix-package package-name) + "Fetch the metadata for PACKAGE-NAME from cran.r-project.org, and retu= rn the +`package' s-expression corresponding to that package, or #f on failure." + (let ((module-meta (cran-fetch package-name))) + (and=3D> module-meta cran-sxml->sexp))) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index d0bdec1..9d8e5cb 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -73,7 +73,7 @@ rather than \\n." ;;; Entry point. ;;; =20 -(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa")) +(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa" "cran")) =20 (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm new file mode 100644 index 0000000..f11fa10 --- /dev/null +++ b/guix/scripts/import/cran.scm @@ -0,0 +1,92 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2014 Eric Bavier +;;; Copyright =C2=A9 2015 Ricardo Wurmus +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (a= t +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix scripts import cran) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix import cran) + #:use-module (guix scripts import) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:export (guix-import-cran)) + +=0C +;;; +;;; Command-line options. +;;; + +(define %default-options + '()) + +(define (show-help) + (display (_ "Usage: guix import cran PACKAGE-NAME +Import and convert the CRAN package for PACKAGE-NAME.\n")) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specification of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix import cran"))) + %standard-import-options)) + +=0C +;;; +;;; Entry point. +;;; + +(define (guix-import-cran . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((package-name) + (let ((sexp (cran->guix-package package-name))) + (unless sexp + (leave (_ "failed to download description for package '~a'~%"= ) + package-name)) + sexp)) + (() + (leave (_ "too few arguments~%"))) + ((many ...) + (leave (_ "too many arguments~%")))))) diff --git a/tests/cran.scm b/tests/cran.scm new file mode 100644 index 0000000..c9cb5f6 --- /dev/null +++ b/tests/cran.scm @@ -0,0 +1,178 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2015 Ricardo Wurmus +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (a= t +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (test-cran) + #:use-module (guix import cran) + #:use-module (guix tests) + #:use-module (srfi srfi-64) + #:use-module (ice-9 match)) + +(define sxml + '(*TOP* (xhtml:html + (xhtml:head + (xhtml:title "CRAN - Package my-example-sxml")) + (xhtml:body + (xhtml:h2 "my-example-sxml: Short description") + (xhtml:p "Long description") + (xhtml:table + (@ (summary "Package my-example-sxml summary")) + (xhtml:tr + (xhtml:td "Version:") + (xhtml:td "1.2.3")) + (xhtml:tr + (xhtml:td "Depends:") + (xhtml:td "R (>=3D 3.1.0)")) + (xhtml:tr + (xhtml:td "SystemRequirements:") + (xhtml:td "cairo (>=3D 1.2 http://www.cairographics.org/)"= )) + (xhtml:tr + (xhtml:td "Imports:") + (xhtml:td + (xhtml:a (@ (href "../scales/index.html")) + "scales") + " (>=3D 0.2.3), " + (xhtml:a (@ (href "../proto/index.html")) + "proto") + ", " + (xhtml:a (@ (href "../Rcpp/index.html")) "Rcpp") + " (>=3D 0.11.0)")) + (xhtml:tr + (xhtml:td "Suggests:") + (xhtml:td + (xhtml:a (@ (href "../some/index.html")) + "some") + ", " + (xhtml:a (@ (href "../suggestions/index.html")) + "suggestions"))) + (xhtml:tr + (xhtml:td "License:") + (xhtml:td + (xhtml:a (@ (href "../../licenses/MIT")) "MIT"))) + (xhtml:tr + (xhtml:td "URL:") + (xhtml:td + (xhtml:a (@ (href "http://gnu.org/s/my-example-sxml")) + "http://gnu.org/s/my-example-sxml") + ", " + (xhtml:a (@ (href "http://alternative/home/page")) + "http://alternative/home/page")))) + (xhtml:h4 "Downloads:") + (xhtml:table + (@ (summary "Package my-example-sxml downloads")) + (xhtml:tr + (xhtml:td " Reference manual: ") + (xhtml:td + (xhtml:a (@ (href "my-example-sxml.pdf")) + " my-example-sxml.pdf "))) + (xhtml:tr + (xhtml:td " Package source: ") + (xhtml:td + (xhtml:a + (@ (href "../../../src/contrib/my-example-sxml_1.2.3.tar= .gz")) + " my-example-sxml_1.2.3.tar.gz ")))) + (xhtml:h4 "Reverse dependencies:") + (xhtml:table + (@ (summary "Package my-example-sxml reverse dependencies")= ) + (xhtml:tr + (xhtml:td "Reverse depends:") + (xhtml:td "Too many.")) + (xhtml:tr + (xhtml:td "Reverse imports:") + (xhtml:td "Likewise.")) + (xhtml:tr + (xhtml:td "Reverse suggests:") + (xhtml:td "Uncountable."))))))) + +(define simple-table + '(xhtml:table + (xhtml:tr + (xhtml:td "Numbers") + (xhtml:td "123")) + (xhtml:tr + (@ (class "whatever")) + (xhtml:td (@ (class "unimportant")) "Letters") + (xhtml:td "abc")) + (xhtml:tr + (xhtml:td "Letters") + (xhtml:td "xyz")) + (xhtml:tr + (xhtml:td "Single")) + (xhtml:tr + (xhtml:td "not a value") + (xhtml:td "not a label") + (xhtml:td "also not a label")))) + +(test-begin "cran") + +(test-equal "table-datum: return list of first table cell matching label= " + '((xhtml:td "abc")) + ((@@ (guix import cran) table-datum) simple-table "Letters")) + +(test-equal "table-datum: return empty list if no match" + '() + ((@@ (guix import cran) table-datum) simple-table "Astronauts")) + +(test-equal "table-datum: only consider the first cell as a label cell" + '() + ((@@ (guix import cran) table-datum) simple-table "not a label")) + + +(test-assert "cran-sxml->sexp" + ;; Replace network resources with sample data. + (mock ((guix build download) url-fetch + (lambda* (url file-name #:key (mirrors '())) + (with-output-to-file file-name + (lambda () + (display + (match url + ("mirror://cran/src/contrib/my-example-sxml_1.2.3.tar.= gz" + "source") + (_ (error "Unexpected URL: " url)))))))) + (match ((@@ (guix import cran) cran-sxml->sexp) sxml) + (('package + ('name "r-my-example-sxml") + ('version "1.2.3") + ('source ('origin + ('method 'url-fetch) + ('uri ('string-append "mirror://cran/src/contrib/my-= example-sxml_" + 'version ".tar.gz")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'r-build-system) + ('inputs + ('quasiquote + (("cairo" ('unquote 'cairo))))) + ('propagated-inputs + ('quasiquote + (("r-proto" ('unquote 'r-proto)) + ("r-rcpp" ('unquote 'r-rcpp)) + ("r-scales" ('unquote 'r-scales))))) + ('home-page "http://gnu.org/s/my-example-sxml") + ('synopsis "Short description") + ('description "Long description") + ('license 'x11))) + (x + (begin + (format #t "~s\n" x) + (pk 'fail x #f)))))) + +(test-end "cran") + +=0C +(exit (=3D (test-runner-fail-count (test-runner-current)) 0)) --=20 2.1.0 --=-=-= Content-Type: text/x-patch; charset="utf-8" Content-Disposition: inline; filename="0002-build-Add-R-build-system.patch" Content-Transfer-Encoding: quoted-printable >From 8271e8a5e7d237693e8d4b7b34e4a484b9a1fc22 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Fri, 31 Jul 2015 14:47:34 +0200 Subject: [PATCH 2/2] build: Add R build system. * guix/build-system/r.scm: New file. * guix/build/r-build-system: New file. * Makefile.am (MODULES): Add new files. * doc/guix.texi (Build Systems): Document r-build-system. --- Makefile.am | 2 + doc/guix.texi | 10 ++++ guix/build-system/r.scm | 134 ++++++++++++++++++++++++++++++++++++= ++++++ guix/build/r-build-system.scm | 112 +++++++++++++++++++++++++++++++++++ 4 files changed, 258 insertions(+) create mode 100644 guix/build-system/r.scm create mode 100644 guix/build/r-build-system.scm diff --git a/Makefile.am b/Makefile.am index 8f25145..ab00485 100644 --- a/Makefile.am +++ b/Makefile.am @@ -58,6 +58,7 @@ MODULES =3D \ guix/build-system/perl.scm \ guix/build-system/python.scm \ guix/build-system/waf.scm \ + guix/build-system/r.scm \ guix/build-system/ruby.scm \ guix/build-system/trivial.scm \ guix/ftp-client.scm \ @@ -77,6 +78,7 @@ MODULES =3D \ guix/build/gnu-dist.scm \ guix/build/perl-build-system.scm \ guix/build/python-build-system.scm \ + guix/build/r-build-system.scm \ guix/build/ruby-build-system.scm \ guix/build/waf-build-system.scm \ guix/build/haskell-build-system.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 8774607..3a40c98 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2481,6 +2481,16 @@ passes flags specified by the @code{#:make-maker-f= lags} or Which Perl package is used can be specified with @code{#:perl}. @end defvr =20 +@defvr {Scheme Variable} r-build-system +This variable is exported by @code{(guix build-system r)}. It +implements the build procedure used by @uref{http://r-project.org, R} +packages, which essentially is little more than running @code{R CMD +INSTALL --library=3D/gnu/store/@dots{}} in an environment where +@code{R_LIBS_SITE} contains the paths to all R package inputs. Tests +are run after installation using the R function +@code{tools::testInstalledPackage}. +@end defvr + @defvr {Scheme Variable} ruby-build-system This variable is exported by @code{(guix build-system ruby)}. It implements the RubyGems build procedure used by Ruby packages, which diff --git a/guix/build-system/r.scm b/guix/build-system/r.scm new file mode 100644 index 0000000..4daec5e --- /dev/null +++ b/guix/build-system/r.scm @@ -0,0 +1,134 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2015 Ricardo Wurmus +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (a= t +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix build-system r) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix packages) + #:use-module (guix derivations) + #:use-module (guix search-paths) + #:use-module (guix build-system) + #:use-module (guix build-system gnu) + #:use-module (ice-9 match) + #:use-module (srfi srfi-26) + #:export (%r-build-system-modules + r-build + r-build-system)) + +;; Commentary: +;; +;; Standard build procedure for R packages. +;; +;; Code: + +(define %r-build-system-modules + ;; Build-side modules imported by default. + `((guix build r-build-system) + ,@%gnu-build-system-modules)) + +(define (default-r) + "Return the default R package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((r-mod (resolve-interface '(gnu packages statistics)))) + (module-ref r-mod 'r))) + +(define* (lower name + #:key source inputs native-inputs outputs system target + (r (default-r)) + #:allow-other-keys + #:rest arguments) + "Return a bag for NAME." + (define private-keywords + '(#:source #:target #:inputs #:native-inputs)) + + (and (not target) ;XXX: no cross-compila= tion + (bag + (name name) + (system system) + (host-inputs `(,@(if source + `(("source" ,source)) + '()) + ,@inputs + + ;; Keep the standard inputs of 'gnu-build-system= '. + ,@(standard-packages))) + (build-inputs `(("r" ,r) + ,@native-inputs)) + (outputs outputs) + (build r-build) + (arguments (strip-keyword-arguments private-keywords arguments)= )))) + +(define* (r-build store name inputs + #:key + (tests? #t) + (test-target "tests") + (configure-flags ''()) + (phases '(@ (guix build r-build-system) + %standard-phases)) + (outputs '("out")) + (search-paths '()) + (system (%current-system)) + (guile #f) + (imported-modules %r-build-system-modules) + (modules '((guix build r-build-system) + (guix build utils)))) + "Build SOURCE with INPUTS." + (define builder + `(begin + (use-modules ,@modules) + (r-build #:name ,name + #:source ,(match (assoc-ref inputs "source") + (((? derivation? source)) + (derivation->output-path source)) + ((source) + source) + (source + source)) + #:configure-flags ,configure-flags + #:system ,system + #:tests? ,tests? + #:test-target ,test-target + #:phases ,phases + #:outputs %outputs + #:search-paths ',(map search-path-specification->sexp + search-paths) + #:inputs %build-inputs))) + + (define guile-for-build + (match guile + ((? package?) + (package-derivation store guile system #:graft? #f)) + (#f ; the default + (let* ((distro (resolve-interface '(gnu packages commencement))) + (guile (module-ref distro 'guile-final))) + (package-derivation store guile system #:graft? #f))))) + + (build-expression->derivation store name builder + #:inputs inputs + #:system system + #:modules imported-modules + #:outputs outputs + #:guile-for-build guile-for-build)) + +(define r-build-system + (build-system + (name 'r) + (description "The standard R build system") + (lower lower))) + +;;; r.scm ends here diff --git a/guix/build/r-build-system.scm b/guix/build/r-build-system.sc= m new file mode 100644 index 0000000..81e2de9 --- /dev/null +++ b/guix/build/r-build-system.scm @@ -0,0 +1,112 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2015 Ricardo Wurmus +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (a= t +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix build r-build-system) + #:use-module ((guix build gnu-build-system) #:prefix gnu:) + #:use-module (guix build utils) + #:use-module (ice-9 match) + #:use-module (ice-9 ftw) + #:use-module (ice-9 popen) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:export (%standard-phases + r-build)) + +;; Commentary: +;; +;; Builder-side code of the standard build procedure for R packages. +;; +;; Code: + +(define (call-r command params) + (zero? (apply system* "R" "CMD" command params))) + +(define (pipe-to-r command params) + (let ((port (apply open-pipe* OPEN_WRITE "R" params))) + (display command port) + (zero? (status:exit-val (close-pipe port))))) + +(define (generate-site-path inputs) + (string-join (map (match-lambda + ((_ path) + (string-append path "/site-library"))) + ;; Restrict to inputs beginning with "r-". + (filter (match-lambda + ((name _) + (string-prefix? "r-" name))) + inputs)) + ":")) + +(define* (check #:key test-target inputs outputs tests? #:allow-other-ke= ys) + "Run the test suite of a given R package." + (let* ((libdir (string-append (assoc-ref outputs "out") "/site-libr= ary/")) + + ;; R package names are case-sensitive and cannot be derived fro= m the + ;; Guix package name. The exact package name is required as an + ;; argument to =E2=80=98tools::testInstalledPackage=E2=80=99, w= hich runs the tests + ;; for a package given its name and the path to the =E2=80=9Cli= brary=E2=80=9D (a + ;; location for a collection of R packages) containing it. + + ;; Since there can only be one R package in any collection (=3D + ;; =E2=80=9Clibrary=E2=80=9D), the name of the only directory i= n the collection path + ;; is the original name of the R package. + (pkg-name (car (scandir libdir (negate (cut member <> '("." ".= .")))))) + (testdir (string-append libdir pkg-name "/" test-target)) + (site-path (string-append libdir ":" (generate-site-path inputs= )))) + (if (and tests? (file-exists? testdir)) + (begin + (setenv "R_LIBS_SITE" site-path) + (pipe-to-r (string-append "tools::testInstalledPackage(\"" pkg= -name "\", " + "lib.loc =3D \"" libdir "\")") + '("--no-save" "--slave"))) + #t))) + +(define* (install #:key outputs inputs (configure-flags '()) + #:allow-other-keys) + "Install a given R package." + (let* ((out (assoc-ref outputs "out")) + (site-library (string-append out "/site-library/")) + (params (append configure-flags + (list "--install-tests" + (string-append "--library=3D" site-= library) + "."))) + (site-path (string-append site-library ":" + (generate-site-path inputs)))) + ;; If dependencies cannot be found at install time, R will refuse to + ;; install the package. + (setenv "R_LIBS_SITE" site-path) + ;; Some R packages contain a configure script for which the CONFIG_S= HELL + ;; variable should be set. + (setenv "CONFIG_SHELL" (which "bash")) + (mkdir-p site-library) + (call-r "INSTALL" params))) + +(define %standard-phases + (modify-phases gnu:%standard-phases + (delete 'configure) + (delete 'build) + (delete 'check) ; tests must be run after installation + (replace 'install install) + (add-after 'install 'check check))) + +(define* (r-build #:key inputs (phases %standard-phases) + #:allow-other-keys #:rest args) + "Build the given R package, applying all of PHASES in order." + (apply gnu:gnu-build #:inputs inputs #:phases phases args)) + +;;; r-build-system.scm ends here --=20 2.1.0 --=-=-=--