Merge branch 'staging' into core-updates.

1 files changed, 55 insertions, 25 deletions

diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index b4284f5c33..77b5f12f72 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 David Thompson <davet@gnu.org>
 ;;; Copyright © 2015 Cyril Roelandt <tipecaml@gmail.com>
-;;; Copyright © 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015-2017, 2019-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
@@ -11,6 +11,8 @@
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
+;;; Copyright © 2022 Vivien Kraus <vivien@planete-kraus.eu>
+;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -41,6 +43,7 @@
   #: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)
@@ -59,6 +62,7 @@
             specification->requirement-name
             guix-package->pypi-name
             pypi-recursive-import
+            find-project-url
             pypi->guix-package
             %pypi-updater))
 
@@ -418,6 +422,24 @@ return the unaltered list of upstream dependency names."
     (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_ "project name ~a does not appear verbatim in the PyPI URI~%")
+         name)
+        (display-hint
+         (format #f (G_ "The PyPI URI is: @url{~a}.  You should review the
+pypi-uri declaration in the generated package. You may need to replace ~s with
+a substring of the PyPI URI that identifies the package.")  pypi-url name))
+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 +468,7 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
                     (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
@@ -483,21 +497,37 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
      (let* ((project (pypi-fetch package-name))
             (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) version))))
-              (make-pypi-sexp (project-info-name info) version
-                              (and=> (source-release project version)
-                                     distribution-url)
-                              (and=> (wheel-release project version)
-                                     distribution-url)
-                              (project-info-home-page info)
-                              (project-info-summary info)
-                              (project-info-summary info)
-                              (string->license
-                               (project-info-license info)))))))))
+       (if project
+           (guard (c ((missing-source-error? c)
+                      (let ((package (missing-source-error-package c)))
+                        (raise
+                         (apply
+                          make-compound-condition
+                          (formatted-message
+                           (G_ "no source release for pypi package ~a ~a~%")
+                           (project-info-name info) version)
+                          (match (project-info-home-page info)
+                            ((or #f "") '())
+                            (url
+                             (list
+                              (condition
+                               (&fix-hint
+                                (hint (format #f (G_ "This indicates that the
+package is available on PyPI, but only as a \"wheel\" containing binaries, not
+source.  To build it from source, refer to the upstream repository at
+@uref{~a}.")
+                                              url))))))))))))
+             (make-pypi-sexp (project-info-name info) version
+                             (and=> (source-release project version)
+                                    distribution-url)
+                             (and=> (wheel-release project version)
+                                    distribution-url)
+                             (project-info-home-page info)
+                             (project-info-summary info)
+                             (project-info-summary info)
+                             (string->license
+                              (project-info-license info))))
+           (values #f '()))))))
 
 (define* (pypi-recursive-import package-name #:optional version)
   (recursive-import package-name