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>.

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."