diff options
author | Ludovic Courtès <ludo@gnu.org> | 2023-05-15 22:37:25 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2023-05-31 23:25:24 +0200 |
commit | e6223017d95bc615b2648f0798d9a3904d5b5f57 (patch) | |
tree | 39fcbb535bf7077f684f3b3860e2360863fd3982 /guix/import/cran.scm | |
parent | db10a4a2aefd8c8b2edb6fedc220396c50541c4b (diff) | |
download | guix-patches-e6223017d95bc615b2648f0798d9a3904d5b5f57.tar guix-patches-e6223017d95bc615b2648f0798d9a3904d5b5f57.tar.gz |
upstream: Replace 'input-changes' field by 'inputs'.
Returning the expected list of inputs rather than changes relative to
the current package definition is less ambiguous and offers more
possibilities for further processing.
* guix/upstream.scm (<upstream-source>)[input-changes]: Remove.
[inputs]: New field.
(<upstream-input>): New record type.
* guix/upstream.scm (upstream-input-type-predicate)
(input-type-filter, upstream-source-regular-inputs)
(upstream-source-native-inputs, upstream-source-propagated-inputs): New
procedures.
(changed-inputs): Expect an <upstream-source> as its second argument.
Adjust accordingly.
* guix/import/pypi.scm (distribution-sha256): New procedure.
(maybe-inputs): Expect a list of <upstream-input>.
(compute-inputs): Rewrite to return a list of <upstream-input>.
(pypi-package-inputs, pypi-package->upstream-source): New procedures.
(make-pypi-sexp): Use it.
* guix/import/stackage.scm (latest-lts-release): Define 'cabal'.
Replace 'input-changes' field by 'inputs'.
* guix/scripts/refresh.scm (update-package): Use 'changed-inputs'
instead of 'upstream-source-input-changes'.
* tests/cran.scm ("description->package"): Adjust order of inputs.
* tests/pypi.scm (default-sha256, default-sha256/base32): New variables.
(foo-json): Add 'digests' entry.
("pypi->guix-package, no wheel"): Check HASH against DEFAULT-SHA256/BASE32.
("pypi->guix-package, wheels"): Likewise.
("pypi->guix-package, no usable requirement file."): Likewise.
("pypi->guix-package, package name contains \"-\" followed by digits"):
Likewise.
("package-latest-release"): New test.
* tests/upstream.scm (test-package-sexp): Remove.
("changed-inputs returns no changes"): Rewrite to use <upstream-source>.
(test-new-package-sexp): Remove.
("changed-inputs returns changes to plain input list"): Rewrite.
("changed-inputs returns changes to all plain input lists"): Likewise.
("changed-inputs returns changes to labelled input list")
("changed-inputs returns changes to all labelled input lists"): Remove.
* guix/import/cran.scm (maybe-inputs): Expect PACKAGE-INPUTS to be a
list of <upstream-input>.
(source-dir->dependencies): Return a list of <upstream-input>.
(vignette-builders): Likewise.
(uri-helper, cran-package-source-url)
(cran-package-propagated-inputs, cran-package-inputs): New procedures.
(description->package): Use them instead of local definitions.
(latest-cran-release): Replace 'input-changes' field by 'inputs'.
(latest-bioconductor-release): Likewise.
(format-inputs): Remove.
* guix/import/hackage.scm (cabal-package-inputs): New procedure.
(hackage-module->sexp): Use it.
[maybe-inputs]: Expect a list of <upstream-input>.
Diffstat (limited to 'guix/import/cran.scm')
-rw-r--r-- | guix/import/cran.scm | 194 |
1 files changed, 125 insertions, 69 deletions
diff --git a/guix/import/cran.scm b/guix/import/cran.scm index bb271634ed..d25f334396 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015-2023 Ricardo Wurmus <rekado@elephly.net> -;;; Copyright © 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015-2017, 2019-2021, 2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> @@ -164,24 +164,16 @@ rest))))))) (fold parse '() lines))) -(define (format-inputs names) - "Generate a sorted list of package inputs from a list of package NAMES." - (map (lambda (name) - (case (%input-style) - ((specification) - `(specification->package ,name)) - (else - (string->symbol name)))) - (sort names string-ci<?))) - -(define* (maybe-inputs package-inputs #:optional (type 'inputs)) +(define* (maybe-inputs package-inputs #:optional (input-type 'inputs)) "Given a list of PACKAGE-INPUTS, tries to generate the TYPE field of a package definition." (match package-inputs (() '()) ((package-inputs ...) - `((,type (list ,@(format-inputs package-inputs))))))) + `((,input-type (list ,@(map (compose string->symbol + upstream-input-downstream-name) + package-inputs))))))) (define %cran-url "https://cran.r-project.org/web/packages/") (define %cran-canonical-url "https://cran.r-project.org/package=") @@ -520,14 +512,29 @@ the pkg-config tool." "(Makevars.*|configure.*)")) (define (source-dir->dependencies dir) - "Guess dependencies of R package source in DIR and return two values: a list -of package names for INPUTS and another list of names of NATIVE-INPUTS." - (values - (needed-libraries-in-directory dir) - (append - (if (directory-needs-esbuild? dir) '("esbuild") '()) - (if (directory-needs-pkg-config? dir) '("pkg-config") '()) - (if (directory-needs-fortran? dir) '("gfortran") '())))) + "Guess dependencies of R package source in DIR and return a list of +<upstream-input> corresponding to the dependencies guessed from source files +in DIR." + (define (native name) + (upstream-input + (name name) + (downstream-name name) + (type 'native))) + + (append (map (lambda (name) + (upstream-input + (name name) + (downstream-name (cran-guix-name name)))) + (needed-libraries-in-directory dir)) + (if (directory-needs-esbuild? dir) + (list (native "esbuild")) + '()) + (if (directory-needs-pkg-config? dir) + (list (native "pkg-config")) + '()) + (if (directory-needs-fortran? dir) + (list (native "gfortran")) + '()))) (define (source->dependencies source tarball?) "SOURCE-DIR->DEPENDENCIES, but for directories and tarballs as indicated @@ -541,7 +548,79 @@ by TARBALL?" (source-dir->dependencies source))) (define (vignette-builders meta) - (map cran-guix-name (listify meta "VignetteBuilder"))) + (map (lambda (name) + (upstream-input + (name name) + (downstream-name (cran-guix-name name)) + (type 'native))) + (listify meta "VignetteBuilder"))) + +(define (uri-helper repository) + (match repository + ('cran cran-uri) + ('bioconductor bioconductor-uri) + ('git #f) + ('hg #f))) + +(define (cran-package-source-url meta repository) + "Return the URL of the source code referred to by META, a package in +REPOSITORY." + (case repository + ((git) (assoc-ref meta 'git)) + ((hg) (assoc-ref meta 'hg)) + (else + (match (apply (uri-helper repository) + (assoc-ref meta "Package") + (assoc-ref meta "Version") + (case repository + ((bioconductor) + (list (assoc-ref meta 'bioconductor-type))) + (else '()))) + ((urls ...) urls) + ((? string? url) url) + (_ #f))))) + +(define (cran-package-propagated-inputs meta) + "Return the list of <upstream-input> derived from dependency information in +META." + (filter-map (lambda (name) + (and (not (member name + (append default-r-packages invalid-packages))) + (upstream-input + (name name) + (downstream-name (cran-guix-name name)) + (type 'propagated)))) + (lset-union equal? + (listify meta "Imports") + (listify meta "LinkingTo") + (delete "R" (listify meta "Depends"))))) + +(define* (cran-package-inputs meta repository + #:key (download-source download)) + "Return the list of <upstream-input> corresponding to all the dependencies +of META, a package in REPOSITORY." + (let* ((url (cran-package-source-url meta repository)) + (source (download-source url + #:method + (cond ((assoc-ref meta 'git) 'git) + ((assoc-ref meta 'hg) 'hg) + (else #f)))) + (tarball? (not (or (assoc-ref meta 'git) + (assoc-ref meta 'hg))))) + (sort (append (source->dependencies source tarball?) + (filter-map (lambda (name) + (and (not (member name invalid-packages)) + (upstream-input + (name name) + (downstream-name + (transform-sysname name))))) + (map string-downcase + (listify meta "SystemRequirements"))) + (cran-package-propagated-inputs meta) + (vignette-builders meta)) + (lambda (input1 input2) + (string<? (upstream-input-downstream-name input1) + (upstream-input-downstream-name input2)))))) (define* (description->package repository meta #:key (license-prefix identity) (download-source download)) @@ -556,11 +635,6 @@ from the alist META, which was derived from the R package's DESCRIPTION file." ((cran) %cran-canonical-url) ((bioconductor) %bioconductor-url) ((git) #f))) - (uri-helper (case repository - ((cran) cran-uri) - ((bioconductor) bioconductor-uri) - ((git) #f) - ((hg) #f))) (name (assoc-ref meta "Package")) (synopsis (assoc-ref meta "Title")) (version (assoc-ref meta "Version")) @@ -572,40 +646,16 @@ from the alist META, which was derived from the R package's DESCRIPTION file." (else (match (listify meta "URL") ((url rest ...) url) (_ (string-append canonical-url-base name)))))) - (source-url (case repository - ((git) (assoc-ref meta 'git)) - ((hg) (assoc-ref meta 'hg)) - (else - (match (apply uri-helper name version - (case repository - ((bioconductor) - (list (assoc-ref meta 'bioconductor-type))) - (else '()))) - ((urls ...) urls) - ((? string? url) url) - (_ #f))))) + (source-url (cran-package-source-url meta repository)) (git? (if (assoc-ref meta 'git) #true #false)) (hg? (if (assoc-ref meta 'hg) #true #false)) (source (download-source source-url #:method (cond (git? 'git) (hg? 'hg) (else #f)))) - (tarball? (not (or git? hg?))) - (source-inputs source-native-inputs - (source->dependencies source tarball?)) - (sysdepends (append - source-inputs - (filter (lambda (name) - (not (member name invalid-packages))) - (map string-downcase (listify meta "SystemRequirements"))))) - (propagate (filter (lambda (name) - (not (member name (append default-r-packages - invalid-packages)))) - (lset-union equal? - (listify meta "Imports") - (listify meta "LinkingTo") - (delete "R" - (listify meta "Depends"))))) + (uri-helper (uri-helper repository)) + (inputs (cran-package-inputs meta repository + #:download-source download-source)) (package `(package (name ,(cran-guix-name name)) @@ -651,12 +701,18 @@ 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-inputs (map transform-sysname sysdepends)) - ,@(maybe-inputs (map cran-guix-name propagate) 'propagated-inputs) - ,@(maybe-inputs - `(,@source-native-inputs - ,@(vignette-builders meta)) - 'native-inputs) + + ,@(maybe-inputs (filter (upstream-input-type-predicate 'regular) + inputs) + 'inputs) + ,@(maybe-inputs (filter (upstream-input-type-predicate + 'propagated) + inputs) + 'propagated-inputs) + ,@(maybe-inputs (filter (upstream-input-type-predicate 'native) + inputs) + 'native-inputs) + (home-page ,(if (string-null? home-page) (string-append base-url name) home-page)) @@ -675,7 +731,10 @@ from the alist META, which was derived from the R package's DESCRIPTION file." (revision "1")) ,package)) (else package)) - propagate))) + (filter-map (lambda (input) + (and (eq? 'propagated (upstream-input-type input)) + (upstream-input-name input))) + inputs)))) (define cran->guix-package (memoize @@ -760,9 +819,7 @@ s-expression corresponding to that package, or #f on failure." (package (package-name pkg)) (version version) (urls (cran-uri upstream-name version)) - (input-changes - (changed-inputs pkg - (description->package 'cran meta))))))) + (inputs (cran-package-inputs meta 'cran)))))) (define* (latest-bioconductor-release pkg #:key (version #f)) "Return an <upstream-source> for the latest release of the package PKG." @@ -784,10 +841,9 @@ s-expression corresponding to that package, or #f on failure." (package (package-name pkg)) (version latest-version) (urls (bioconductor-uri upstream-name latest-version)) - (input-changes - (changed-inputs - pkg - (cran->guix-package upstream-name #:repo 'bioconductor)))))) + (inputs + (let ((meta (fetch-description 'bioconductor upstream-name))) + (cran-package-inputs meta 'bioconductor)))))) (define (cran-package? package) "Return true if PACKAGE is an R package from CRAN." |