From 3e7cfd8b2c3a76ab8aac82a7d2f2a9f3e1a5139d Mon Sep 17 00:00:00 2001
From: Vivien Kraus <vivien@planete-kraus.eu>
Date: Thu, 20 Jan 2022 20:11:56 +0100
Subject: [PATCH] pypi importer: Convert - to _ in pypi urls if needed.

* guix/import/pypi.scm (find-project-url): New function.
(make-pypi-sexp): Use find-project-url.
* tests/pypi.scm ("Package Foo has a correct pypi-uri of foo"): New test.
("If the package goo is released as foo, the importer warns"): New test.
---
 guix/import/pypi.scm |  30 ++++++---
 tests/pypi.scm       | 150 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 171 insertions(+), 9 deletions(-)

diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index b4284f5c33..3839c37a95 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -41,6 +41,7 @@ (define-module (guix import pypi)
   #:use-module (guix memoization)
   #:use-module (guix diagnostics)
   #:use-module (guix i18n)
+  #:use-module ((guix ui) #:select (display-hint))
   #:use-module ((guix build utils)
                 #:select ((package-name->name+version
                            . hyphen-package-name->name+version)
@@ -418,6 +419,25 @@ (define process-requirements
     (values (map process-requirements dependencies)
             (concatenate dependencies))))
 
+(define (find-project-url name pypi-url)
+  "Try different project name substitution until the result is found in
+pypi-uri.  Downcase is required for \"uWSGI\", and
+underscores are required for flake8-array-spacing."
+  (or (find (cut string-contains pypi-url <>)
+            (list name
+                  (string-downcase name)
+                  (string-replace-substring name "-" "_")))
+      (begin
+        (warning
+         (G_ "The project name does not appear verbatim in the pypi URI~%"))
+        (display-hint
+         (format #f (G_ "The project name is: @strong{~a}") name))
+        (display-hint
+         (format #f (G_ "The pypi URI is: @strong{@url{~a}}") pypi-url))
+        (display-hint
+         (G_ "The pypi-uri declaration in the generated package might need to be changed."))
+        name)))
+
 (define (make-pypi-sexp name version source-url wheel-url home-page synopsis
                         description license)
   "Return the `package' s-expression for a python package with the given NAME,
@@ -446,15 +466,7 @@ (define (maybe-upstream-name name)
                     (origin
                       (method url-fetch)
                       (uri (pypi-uri
-                             ;; PyPI URL are case sensitive, but sometimes
-                             ;; a project named using mixed case has a URL
-                             ;; using lower case, so we must work around this
-                             ;; inconsistency.  For actual examples, compare
-                             ;; the URLs of the "Deprecated" and "uWSGI" PyPI
-                             ;; packages.
-                             ,(if (string-contains source-url name)
-                                  name
-                                  (string-downcase name))
+                             ,(find-project-url name source-url)
                              version
                              ;; Some packages have been released as `.zip`
                              ;; instead of the more common `.tar.gz`. For
diff --git a/tests/pypi.scm b/tests/pypi.scm
index 1ea5f02643..b0aff2f0a1 100644
--- a/tests/pypi.scm
+++ b/tests/pypi.scm
@@ -23,10 +23,12 @@ (define-module (test-pypi)
   #:use-module (guix import pypi)
   #:use-module (guix base32)
   #:use-module (guix memoization)
+  #:use-module (guix utils)
   #:use-module (gcrypt hash)
   #:use-module (guix tests)
   #:use-module (guix build-system python)
   #:use-module ((guix build utils) #:select (delete-file-recursively which mkdir-p))
+  #:use-module ((guix diagnostics) #:select (guix-warning-port))
   #:use-module (srfi srfi-64)
   #:use-module (ice-9 match))
 
@@ -428,4 +430,152 @@ (define test-metadata-with-extras-jedi "\
                 (x
                  (pk 'fail x #f))))))
 
+(test-equal "Package Foo has a correct pypi-uri of foo"
+  ""
+  (call-with-output-string
+    (lambda (port)
+      (parameterize ((guix-warning-port port))
+        ;; Replace network resources with sample data.
+        (mock ((guix import utils) url-fetch
+               (lambda (url file-name)
+                 (match url
+                   ("https://example.com/foo-1.0.0.tar.gz"
+                    (begin
+                      (mkdir-p "foo-1.0.0/foo.egg-info")
+                      (with-output-to-file "foo-1.0.0/foo.egg-info/requires.txt"
+                        (lambda ()
+                          (display test-requires.txt)))
+                      (parameterize ((current-output-port (%make-void-port "rw+")))
+                        (system* "tar" "czvf" file-name "foo-1.0.0/"))
+                      (delete-file-recursively "foo-1.0.0")))
+                   ("https://example.com/foo-1.0.0-py2.py3-none-any.whl"
+                    (begin
+                      (mkdir "foo-1.0.0.dist-info")
+                      (with-output-to-file "foo-1.0.0.dist-info/METADATA"
+                        (lambda ()
+                          (display test-metadata)))
+                      (let ((zip-file (string-append file-name ".zip")))
+                        ;; zip always adds a "zip" extension to the file it creates,
+                        ;; so we need to rename it.
+                        (system* "zip" "-q" zip-file "foo-1.0.0.dist-info/METADATA")
+                        (rename-file zip-file file-name))
+                      (delete-file-recursively "foo-1.0.0.dist-info")))
+                   (_ (error "Unexpected URL: " url)))))
+              (mock ((guix http-client) http-fetch
+                     (lambda (url . rest)
+                       (match url
+                         ;; Note the Foo capitalization in the project URL
+                         ("https://pypi.org/pypi/Foo/json"
+                          ;; The document advertises the package name as "Foo"
+                          ;; too
+                          (let ((name-fixed
+                                 (string-replace-substring
+                                  test-json-1
+                                  "\"name\": \"foo\","
+                                  "\"name\": \"Foo\",")))
+                            (values (open-input-string name-fixed)
+                                    (string-length name-fixed))))
+                         ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f)
+                         (_ (error "Unexpected URL: " url)))))
+                    (match (pypi->guix-package "Foo")
+                      (('package
+                         ('name "python-foo") ;; Guix wants downcase package
+                                              ;; names
+                         ('version "1.0.0")
+                         ('source ('origin
+                                    ('method 'url-fetch)
+                                    ('uri ('pypi-uri "foo" 'version))
+                                    ('sha256
+                                     ('base32
+                                      (? string? hash)))))
+                         ('build-system 'python-build-system)
+                         ('propagated-inputs ('list 'python-bar 'python-baz))
+                         ('native-inputs ('list 'python-pytest))
+                         ('home-page "http://example.com")
+                         ('synopsis "summary")
+                         ('description "summary")
+                         ('license 'license:lgpl2.0))
+                       (string=? (bytevector->nix-base32-string
+                                  test-source-hash)
+                                 hash))
+                      (x
+                       (error "Failed: ~S" x)))))))))
+
+(test-equal "If the package goo is released as foo, the importer warns"
+  "warning: The project name does not appear verbatim in the pypi URI
+hint: The project name is: *goo*
+
+hint: The pypi URI is: *`https://example.com/foo-1.0.0.tar.gz'*
+
+hint: The pypi-uri declaration in the generated package might need to be changed.
+
+"
+  (call-with-output-string
+    (lambda (port)
+      (parameterize ((guix-warning-port port)
+                     (current-error-port port))
+        ;; Replace network resources with sample data.
+        (mock ((guix import utils) url-fetch
+               (lambda (url file-name)
+                 (match url
+                   ("https://example.com/foo-1.0.0.tar.gz"
+                    (begin
+                      (mkdir-p "foo-1.0.0/foo.egg-info")
+                      (with-output-to-file "foo-1.0.0/foo.egg-info/requires.txt"
+                        (lambda ()
+                          (display test-requires.txt)))
+                      (parameterize ((current-output-port (%make-void-port "rw+")))
+                        (system* "tar" "czvf" file-name "foo-1.0.0/"))
+                      (delete-file-recursively "foo-1.0.0")))
+                   ("https://example.com/foo-1.0.0-py2.py3-none-any.whl"
+                    (begin
+                      (mkdir "foo-1.0.0.dist-info")
+                      (with-output-to-file "foo-1.0.0.dist-info/METADATA"
+                        (lambda ()
+                          (display test-metadata)))
+                      (let ((zip-file (string-append file-name ".zip")))
+                        ;; zip always adds a "zip" extension to the file it creates,
+                        ;; so we need to rename it.
+                        (system* "zip" "-q" zip-file "foo-1.0.0.dist-info/METADATA")
+                        (rename-file zip-file file-name))
+                      (delete-file-recursively "foo-1.0.0.dist-info")))
+                   (_ (error "Unexpected URL: " url)))))
+              (mock ((guix http-client) http-fetch
+                     (lambda (url . rest)
+                       (match url
+                         ("https://pypi.org/pypi/goo/json"
+                          (let ((name-fixed ;; The true name of the package is
+                                            ;; "goo", only the releases are
+                                            ;; named foo-
+                                 (string-replace-substring
+                                  test-json-1
+                                  "\"name\": \"foo\","
+                                  "\"name\": \"goo\",")))
+                            (values (open-input-string name-fixed)
+                                    (string-length name-fixed))))
+                         ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f)
+                         (_ (error "Unexpected URL: " url)))))
+                    (match (pypi->guix-package "goo")
+                      (('package
+                         ('name "python-goo")
+                         ('version "1.0.0")
+                         ('source ('origin
+                                    ('method 'url-fetch)
+                                    ('uri ('pypi-uri "goo" 'version))
+                                    ('sha256
+                                     ('base32
+                                      (? string? hash)))))
+                         ('build-system 'python-build-system)
+                         ('propagated-inputs ('list 'python-bar 'python-baz))
+                         ('native-inputs ('list 'python-pytest))
+                         ('home-page "http://example.com")
+                         ('synopsis "summary")
+                         ('description "summary")
+                         ('license 'license:lgpl2.0))
+                       (string=? (bytevector->nix-base32-string
+                                  test-source-hash)
+                                 hash))
+                      (x
+                       (error "Failed: ~S" x)))))))))
+
 (test-end "pypi")
-- 
2.34.0

