Commit | Line | Data |
---|---|---|
f8f3bef6 | 1 | ;;; GNU Guix --- Functional package management for GNU |
babeea3f | 2 | ;;; Copyright © 2015, 2017, 2018 Ricardo Wurmus <rekado@elephly.net> |
f8f3bef6 RW |
3 | ;;; |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | (define-module (guix build r-build-system) | |
20 | #:use-module ((guix build gnu-build-system) #:prefix gnu:) | |
21 | #:use-module (guix build utils) | |
22 | #:use-module (ice-9 match) | |
23 | #:use-module (ice-9 ftw) | |
24 | #:use-module (ice-9 popen) | |
25 | #:use-module (srfi srfi-1) | |
26 | #:use-module (srfi srfi-26) | |
babeea3f | 27 | #:use-module (srfi srfi-35) |
f8f3bef6 RW |
28 | #:export (%standard-phases |
29 | r-build)) | |
30 | ||
31 | ;; Commentary: | |
32 | ;; | |
33 | ;; Builder-side code of the standard build procedure for R packages. | |
34 | ;; | |
35 | ;; Code: | |
36 | ||
37 | (define (invoke-r command params) | |
babeea3f | 38 | (apply invoke "R" "CMD" command params)) |
f8f3bef6 RW |
39 | |
40 | (define (pipe-to-r command params) | |
41 | (let ((port (apply open-pipe* OPEN_WRITE "R" params))) | |
42 | (display command port) | |
babeea3f RW |
43 | (let ((code (status:exit-val (close-pipe port)))) |
44 | (unless (zero? code) | |
45 | (raise (condition ((@@ (guix build utils) &invoke-error) | |
46 | (program "R") | |
4dd91dff | 47 | (arguments (cons command params)) |
babeea3f RW |
48 | (exit-status (status:exit-val code)) |
49 | (term-signal (status:term-sig code)) | |
50 | (stop-signal (status:stop-sig code))))))))) | |
f8f3bef6 RW |
51 | |
52 | (define (generate-site-path inputs) | |
53 | (string-join (map (match-lambda | |
54 | ((_ . path) | |
55 | (string-append path "/site-library"))) | |
56 | ;; Restrict to inputs beginning with "r-". | |
57 | (filter (match-lambda | |
58 | ((name . _) | |
59 | (string-prefix? "r-" name))) | |
60 | inputs)) | |
61 | ":")) | |
62 | ||
63 | (define* (check #:key test-target inputs outputs tests? #:allow-other-keys) | |
64 | "Run the test suite of a given R package." | |
65 | (let* ((libdir (string-append (assoc-ref outputs "out") "/site-library/")) | |
66 | ||
67 | ;; R package names are case-sensitive and cannot be derived from the | |
68 | ;; Guix package name. The exact package name is required as an | |
69 | ;; argument to ‘tools::testInstalledPackage’, which runs the tests | |
70 | ;; for a package given its name and the path to the “library” (a | |
71 | ;; location for a collection of R packages) containing it. | |
72 | ||
73 | ;; Since there can only be one R package in any collection (= | |
74 | ;; “library”), the name of the only directory in the collection path | |
75 | ;; is the original name of the R package. | |
76 | (pkg-name (car (scandir libdir (negate (cut member <> '("." "..")))))) | |
77 | (testdir (string-append libdir pkg-name "/" test-target)) | |
78 | (site-path (string-append libdir ":" (generate-site-path inputs)))) | |
babeea3f RW |
79 | (when (and tests? (file-exists? testdir)) |
80 | (setenv "R_LIBS_SITE" site-path) | |
81 | (pipe-to-r (string-append "tools::testInstalledPackage(\"" pkg-name "\", " | |
82 | "lib.loc = \"" libdir "\")") | |
83 | '("--no-save" "--slave"))) | |
84 | #t)) | |
f8f3bef6 RW |
85 | |
86 | (define* (install #:key outputs inputs (configure-flags '()) | |
87 | #:allow-other-keys) | |
88 | "Install a given R package." | |
89 | (let* ((out (assoc-ref outputs "out")) | |
90 | (site-library (string-append out "/site-library/")) | |
91 | (params (append configure-flags | |
92 | (list "--install-tests" | |
93 | (string-append "--library=" site-library) | |
de643f0c | 94 | "--built-timestamp=1970-01-01" |
f8f3bef6 RW |
95 | "."))) |
96 | (site-path (string-append site-library ":" | |
97 | (generate-site-path inputs)))) | |
98 | ;; If dependencies cannot be found at install time, R will refuse to | |
99 | ;; install the package. | |
100 | (setenv "R_LIBS_SITE" site-path) | |
101 | ;; Some R packages contain a configure script for which the CONFIG_SHELL | |
102 | ;; variable should be set. | |
103 | (setenv "CONFIG_SHELL" (which "bash")) | |
104 | (mkdir-p site-library) | |
105 | (invoke-r "INSTALL" params))) | |
106 | ||
107 | (define %standard-phases | |
108 | (modify-phases gnu:%standard-phases | |
189be331 | 109 | (delete 'bootstrap) |
f8f3bef6 RW |
110 | (delete 'configure) |
111 | (delete 'build) | |
112 | (delete 'check) ; tests must be run after installation | |
113 | (replace 'install install) | |
114 | (add-after 'install 'check check))) | |
115 | ||
116 | (define* (r-build #:key inputs (phases %standard-phases) | |
117 | #:allow-other-keys #:rest args) | |
118 | "Build the given R package, applying all of PHASES in order." | |
119 | (apply gnu:gnu-build #:inputs inputs #:phases phases args)) | |
120 | ||
121 | ;;; r-build-system.scm ends here |