guix-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[PATCH] R build system and CRAN importer (updated)


From: Ricardo Wurmus
Subject: [PATCH] R build system and CRAN importer (updated)
Date: Fri, 31 Jul 2015 15:11:59 +0200

Hi again,

attached are two patches.  The first is a slightly updated version of
the CRAN importer (it’s now defaulting to the CRAN URL for the
‘home-page’ field if no home page URL is given); the second is the R
build system.

I have tested this all by importing and building ‘ggplot2’ and all its
dependencies (about 16 packages in total, containing C code as well as R
code).  The build system seems to work well, as far as I can tell.  It
even runs test, although they are only run after the ‘install’ phase.
There is no ‘configure’ and no ‘build’ phase, because most of the work
is done with “R CMD INSTALL”.

Our ‘r’ package should declare a search path for R_LIBS_SITE to allow
for R packages to be found at runtime:

+    (native-search-paths
+     (list (search-path-specification
+            (variable "R_LIBS_SITE")
+            (files (list "site-library/")))))

I’ll submit a patch for this later.

~~ Ricardo

>From 3c0859e4086d9648119a3eb3ebff884a5ec07b47 Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <address@hidden>
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.
* Makefile.am (MODULES): Add 'guix/import/cran.scm' and
  'guix/scripts/import/cran.scm'.
* doc/guix.texi (Invoking guix import): Document it.
* po/guix/POTFILES.in: Add 'guix/scripts/import/cran.scm'.
---
 Makefile.am                  |   2 +
 doc/guix.texi                |  12 +++
 guix/import/cran.scm         | 190 +++++++++++++++++++++++++++++++++++++++++++
 guix/scripts/import.scm      |   2 +-
 guix/scripts/import/cran.scm |  92 +++++++++++++++++++++
 5 files changed, 297 insertions(+), 1 deletion(-)
 create mode 100644 guix/import/cran.scm
 create mode 100644 guix/scripts/import/cran.scm

diff --git a/Makefile.am b/Makefile.am
index ada4cbe..b397962 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -98,6 +98,7 @@ MODULES =                                     \
   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 =                                   \
   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              \
diff --git a/doc/guix.texi b/doc/guix.texi
index 24b2039..77e47c0 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -3867,6 +3867,18 @@ Perl module:
 guix import cpan Acme::Boolean
 @end example
 
address@hidden cran
address@hidden CRAN
+Import meta-data from @uref{http://cran.r-project.org/, CRAN}.
+Information is extracted from the HTML package description.
+
+The command command below imports meta-data for the @code{Cairo}
+R package:
+
address@hidden
+guix import cran Cairo
address@hidden example
+
 @item nix
 Import meta-data from a local copy of the source of the
 @uref{http://nixos.org/nixpkgs/, Nixpkgs address@hidden
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
new file mode 100644
index 0000000..805eeb3
--- /dev/null
+++ b/guix/import/cran.scm
@@ -0,0 +1,190 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 Ricardo Wurmus <address@hidden>
+;;;
+;;; 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 (at
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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-ci<? a b))))))
+
+(define (maybe-inputs package-inputs)
+  "Given a list of PACKAGE-INPUTS, tries to generate the 'inputs' field of a
+package definition."
+  (match package-inputs
+    (()
+     '())
+    ((package-inputs ...)
+     `((inputs (,'quasiquote ,(format-inputs package-inputs)))))))
+
+(define %cran-url "http://cran.r-project.org/web/packages/";)
+
+(define (cran-fetch name)
+  "Return an sxml representation of the CRAN page for the R package NAME,
+or #f on failure.  NAME is case-sensitive."
+  ;; This API always returns the latest release of the module.
+  (let ((cran-url (string-append %cran-url name)))
+    (false-if-exception
+     (xml->sxml (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) ">=")
+                    ((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) " "))
+
+  ;; Extract the datum node next to a LABEL in the sxml table TREE.
+  (define (table-datum tree label)
+    (let ((label-node ((sxpath `(xhtml:tr (equal? (xhtml:td ,label)))) tree)))
+      (if (null? label-node)
+          '()
+          ((node-pos 1)
+           ((take-after (node-eq? (car label-node)))
+            ((node-join
+              (node-parent tree)
+              (select-kids (node-typeof? '*)))
+             label-node))))))
+
+  (define (guix-name name)
+    (if (string-prefix? "r-" name)
+        (string-downcase name)
+        (string-append "r-" (string-downcase name))))
+
+  (sxml-match-let*
+   (((xhtml:html
+      ,head
+      (xhtml:body
+       (xhtml:h2 ,name-and-synopsis)
+       (xhtml:p ,description)
+       ,summary
+       (xhtml:h4 "Downloads:") ,downloads
+       . ,rest))
+     (cadr 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 want an
+                                     ;; absolute path.
+                                     (regexp-substitute/global
+                                      #f "\\.\\./"
+                                      (string-join
+                                       ((sxpath '((xhtml:a 1) @ href *text*))
+                                        (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 
"SystemRequirements:"))
+                             '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 version)))
+                  (sha256
+                   (base32
+                    ,(bytevector->nix-base32-string (file-sha256 tarball))))))
+        (build-system r-build-system)
+        ,@(maybe-inputs (append sysdepends imports))
+        (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 return the
+`package' s-expression corresponding to that package, or #f on failure."
+  (let ((module-meta (cran-fetch package-name)))
+    (and=> 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.
 ;;;
 
-(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa"))
+(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa" "cran"))
 
 (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 © 2014 Eric Bavier <address@hidden>
+;;; Copyright © 2015 Ricardo Wurmus <address@hidden>
+;;;
+;;; 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 (at
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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))
+
+
+;;;
+;;; 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))
+
+
+;;;
+;;; 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~%"))))))
-- 
2.1.0

>From 6b0fcfe408600b3114f88ec430e48acf2a4f1cba Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <address@hidden>
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                 |   9 +++
 guix/build-system/r.scm       | 134 ++++++++++++++++++++++++++++++++++++++++++
 guix/build/r-build-system.scm | 100 +++++++++++++++++++++++++++++++
 4 files changed, 245 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 b397962..af71fae 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -58,6 +58,7 @@ MODULES =                                     \
   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 =                                     \
   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 77e47c0..5a5ef4c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2464,6 +2464,15 @@ passes flags specified by the @code{#:make-maker-flags} 
or
 Which Perl package is used can be specified with @code{#:perl}.
 @end defvr
 
address@hidden {Scheme Variable} r-build-system
+This variable is exported by @code{(guix build-system r)}.  It
+implements the build procedure used by R packages, which essentially is
+little more than running @code{R CMD INSTALL
+--library=/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}.
address@hidden 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 © 2015 Ricardo Wurmus <address@hidden>
+;;;
+;;; 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 (at
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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-compilation
+       (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.scm
new file mode 100644
index 0000000..24c806c
--- /dev/null
+++ b/guix/build/r-build-system.scm
@@ -0,0 +1,100 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 Ricardo Wurmus <address@hidden>
+;;;
+;;; 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 (at
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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 (lambda (input)
+                      (string-append (cdr input) "/site-library"))
+                    ;; Restrict to inputs beginning with "r-".
+                    (filter (lambda (input)
+                              (string-prefix? "r-" (car input)))
+                            inputs))
+               ":"))
+
+(define* (check #:key test-target inputs outputs tests? #:allow-other-keys)
+  "Run the test suite of a given R package."
+  (let* ((libdir    (string-append (assoc-ref outputs "out") "/site-library/"))
+         (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 = \"" libdir "\")")
+                     (list "--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=" 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_SHELL
+    ;; 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
-- 
2.1.0


reply via email to

[Prev in Thread] Current Thread [Next in Thread]