[bug#51493] [PATCH 0/5] Improvements to the pypi, cran, and "print" importers

[bug#51493] [PATCH 0/5] Improvements to the pypi, cran, and "print" importers

[Ludovic Courtès]

Hi!

These changes were prompted by the need to be able to import
specific versions of packages so I could estimate importer/repository
accuracy:

  https://lists.gnu.org/archive/html/guix-devel/2021-10/msg00258.html

Feedback welcome!

Ludo’.

Ludovic Courtès (5):
  import: pypi: Allow imports of a specific version.
  import: cran: Allow imports of a specific version.
  import: print: Properly render packages with origins as inputs.
  import: print: Correctly handle URI lists.
  import: print: Handle patches that are origins.

 doc/guix.texi                | 16 ++++++-
 guix/import/cran.scm         | 89 +++++++++++++++++++++++-------------
 guix/import/print.scm        | 36 ++++++++++++---
 guix/import/pypi.scm         | 47 ++++++++++---------
 guix/scripts/import/cran.scm | 35 +++++++-------
 guix/scripts/import/pypi.scm | 32 +++++++------
 tests/print.scm              | 61 ++++++++++++++++++++++++
 tests/pypi.scm               | 12 +++--
 8 files changed, 232 insertions(+), 96 deletions(-)


base-commit: 7dbd5339d7e9c572afa0aa051dd304abe702cb7d
-- 
2.33.0

[bug#51493] [PATCH 1/5] import: pypi: Allow imports of a specific version.

[Ludovic Courtès]

* guix/import/pypi.scm (latest-version): New procedure.
(latest-source-release): Rename to...
(source-release): ... this.  Add 'version' parameter.
(latest-wheel-release): Rename to...
(wheel-release): ... this.  Add 'version' parameter.
(pypi->guix-package): Honor 'version' parameter.
(pypi-recursive-import): Add 'version' parameter and honor it.
* guix/scripts/import/pypi.scm (guix-import-pypi): Expect a spec.  Pass
it to 'package-name->name+version'.  Pass the 'version' parameter.
* tests/pypi.scm ("pypi->guix-package, no wheel"): Exercise
the #:version parameter.
* doc/guix.texi (Invoking guix import): Document it.
---
 doc/guix.texi                | 10 ++++++--
 guix/import/pypi.scm         | 47 +++++++++++++++++++-----------------
 guix/scripts/import/pypi.scm | 32 ++++++++++++------------
 tests/pypi.scm               | 12 ++++++---
 4 files changed, 59 insertions(+), 42 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 22215214e0..b742a4808a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11723,13 +11723,19 @@ information, including package dependencies.  For maximum efficiency, it
 is recommended to install the @command{unzip} utility, so that the
 importer can unzip Python wheels and gather data from them.
 
-The command below imports metadata for the @code{itsdangerous} Python
-package:
+The command below imports metadata for the latest version of the
+@code{itsdangerous} Python package:
 
 @example
 guix import pypi itsdangerous
 @end example
 
+You can also ask for a specific version:
+
+@example
+guix import pypi itsdangerous@@1.1.0
+@end example
+
 @table @code
 @item --recursive
 @itemx -r
diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index f908136481..418a3556ec 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -128,27 +128,30 @@ (define-condition-type &missing-source-error &error
   missing-source-error?
   (package  missing-source-error-package))
 
-(define (latest-source-release pypi-package)
-  "Return the latest source release for PYPI-PACKAGE."
-  (let ((releases (assoc-ref (pypi-project-releases pypi-package)
-                             (project-info-version
-                              (pypi-project-info pypi-package)))))
+(define (latest-version project)
+  "Return the latest version of PROJECT, a <pypi-project> record."
+  (project-info-version (pypi-project-info project)))
+
+(define* (source-release pypi-package
+                         #:optional (version (latest-version pypi-package)))
+  "Return the source release of VERSION for PYPI-PACKAGE, a <pypi-project>
+record, by default the latest version."
+  (let ((releases (or (assoc-ref (pypi-project-releases pypi-package) version)
+                      '())))
     (or (find (lambda (release)
                 (string=? "sdist" (distribution-package-type release)))
               releases)
         (raise (condition (&missing-source-error
                            (package pypi-package)))))))
 
-(define (latest-wheel-release pypi-package)
+(define* (wheel-release pypi-package
+                        #:optional (version (latest-version pypi-package)))
   "Return the url of the wheel for the latest release of pypi-package,
 or #f if there isn't any."
-  (let ((releases (assoc-ref (pypi-project-releases pypi-package)
-                             (project-info-version
-                              (pypi-project-info pypi-package)))))
-    (or (find (lambda (release)
-                (string=? "bdist_wheel" (distribution-package-type release)))
-              releases)
-        #f)))
+  (let ((releases (assoc-ref (pypi-project-releases pypi-package) version)))
+    (find (lambda (release)
+            (string=? "bdist_wheel" (distribution-package-type release)))
+          releases)))
 
 (define (python->package-name name)
   "Given the NAME of a package on PyPI, return a Guix-compliant name for the
@@ -484,18 +487,17 @@ (define pypi->guix-package
      "Fetch the metadata for PACKAGE-NAME from pypi.org, and return the
 `package' s-expression corresponding to that package, or #f on failure."
      (let* ((project (pypi-fetch package-name))
-            (info    (and project (pypi-project-info project))))
+            (info    (and=> project pypi-project-info))
+            (version (or version (and=> project latest-version))))
        (and project
             (guard (c ((missing-source-error? c)
                        (let ((package (missing-source-error-package c)))
                          (leave (G_ "no source release for pypi package ~a ~a~%")
-                                (project-info-name info)
-                                (project-info-version info)))))
-              (make-pypi-sexp (project-info-name info)
-                              (project-info-version info)
-                              (and=> (latest-source-release project)
+                                (project-info-name info) version))))
+              (make-pypi-sexp (project-info-name info) version
+                              (and=> (source-release project version)
                                      distribution-url)
-                              (and=> (latest-wheel-release project)
+                              (and=> (wheel-release project version)
                                      distribution-url)
                               (project-info-home-page info)
                               (project-info-summary info)
@@ -503,8 +505,9 @@ (define pypi->guix-package
                               (string->license
                                (project-info-license info)))))))))
 
-(define (pypi-recursive-import package-name)
+(define* (pypi-recursive-import package-name #:optional version)
   (recursive-import package-name
+                    #:version version
                     #:repo->guix-package pypi->guix-package
                     #:guix-name python->package-name))
 
@@ -538,7 +541,7 @@ (define (latest-release package)
            (let* ((info    (pypi-project-info pypi-package))
                   (version (project-info-version info))
                   (url     (distribution-url
-                            (latest-source-release pypi-package))))
+                            (source-release pypi-package))))
              (upstream-source
               (urls (list url))
               (input-changes
diff --git a/guix/scripts/import/pypi.scm b/guix/scripts/import/pypi.scm
index 9170a0b359..a52cd95c93 100644
--- a/guix/scripts/import/pypi.scm
+++ b/guix/scripts/import/pypi.scm
@@ -27,6 +27,7 @@ (define-module (guix scripts import pypi)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-37)
+  #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:export (guix-import-pypi))
@@ -83,21 +84,22 @@ (define (parse-options)
                             (_ #f))
                            (reverse opts))))
     (match args
-      ((package-name)
-       (if (assoc-ref opts 'recursive)
-           ;; Recursive import
-           (map (match-lambda
-                  ((and ('package ('name name) . rest) pkg)
-                   `(define-public ,(string->symbol name)
-                      ,pkg))
-                  (_ #f))
-                (pypi-recursive-import package-name))
-           ;; Single import
-           (let ((sexp (pypi->guix-package package-name)))
-             (unless sexp
-               (leave (G_ "failed to download meta-data for package '~a'~%")
-                      package-name))
-             sexp)))
+      ((spec)
+       (let ((name version (package-name->name+version spec)))
+         (if (assoc-ref opts 'recursive)
+             ;; Recursive import
+             (map (match-lambda
+                    ((and ('package ('name name) . rest) pkg)
+                     `(define-public ,(string->symbol name)
+                        ,pkg))
+                    (_ #f))
+                  (pypi-recursive-import name version))
+             ;; Single import
+             (let ((sexp (pypi->guix-package name #:version version)))
+               (unless sexp
+                 (leave (G_ "failed to download meta-data for package '~a'~%")
+                        name))
+               sexp))))
       (()
        (leave (G_ "too few arguments~%")))
       ((many ...)
diff --git a/tests/pypi.scm b/tests/pypi.scm
index 70f4298a90..ad869ac31f 100644
--- a/tests/pypi.scm
+++ b/tests/pypi.scm
@@ -260,9 +260,15 @@ (define test-metadata-with-extras-jedi "\
                      ('synopsis "summary")
                      ('description "summary")
                      ('license 'license:lgpl2.0))
-                   (string=? (bytevector->nix-base32-string
-                              test-source-hash)
-                             hash))
+                   (and (string=? (bytevector->nix-base32-string
+                                   test-source-hash)
+                                  hash)
+                        (equal? (pypi->guix-package "foo" #:version "1.0.0")
+                                (pypi->guix-package "foo"))
+                        (catch 'quit
+                          (lambda ()
+                            (pypi->guix-package "foo" #:version "42"))
+                          (const #t))))
                   (x
                    (pk 'fail x #f))))))
 
-- 
2.33.0

[bug#51493] [PATCH 2/5] import: cran: Allow imports of a specific version.

[Ludovic Courtès]

* guix/import/cran.scm (download): Handle the case where URL is a list.
(fetch-description-from-tarball): New procedure.
(fetch-description): Add #:version parameter.  Honor it when REPOSITORY
is 'cran.  Use 'fetch-description-from-tarball' when REPOSITORY is
'bioconductor.
(description->package): SOURCE-URL may now be a list.
(cran->guix-package): Pass VERSION to 'fetch-description'.
(cran-recursive-import): Add #:version parameter.
* guix/scripts/import/cran.scm (guix-import-cran): Expect a spec rather
than a mere package name.
* doc/guix.texi (Invoking guix import): Document it.
---
 doc/guix.texi                |  6 +++
 guix/import/cran.scm         | 89 +++++++++++++++++++++++-------------
 guix/scripts/import/cran.scm | 35 +++++++-------
 3 files changed, 83 insertions(+), 47 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index b742a4808a..7645f6f01a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11833,6 +11833,12 @@ The command command below imports metadata for the Cairo R package:
 guix import cran Cairo
 @end example
 
+You can also ask for a specific version:
+
+@example
+guix import cran rasterVis@@0.50.3
+@end example
+
 When @option{--recursive} is added, the importer will traverse the
 dependency graph of the given upstream package recursively and generate
 package expressions for all those packages that are not yet in Guix.
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 5f5f73cbf4..22fae5d7cb 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -229,26 +229,61 @@ (define download
                 (let ((store-directory
                        (add-to-store store (basename url) #t "sha256" dir)))
                   (values store-directory changeset)))))))
-        (else (download-to-store store url)))))))
+        (else
+         (match url
+           ((? string?)
+            (download-to-store store url))
+           ((urls ...)
+            ;; Try all the URLs.  A use case where this is useful is when one
+            ;; of the URLs is the /Archive CRAN URL.
+            (any (cut download-to-store store <>) urls)))))))))
 
-(define (fetch-description repository name)
+(define (fetch-description-from-tarball url)
+  "Fetch the tarball at URL, extra its 'DESCRIPTION' file, parse it, and
+return the resulting alist."
+  (match (download url)
+    (#f #f)
+    (tarball
+     (call-with-temporary-directory
+      (lambda (dir)
+        (parameterize ((current-error-port (%make-void-port "rw+"))
+                       (current-output-port (%make-void-port "rw+")))
+          (and (zero? (system* "tar" "--wildcards" "-x"
+                               "--strip-components=1"
+                               "-C" dir
+                               "-f" tarball "*/DESCRIPTION"))
+               (description->alist
+                (call-with-input-file (string-append dir "/DESCRIPTION")
+                  read-string)))))))))
+
+(define* (fetch-description repository name #:optional version)
   "Return an alist of the contents of the DESCRIPTION file for the R package
-NAME in the given REPOSITORY, or #f in case of failure.  NAME is
+NAME at VERSION in the given REPOSITORY, or #f in case of failure.  NAME is
 case-sensitive."
   (case repository
     ((cran)
-     (let ((url (string-append %cran-url name "/DESCRIPTION")))
-       (guard (c ((http-get-error? c)
-                  (warning (G_ "failed to retrieve package information \
+     (guard (c ((http-get-error? c)
+                (warning (G_ "failed to retrieve package information \
 from ~a: ~a (~a)~%")
-                           (uri->string (http-get-error-uri c))
-                           (http-get-error-code c)
-                           (http-get-error-reason c))
-                  #f))
-         (let* ((port   (http-fetch url))
-                (result (description->alist (read-string port))))
-           (close-port port)
-           result))))
+                         (uri->string (http-get-error-uri c))
+                         (http-get-error-code c)
+                         (http-get-error-reason c))
+                #f))
+       ;; When VERSION is true, we have to download the tarball to get at its
+       ;; 'DESCRIPTION' file; only the latest one is directly accessible over
+       ;; HTTP.
+       (if version
+           (let ((urls (list (string-append "mirror://cran/src/contrib/"
+                                            name "_" version ".tar.gz")
+                             (string-append "mirror://cran/src/contrib/Archive/"
+                                            name "/"
+                                            name "_" version ".tar.gz"))))
+             (fetch-description-from-tarball urls))
+           (let* ((url    (string-append %cran-url name "/DESCRIPTION"))
+                  (port   (http-fetch url))
+                  (result (description->alist (read-string port))))
+             (close-port port)
+             result))))
     ((bioconductor)
      ;; Currently, the bioconductor project does not offer a way to access a
      ;; package's DESCRIPTION file over HTTP, so we determine the version,
@@ -257,22 +292,13 @@ (define (fetch-description repository name)
                           (and (latest-bioconductor-package-version name) #t)
                           (and (latest-bioconductor-package-version name 'annotation) 'annotation)
                           (and (latest-bioconductor-package-version name 'experiment) 'experiment)))
+                ;; TODO: Honor VERSION.
                 (version (latest-bioconductor-package-version name type))
                 (url     (car (bioconductor-uri name version type)))
-                (tarball (download url)))
-       (call-with-temporary-directory
-        (lambda (dir)
-          (parameterize ((current-error-port (%make-void-port "rw+"))
-                         (current-output-port (%make-void-port "rw+")))
-            (and (zero? (system* "tar" "--wildcards" "-x"
-                                 "--strip-components=1"
-                                 "-C" dir
-                                 "-f" tarball "*/DESCRIPTION"))
-                 (and=> (description->alist (with-input-from-file
-                                                (string-append dir "/DESCRIPTION") read-string))
-                        (lambda (meta)
-                          (if (boolean? type) meta
-                              (cons `(bioconductor-type . ,type) meta))))))))))
+                (meta    (fetch-description-from-tarball url)))
+       (if (boolean? type)
+           meta
+           (cons `(bioconductor-type . ,type) meta))))
     ((git)
      (and (string-prefix? "http" name)
           ;; Download the git repository at "NAME"
@@ -485,7 +511,7 @@ (define (description->package repository meta)
                                         ((bioconductor)
                                          (list (assoc-ref meta 'bioconductor-type)))
                                         (else '())))
-                          ((url rest ...) url)
+                          ((urls ...) urls)
                           ((? string? url) url)
                           (_ #f)))))
          (git?       (assoc-ref meta 'git))
@@ -592,7 +618,7 @@ (define cran->guix-package
    (lambda* (package-name #:key (repo 'cran) version)
      "Fetch the metadata for PACKAGE-NAME from REPO and return the `package'
 s-expression corresponding to that package, or #f on failure."
-     (let ((description (fetch-description repo package-name)))
+     (let ((description (fetch-description repo package-name version)))
        (if description
            (description->package repo description)
            (case repo
@@ -610,8 +636,9 @@ (define cran->guix-package
                       (&message
                        (message "couldn't find meta-data for R package")))))))))))
 
-(define* (cran-recursive-import package-name #:key (repo 'cran))
+(define* (cran-recursive-import package-name #:key (repo 'cran) version)
   (recursive-import package-name
+                    #:version version
                     #:repo repo
                     #:repo->guix-package cran->guix-package
                     #:guix-name cran-guix-name))
diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm
index 3e4b038cc4..2934d4300a 100644
--- a/guix/scripts/import/cran.scm
+++ b/guix/scripts/import/cran.scm
@@ -27,8 +27,8 @@ (define-module (guix scripts import cran)
   #:use-module (guix import utils)
   #:use-module (guix scripts import)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-37)
+  #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:export (guix-import-cran))
@@ -98,21 +98,24 @@ (define (parse-options)
                            (reverse opts))))
     (parameterize ((%input-style (assoc-ref opts 'style)))
       (match args
-        ((package-name)
-         (if (assoc-ref opts 'recursive)
-             ;; Recursive import
-             (with-error-handling
-               (map package->definition
-                    (filter identity
-                            (cran-recursive-import package-name
-                                                   #:repo (or (assoc-ref opts 'repo) 'cran)))))
-             ;; Single import
-             (let ((sexp (cran->guix-package package-name
-                                             #:repo (or (assoc-ref opts 'repo) 'cran))))
-               (unless sexp
-                 (leave (G_ "failed to download description for package '~a'~%")
-                        package-name))
-               sexp)))
+        ((spec)
+         (let ((name version (package-name->name+version spec)))
+           (if (assoc-ref opts 'recursive)
+               ;; Recursive import
+               (with-error-handling
+                 (map package->definition
+                      (filter identity
+                              (cran-recursive-import name
+                                                     #:version version
+                                                     #:repo (or (assoc-ref opts 'repo) 'cran)))))
+               ;; Single import
+               (let ((sexp (cran->guix-package name
+                                               #:version version
+                                               #:repo (or (assoc-ref opts 'repo) 'cran))))
+                 (unless sexp
+                   (leave (G_ "failed to download description for package '~a'~%")
+                          name))
+                 sexp))))
         (()
          (leave (G_ "too few arguments~%")))
         ((many ...)
-- 
2.33.0

[bug#51493] [PATCH 3/5] import: print: Properly render packages with origins as inputs.

[Ludovic Courtès]

* guix/import/print.scm (package->code)[source->code]: Check whether
VERSION is true before calling 'factorize-uri'.
[package-lists->code]: Add clause for inputs that are origins.
* tests/print.scm (pkg-with-origin-input, pkg-with-origin-input-source):
New variables.
("package with origin input"): New test.
---
 guix/import/print.scm | 14 +++++++++-----
 tests/print.scm       | 28 ++++++++++++++++++++++++++++
 2 files changed, 37 insertions(+), 5 deletions(-)

diff --git a/guix/import/print.scm b/guix/import/print.scm
index 0310739b3a..8acf5d52f6 100644
--- a/guix/import/print.scm
+++ b/guix/import/print.scm
@@ -89,9 +89,11 @@ (define (source->code source version)
                              (guix hg-download)
                              (guix svn-download)))
                       (procedure-name method)))
-         (uri (string-append ,@(match (factorize-uri uri version)
-                                 ((? string? uri) (list uri))
-                                 (factorized factorized))))
+         (uri ,(if version
+                   `(string-append ,@(match (factorize-uri uri version)
+                                       ((? string? uri) (list uri))
+                                       (factorized factorized)))
+                   uri))
          ,(if (equal? (content-hash-algorithm hash) 'sha256)
               `(sha256 (base32 ,(bytevector->nix-base32-string
                                  (content-hash-value hash))))
@@ -109,7 +111,7 @@ (define (package-lists->code lsts)
           (map (match-lambda
                  ((? symbol? s)
                   (list (symbol->string s) (list 'unquote s)))
-                 ((label pkg . out)
+                 ((label (? package? pkg) . out)
                   (let ((mod (package-module-name pkg)))
                     (cons* label
                            ;; FIXME: using '@ certainly isn't pretty, but it
@@ -117,7 +119,9 @@ (define (package-lists->code lsts)
                            ;; modules.
                            (list 'unquote
                                  (list '@ mod (variable-name pkg mod)))
-                           out))))
+                           out)))
+                 ((label (? origin? origin))
+                  (list label (list 'unquote (source->code origin #f)))))
                lsts)))
 
   (let ((name                (package-name package))
diff --git a/tests/print.scm b/tests/print.scm
index 3386590d3a..ad19f4573a 100644
--- a/tests/print.scm
+++ b/tests/print.scm
@@ -67,6 +67,30 @@ (define-with-source pkg-with-inputs pkg-with-inputs-source
     (description "This is a dummy package.")
     (license license:gpl3+)))
 
+(define-with-source pkg-with-origin-input pkg-with-origin-input-source
+  (package
+    (name "test")
+    (version "1.2.3")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append "file:///tmp/test-"
+                                  version ".tar.gz"))
+              (sha256
+               (base32
+                "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))))
+    (build-system (@ (guix build-system gnu) gnu-build-system))
+    (inputs
+     `(("o" ,(origin
+               (method url-fetch)
+               (uri "http://example.org/somefile.txt")
+               (sha256
+                (base32
+                 "0000000000000000000000000000000000000000000000000000"))))))
+    (home-page "http://gnu.org")
+    (synopsis "Dummy")
+    (description "This is a dummy package.")
+    (license license:gpl3+)))
+
 (test-equal "simple package"
   `(define-public test ,pkg-source)
   (package->code pkg))
@@ -75,4 +99,8 @@ (define-with-source pkg-with-inputs pkg-with-inputs-source
   `(define-public test ,pkg-with-inputs-source)
   (package->code pkg-with-inputs))
 
+(test-equal "package with origin input"
+  `(define-public test ,pkg-with-origin-input-source)
+  (package->code pkg-with-origin-input))
+
 (test-end "print")
-- 
2.33.0

[bug#51493] [PATCH 4/5] import: print: Correctly handle URI lists.

[Ludovic Courtès]

* guix/import/print.scm (package->code)[factorized-uri-code]: New
procedure.
[source->code]: Use it, and factorize URI when it's a list.
* tests/print.scm (pkg-with-origin-input): Check origin URI to a list.
---
 guix/import/print.scm | 15 ++++++++++++---
 tests/print.scm       |  6 ++++--
 2 files changed, 16 insertions(+), 5 deletions(-)

diff --git a/guix/import/print.scm b/guix/import/print.scm
index 8acf5d52f6..4e65d18bc3 100644
--- a/guix/import/print.scm
+++ b/guix/import/print.scm
@@ -25,6 +25,7 @@ (define-module (guix import print)
   #:use-module (guix build-system)
   #:use-module (gnu packages)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:use-module (guix import utils)
   #:use-module (ice-9 control)
   #:use-module (ice-9 match)
@@ -72,6 +73,11 @@ (define (search-path-specification->code spec)
       (file-type (quote ,(search-path-specification-file-type spec)))
       (file-pattern ,(search-path-specification-file-pattern spec))))
 
+  (define (factorized-uri-code uri version)
+    (match (factorize-uri uri version)
+      ((? string? uri) uri)
+      ((factorized ...) `(string-append ,@factorized))))
+
   (define (source->code source version)
     (let ((uri       (origin-uri source))
           (method    (origin-method source))
@@ -90,9 +96,12 @@ (define (source->code source version)
                              (guix svn-download)))
                       (procedure-name method)))
          (uri ,(if version
-                   `(string-append ,@(match (factorize-uri uri version)
-                                       ((? string? uri) (list uri))
-                                       (factorized factorized)))
+                   (match uri
+                     ((? string? uri)
+                      (factorized-uri-code uri version))
+                     ((lst ...)
+                      `(list
+                        ,@(map (cut factorized-uri-code <> version) uri))))
                    uri))
          ,(if (equal? (content-hash-algorithm hash) 'sha256)
               `(sha256 (base32 ,(bytevector->nix-base32-string
diff --git a/tests/print.scm b/tests/print.scm
index ad19f4573a..7f4c8ccdd1 100644
--- a/tests/print.scm
+++ b/tests/print.scm
@@ -73,8 +73,10 @@ (define-with-source pkg-with-origin-input pkg-with-origin-input-source
     (version "1.2.3")
     (source (origin
               (method url-fetch)
-              (uri (string-append "file:///tmp/test-"
-                                  version ".tar.gz"))
+              (uri (list (string-append "file:///tmp/test-"
+                                        version ".tar.gz")
+                         (string-append "http://example.org/test-"
+                                        version ".tar.gz")))
               (sha256
                (base32
                 "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))))
-- 
2.33.0

[bug#51493] [PATCH 5/5] import: print: Handle patches that are origins.

[Ludovic Courtès]

* guix/import/print.scm (package->code)[source->code]: Handle patches
that are origins.
* tests/print.scm (pkg-with-origin-input): Add 'patches' field.
(pkg-with-origin-patch, pkg-with-origin-patch-source): New variables.
("package with origin patch"): New test.
---
 guix/import/print.scm | 13 +++++++++++--
 tests/print.scm       | 33 ++++++++++++++++++++++++++++++++-
 2 files changed, 43 insertions(+), 3 deletions(-)

diff --git a/guix/import/print.scm b/guix/import/print.scm
index 4e65d18bc3..e04a6647b4 100644
--- a/guix/import/print.scm
+++ b/guix/import/print.scm
@@ -112,8 +112,17 @@ (define (source->code source version)
          ;; FIXME: in order to be able to throw away the directory prefix,
          ;; we just assume that the patch files can be found with
          ;; "search-patches".
-         ,@(if (null? patches) '()
-               `((patches (search-patches ,@(map basename patches))))))))
+         ,@(cond ((null? patches)
+                  '())
+                 ((every string? patches)
+                  `((patches (search-patches ,@(map basename patches)))))
+                 (else
+                  `((patches (list ,@(map (match-lambda
+                                            ((? string? file)
+                                             `(search-patch ,file))
+                                            ((? origin? origin)
+                                             (source->code origin #f)))
+                                          patches)))))))))
 
   (define (package-lists->code lsts)
     (list 'quasiquote
diff --git a/tests/print.scm b/tests/print.scm
index 7f4c8ccdd1..ff0db469ab 100644
--- a/tests/print.scm
+++ b/tests/print.scm
@@ -22,6 +22,7 @@ (define-module (test-print)
   #:use-module (guix download)
   #:use-module (guix packages)
   #:use-module ((guix licenses) #:prefix license:)
+  #:use-module ((gnu packages) #:select (search-patches))
   #:use-module (srfi srfi-64))
 
 (define-syntax-rule (define-with-source object source expr)
@@ -79,7 +80,9 @@ (define-with-source pkg-with-origin-input pkg-with-origin-input-source
                                         version ".tar.gz")))
               (sha256
                (base32
-                "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))))
+                "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))
+              (patches (search-patches "guile-linux-syscalls.patch"
+                                       "guile-relocatable.patch"))))
     (build-system (@ (guix build-system gnu) gnu-build-system))
     (inputs
      `(("o" ,(origin
@@ -93,6 +96,30 @@ (define-with-source pkg-with-origin-input pkg-with-origin-input-source
     (description "This is a dummy package.")
     (license license:gpl3+)))
 
+(define-with-source pkg-with-origin-patch pkg-with-origin-patch-source
+  (package
+    (name "test")
+    (version "1.2.3")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append "file:///tmp/test-"
+                                  version ".tar.gz"))
+              (sha256
+               (base32
+                "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))
+              (patches
+               (list (origin
+                       (method url-fetch)
+                       (uri "http://example.org/x.patch")
+                       (sha256
+                        (base32
+                         "0000000000000000000000000000000000000000000000000000")))))))
+    (build-system (@ (guix build-system gnu) gnu-build-system))
+    (home-page "http://gnu.org")
+    (synopsis "Dummy")
+    (description "This is a dummy package.")
+    (license license:gpl3+)))
+
 (test-equal "simple package"
   `(define-public test ,pkg-source)
   (package->code pkg))
@@ -105,4 +132,8 @@ (define-with-source pkg-with-origin-input pkg-with-origin-input-source
   `(define-public test ,pkg-with-origin-input-source)
   (package->code pkg-with-origin-input))
 
+(test-equal "package with origin patch"
+  `(define-public test ,pkg-with-origin-patch-source)
+  (package->code pkg-with-origin-patch))
+
 (test-end "print")
-- 
2.33.0

bug#51493: [PATCH 0/5] Improvements to the pypi, cran, and "print" importers

[Ludovic Courtès]

Ludovic Courtès <ludo@gnu.org> skribis:

>   import: pypi: Allow imports of a specific version.
>   import: cran: Allow imports of a specific version.
>   import: print: Properly render packages with origins as inputs.
>   import: print: Correctly handle URI lists.
>   import: print: Handle patches that are origins.

Pushed as b2ed40c29f578d46d42cb1c5e99bd797cea3aba0, topped with this
extra commit in the same vein:

  3756ce3267 import: print: Replace packages and origins in 'arguments'.

I’ll have to take care of the merge conflicts with ‘core-updates-frozen’
in print.scm…

Ludo’.

[bug#51493] [PATCH 1/5] import: pypi: Allow imports of a specific version.

[zimoun]

Hi Ludo,

I am late to the party.  I just have one bikeshedding question about
double ’@’ for specifying the version…

On Fri, 29 Oct 2021 at 23:35, Ludovic Courtès <ludo@gnu.org> wrote:

> +You can also ask for a specific version:
> +
> +@example
> +guix import pypi itsdangerous@@1.1.0
> +@end example

…as here.  Is doubling ’@’ mandatory for technical reasons?  Because
usually, Guix uses simple ’@’ when referring to a specific version.

BTW, patch#51545 [1] adds similar features for egg importer.

1: <http://issues.guix.gnu.org/issue/51545>

Cheers,
simon

[bug#51493] [PATCH 1/5] import: pypi: Allow imports of a specific version.

[Tobias Geerinckx-Rice via Guix-patches via]

Simon,

On 2021-11-12 11:18, zimoun wrote:
> …as here.  Is doubling ’@’ mandatory for technical reasons?  Because
> usually, Guix uses simple ’@’ when referring to a specific version.

@ is special in Texinfo:

>> @example

'@@' encodes a literal '@'.

Kind regards,

T G-R

Sent from a Web browser.  Excuse or enjoy my brevity.

[bug#51493] [PATCH 1/5] import: pypi: Allow imports of a specific version.

[zimoun]

Re,

On Fri, 12 Nov 2021 at 11:50, Tobias Geerinckx-Rice <me@tobias.gr> wrote:

> @ is special in Texinfo:

Rah, obviously!  Sorry for the noise.

Cheers,
simon