[jackhill/guix/guix.git] / guix / build-system / r.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2017, 2018, 2019, 2020 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-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
            cran-uri
            bioconductor-uri))

;; Commentary:
;;
;; Standard build procedure for R packages.
;;
;; Code:

(define (cran-uri name version)
  "Return a list of URI strings for the R package archive on CRAN for the
release corresponding to NAME and VERSION.  As only the most recent version is
available via the first URI, the second URI points to the archived version."
  (list (string-append "mirror://cran/src/contrib/"
                       name "_" version ".tar.gz")
        (string-append "mirror://cran/src/contrib/Archive/"
                       name "/" name "_" version ".tar.gz")))

(define* (bioconductor-uri name version #:optional type)
  "Return a URI string for the R package archive on Bioconductor for the
release corresponding to NAME and VERSION."
  (let ((type-url-part (match type
                         ('annotation "/data/annotation")
                         ('experiment "/data/experiment")
                         (_ "/bioc"))))
    (list (string-append "https://bioconductor.org/packages/release"
                         type-url-part
                         "/src/contrib/"
                         name "_" version ".tar.gz")
          ;; TODO: use %bioconductor-version from (guix import cran)
          (string-append "https://bioconductor.org/packages/3.11"
                         type-url-part
                         "/src/contrib/"
                         name "_" version ".tar.gz"))))

(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-minimal)))

(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 #:r #: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)
                  (substitutable? #t)
                  (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
                                #:substitutable? substitutable?))

(define r-build-system
  (build-system
    (name 'r)
    (description "The standard R build system")
    (lower lower)))

;;; r.scm ends here
Commit	Line	Data
f8f3bef6	1	;;; GNU Guix --- Functional package management for GNU
8e518d48	2	;;; Copyright © 2015, 2017, 2018, 2019, 2020 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-system r)
	20	#:use-module (guix store)
	21	#:use-module (guix utils)
	22	#:use-module (guix packages)
	23	#:use-module (guix derivations)
	24	#:use-module (guix search-paths)
	25	#:use-module (guix build-system)
	26	#:use-module (guix build-system gnu)
	27	#:use-module (ice-9 match)
	28	#:use-module (srfi srfi-26)
	29	#:export (%r-build-system-modules
	30	r-build
5546114e	31	r-build-system
12d38e8d RW	32	cran-uri
12d38e8d RW	33	bioconductor-uri))
f8f3bef6 RW	34
	35	;; Commentary:
	36	;;
	37	;; Standard build procedure for R packages.
	38	;;
	39	;; Code:
	40
5546114e RW	41	(define (cran-uri name version)
	42	"Return a list of URI strings for the R package archive on CRAN for the
	43	release corresponding to NAME and VERSION. As only the most recent version is
	44	available via the first URI, the second URI points to the archived version."
	45	(list (string-append "mirror://cran/src/contrib/"
	46	name "_" version ".tar.gz")
	47	(string-append "mirror://cran/src/contrib/Archive/"
	48	name "/" name "_" version ".tar.gz")))
	49
c586f427	50	(define* (bioconductor-uri name version #:optional type)
12d38e8d RW	51	"Return a URI string for the R package archive on Bioconductor for the
12d38e8d RW	52	release corresponding to NAME and VERSION."
c586f427 RW	53	(let ((type-url-part (match type
	54	('annotation "/data/annotation")
	55	('experiment "/data/experiment")
	56	(_ "/bioc"))))
	57	(list (string-append "https://bioconductor.org/packages/release"
	58	type-url-part
	59	"/src/contrib/"
	60	name "_" version ".tar.gz")
74e7465c	61	;; TODO: use %bioconductor-version from (guix import cran)
8e518d48	62	(string-append "https://bioconductor.org/packages/3.11"
c586f427	63	type-url-part
b032d14e	64	"/src/contrib/"
c586f427	65	name "_" version ".tar.gz"))))
12d38e8d	66
f8f3bef6 RW	67	(define %r-build-system-modules
	68	;; Build-side modules imported by default.
	69	`((guix build r-build-system)
	70	,@%gnu-build-system-modules))
	71
	72	(define (default-r)
	73	"Return the default R package."
	74	;; Lazily resolve the binding to avoid a circular dependency.
	75	(let ((r-mod (resolve-interface '(gnu packages statistics))))
2d7c4ae3	76	(module-ref r-mod 'r-minimal)))
f8f3bef6 RW	77
	78	(define* (lower name
	79	#:key source inputs native-inputs outputs system target
	80	(r (default-r))
	81	#:allow-other-keys
	82	#:rest arguments)
	83	"Return a bag for NAME."
	84	(define private-keywords
32eb4424	85	'(#:source #:target #:r #:inputs #:native-inputs))
f8f3bef6 RW	86
	87	(and (not target) ;XXX: no cross-compilation
	88	(bag
	89	(name name)
	90	(system system)
	91	(host-inputs `(,@(if source
	92	`(("source" ,source))
	93	'())
	94	,@inputs
	95
	96	;; Keep the standard inputs of 'gnu-build-system'.
	97	,@(standard-packages)))
	98	(build-inputs `(("r" ,r)
	99	,@native-inputs))
	100	(outputs outputs)
	101	(build r-build)
	102	(arguments (strip-keyword-arguments private-keywords arguments)))))
	103
	104	(define* (r-build store name inputs
	105	#:key
	106	(tests? #t)
	107	(test-target "tests")
	108	(configure-flags ''())
	109	(phases '(@ (guix build r-build-system)
	110	%standard-phases))
	111	(outputs '("out"))
	112	(search-paths '())
	113	(system (%current-system))
	114	(guile #f)
cb6ce89e	115	(substitutable? #t)
f8f3bef6 RW	116	(imported-modules %r-build-system-modules)
	117	(modules '((guix build r-build-system)
	118	(guix build utils))))
	119	"Build SOURCE with INPUTS."
	120	(define builder
	121	`(begin
	122	(use-modules ,@modules)
	123	(r-build #:name ,name
	124	#:source ,(match (assoc-ref inputs "source")
	125	(((? derivation? source))
	126	(derivation->output-path source))
	127	((source)
	128	source)
	129	(source
	130	source))
	131	#:configure-flags ,configure-flags
	132	#:system ,system
	133	#:tests? ,tests?
	134	#:test-target ,test-target
	135	#:phases ,phases
	136	#:outputs %outputs
	137	#:search-paths ',(map search-path-specification->sexp
	138	search-paths)
	139	#:inputs %build-inputs)))
	140
	141	(define guile-for-build
	142	(match guile
	143	((? package?)
	144	(package-derivation store guile system #:graft? #f))
	145	(#f ; the default
	146	(let* ((distro (resolve-interface '(gnu packages commencement)))
	147	(guile (module-ref distro 'guile-final)))
	148	(package-derivation store guile system #:graft? #f)))))
	149
	150	(build-expression->derivation store name builder
	151	#:inputs inputs
	152	#:system system
	153	#:modules imported-modules
	154	#:outputs outputs
cb6ce89e RW	155	#:guile-for-build guile-for-build
cb6ce89e RW	156	#:substitutable? substitutable?))
f8f3bef6 RW	157
	158	(define r-build-system
	159	(build-system
	160	(name 'r)
	161	(description "The standard R build system")
	162	(lower lower)))
	163
	164	;;; r.scm ends here