diff options
Diffstat (limited to 'guix/import/cran.scm')
| -rw-r--r-- | guix/import/cran.scm | 82 |
1 files changed, 74 insertions, 8 deletions
diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 6eddcbfb7b..db9250faec 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -270,7 +270,7 @@ bioconductor package NAME, or #F if the package is unknown." ;; of the URLs is the /Archive CRAN URL. (any (cut download-to-store store <>) urls))))))))) -(define (fetch-description-from-tarball url) +(define* (fetch-description-from-tarball url #:key (download download)) "Fetch the tarball at URL, extra its 'DESCRIPTION' file, parse it, and return the resulting alist." (match (download url) @@ -288,7 +288,7 @@ return the resulting alist." (call-with-input-file (string-append dir "/DESCRIPTION") read-string))))))))) -(define* (fetch-description repository name #:optional version) +(define* (fetch-description repository name #:optional version replacement-download) "Return an alist of the contents of the DESCRIPTION file for the R package NAME at VERSION in the given REPOSITORY, or #f in case of failure. NAME is case-sensitive." @@ -310,7 +310,9 @@ from ~a: ~a (~a)~%") (string-append "mirror://cran/src/contrib/Archive/" name "/" name "_" version ".tar.gz")))) - (fetch-description-from-tarball urls)) + (fetch-description-from-tarball + urls #:download (or replacement-download + download))) (let* ((url (string-append %cran-url name "/DESCRIPTION")) (port (http-fetch url)) (result (description->alist (read-string port)))) @@ -327,7 +329,9 @@ from ~a: ~a (~a)~%") ;; TODO: Honor VERSION. (version (latest-bioconductor-package-version name type)) (url (car (bioconductor-uri name version type))) - (meta (fetch-description-from-tarball url))) + (meta (fetch-description-from-tarball + url #:download (or replacement-download + download)))) (if (boolean? type) meta (cons `(bioconductor-type . ,type) meta)))) @@ -453,6 +457,7 @@ empty list when the FIELD cannot be found." ("numpy" "python-numpy") ("openssl-devel" "openssl") ("openssl@1.1" "openssl-1.1") + ("packaging" "python-packaging") ("pandas" "python-pandas") ("pandoc-citeproc" "pandoc") ("python3" "python-3") @@ -667,6 +672,54 @@ of META, a package in REPOSITORY." (string<? (upstream-input-downstream-name input1) (upstream-input-downstream-name input2)))))) +(define (phases-for-inputs input-names) + "Generate a list of build phases based on the provided INPUT-NAMES, a list +of package names for all input packages." + (let ((rules + (list (lambda () + (and (any (lambda (name) + (member name '("styler" "ExperimentHub"))) + input-names) + '(add-after 'unpack 'set-HOME + (lambda _ (setenv "HOME" "/tmp"))))) + (lambda () + (and (member "esbuild" input-names) + '(add-after 'unpack 'process-javascript + (lambda* (#:key inputs #:allow-other-keys) + (with-directory-excursion "inst/" + (for-each (match-lambda + ((source . target) + (minify source #:target target))) + '()))))))))) + (fold (lambda (rule phases) + (let ((new-phase (rule))) + (if new-phase (cons new-phase phases) phases))) + (list) + rules))) + +(define (maybe-arguments inputs) + "Generate a list for the arguments field that can be spliced into a package +S-expression." + (let ((input-names (map upstream-input-name inputs)) + (esbuild-modules '(#:modules + '((guix build r-build-system) + (guix build minify-build-system) + (guix build utils) + (ice-9 match)) + #:imported-modules + `(,@%r-build-system-modules + (guix build minify-build-system))))) + (match (phases-for-inputs input-names) + (() '()) + (phases + `((arguments + (list + ,@(if (member "esbuild" input-names) + esbuild-modules '()) + #:phases + '(modify-phases %standard-phases + ,@phases)))))))) + (define* (description->package repository meta #:key (license-prefix identity) (download-source download)) "Return the `package' s-expression for an R package published on REPOSITORY @@ -746,7 +799,7 @@ from the alist META, which was derived from the R package's DESCRIPTION file." `((properties ,`(,'quasiquote ((,'upstream-name . ,name))))) '()) (build-system r-build-system) - + ,@(maybe-arguments inputs) ,@(maybe-inputs (filter (upstream-input-type-predicate 'regular) inputs) 'inputs) @@ -877,15 +930,25 @@ s-expression corresponding to that package, or #f on failure." (define upstream-name (package->upstream-name pkg)) + (define type + (cond + ((bioconductor-data-package? pkg) + 'annotation) + ((bioconductor-experiment-package? pkg) + 'experiment) + ((bioconductor-package? pkg) + #true) + (else #false))) + (define latest-version - (latest-bioconductor-package-version upstream-name)) + (latest-bioconductor-package-version upstream-name type)) (and latest-version ;; Bioconductor does not provide signatures. (upstream-source (package (package-name pkg)) (version latest-version) - (urls (bioconductor-uri upstream-name latest-version)) + (urls (bioconductor-uri upstream-name latest-version type)) (inputs (let ((meta (fetch-description 'bioconductor upstream-name))) (cran-package-inputs meta 'bioconductor)))))) @@ -939,7 +1002,10 @@ s-expression corresponding to that package, or #f on failure." (upstream-updater (name 'bioconductor) (description "Updater for Bioconductor packages") - (pred bioconductor-package?) + (pred (lambda (pkg) + (or (bioconductor-package? pkg) + (bioconductor-data-package? pkg) + (bioconductor-experiment-package? pkg)))) (import latest-bioconductor-release))) ;;; cran.scm ends here |