guix-devel/guix/build/r-build-system.scm

114 lines
4.7 KiB
Scheme
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; 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 (invoke-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-keys)
"Run the test suite of a given R package."
(let* ((libdir (string-append (assoc-ref outputs "out") "/site-library/"))
;; R package names are case-sensitive and cannot be derived from the
;; Guix package name. The exact package name is required as an
;; argument to tools::testInstalledPackage, which runs the tests
;; for a package given its name and the path to the “library” (a
;; location for a collection of R packages) containing it.
;; Since there can only be one R package in any collection (=
;; “library”), the name of the only directory in 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 = \"" 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=" site-library)
"--built-timestamp=1970-01-01"
".")))
(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)
(invoke-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