[PATCH] import: pypi: read requirements from wheels.

[Cyril Roelandt]

* guix/import/pypi.scm (latest-wheel-release): New procedure.
---
 guix/import/pypi.scm | 116 +++++++++++++++++++++++++++++++++++++++------------
 tests/pypi.scm       |  74 ++++++++++++++++++++++++++++++++
 2 files changed, 163 insertions(+), 27 deletions(-)

diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index d54bb9f..0fea71a 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -72,6 +72,16 @@ or #f on failure."
         (raise (condition (&missing-source-error
                            (package pypi-package)))))))
 
+(define (latest-wheel-release 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-package "releases"
+                              (assoc-ref* pypi-package "info" "version"))))
+    (or (find (lambda (release)
+                (string=? "bdist_wheel" (assoc-ref release "packagetype")))
+              releases)
+        #f)))
+
 (define (python->package-name name)
   "Given the NAME of a package on PyPI, return a Guix-compliant name for the
 package."
@@ -89,6 +99,14 @@ package on PyPI."
     ;; '/' + package name + '/' + ...
     (substring source-url 42 (string-rindex source-url #\/))))
 
+(define (wheel-url->extracted-directory wheel-url)
+  (string-append
+   (string-join
+    (list-head
+     (string-split (last (string-split wheel-url #\/))  #\-) 2)
+    "-")
+   ".dist-info"))
+
 (define (maybe-inputs package-inputs)
   "Given a list of PACKAGE-INPUTS, tries to generate the 'inputs' field of a
 package definition."
@@ -98,10 +116,10 @@ package definition."
     ((package-inputs ...)
      `((inputs (,'quasiquote ,package-inputs))))))
 
-(define (guess-requirements source-url tarball)
-  "Given SOURCE-URL and a TARBALL of the package, return a list of the required
-packages specified in the requirements.txt file. TARBALL will be extracted in
-the current directory, and will be deleted."
+(define (guess-requirements source-url wheel-url tarball)
+  "Given SOURCE-URL, WHEEL-URL and a TARBALL of the package, return a list of
+the required packages specified in the requirements.txt file. TARBALL will be
+extracted in the current directory, and will be deleted."
 
   (define (tarball-directory url)
     ;; Given the URL of the package's tarball, return the name of the directory
@@ -148,26 +166,69 @@ cannot determine package dependencies"))
                   (loop (cons (python->package-name (clean-requirement line))
                               result))))))))))
 
-  (let ((dirname (tarball-directory source-url)))
-    (if (string? dirname)
-        (let* ((req-file (string-append dirname "/requirements.txt"))
-               (exit-code (system* "tar" "xf" tarball req-file)))
-          ;; TODO: support more formats.
-          (if (zero? exit-code)
-              (dynamic-wind
-                (const #t)
-                (lambda ()
-                  (read-requirements req-file))
-                (lambda ()
-                  (delete-file req-file)
-                  (rmdir dirname)))
-              (begin
-                (warning (_ "'tar xf' failed with exit code ~a\n")
-                         exit-code)
-                '())))
-        '())))
+  (define (read-wheel-metadata wheel-archive)
+    ;; Given WHEEL-ARCHIVE, a ZIP Python wheel archive, return the package's
+    ;; requirements.
+    (let* ((dirname (wheel-url->extracted-directory wheel-url))
+           (json-file (string-append dirname "/metadata.json")))
+      (and (system* "unzip" "-q" wheel-archive json-file)
+           (dynamic-wind
+             (const #t)
+             (lambda ()
+               (call-with-input-file json-file
+                 (lambda (port)
+                   (let* ((metadata (json->scm port))
+                          (run_requires (hash-ref metadata "run_requires"))
+                          (requirements (hash-ref (list-ref run_requires 0)
+                                                  "requires")))
+                     (map (lambda (r)
+                            (python->package-name (clean-requirement r)))
+                          requirements)))))
+             (lambda ()
+               (delete-file json-file)
+               (rmdir dirname))))))
+
+  (define (guess-requirements-from-wheel)
+    ;; Return the package's requirements using the wheel, or #f if an error
+    ;; occurs.
+    (call-with-temporary-output-file
+     (lambda (temp port)
+       (if wheel-url
+         (and (url-fetch wheel-url temp)
+              (read-wheel-metadata temp))
+         #f))))
+
+
+  (define (guess-requirements-from-source)
+    ;; Return the package's requirements by guessing them from the source.
+    (let ((dirname (tarball-directory source-url)))
+      (if (string? dirname)
+          (let* ((req-file (string-append dirname "/requirements.txt"))
+                 (exit-code (system* "tar" "xf" tarball req-file)))
+            ;; TODO: support more formats.
+            (if (zero? exit-code)
+                (dynamic-wind
+                  (const #t)
+                  (lambda ()
+                    (read-requirements req-file))
+                  (lambda ()
+                    (delete-file req-file)
+                    (rmdir dirname)))
+                (begin
+                  (warning (_ "'tar xf' failed with exit code ~a\n")
+                           exit-code)
+                  '())))
+          '())))
+
+  ;; First, try to compute the requirements using the wheel, since that is the
+  ;; most reliable option. If a wheel is not provided for this package, try
+  ;; getting them by reading the "requirements.txt" file from the source. Note
+  ;; that "requirements.txt" is not mandatory, so this is likely to fail.
+  (or (guess-requirements-from-wheel)
+      (guess-requirements-from-source)))
+
 
-(define (compute-inputs source-url tarball)
+(define (compute-inputs source-url wheel-url tarball)
   "Given the SOURCE-URL of an already downloaded TARBALL, return a list of
 name/variable pairs describing the required inputs of this package."
   (sort
@@ -176,13 +237,13 @@ name/variable pairs describing the required inputs of 
this package."
          (append '("python-setuptools")
                  ;; Argparse has been part of Python since 2.7.
                  (remove (cut string=? "python-argparse" <>)
-                         (guess-requirements source-url tarball))))
+                         (guess-requirements source-url wheel-url tarball))))
     (lambda args
       (match args
         (((a _ ...) (b _ ...))
          (string-ci<? a b))))))
 
-(define (make-pypi-sexp name version source-url home-page synopsis
+(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,
 VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
@@ -199,7 +260,7 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and 
LICENSE."
                         (base32
                          ,(guix-hash-url temp)))))
              (build-system python-build-system)
-             ,@(maybe-inputs (compute-inputs source-url temp))
+             ,@(maybe-inputs (compute-inputs source-url wheel-url temp))
              (home-page ,home-page)
              (synopsis ,synopsis)
              (description ,description)
@@ -218,11 +279,12 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, 
and LICENSE."
            (let ((name (assoc-ref* package "info" "name"))
                  (version (assoc-ref* package "info" "version"))
                  (release (assoc-ref (latest-source-release package) "url"))
+                 (wheel (assoc-ref (latest-wheel-release package) "url"))
                  (synopsis (assoc-ref* package "info" "summary"))
                  (description (assoc-ref* package "info" "summary"))
                  (home-page (assoc-ref* package "info" "home_page"))
                  (license (string->license (assoc-ref* package "info" 
"license"))))
-             (make-pypi-sexp name version release home-page synopsis
+             (make-pypi-sexp name version release wheel home-page synopsis
                              description license))))))
 
 (define (pypi-package? package)
diff --git a/tests/pypi.scm b/tests/pypi.scm
index 960b8cd..e89fd64 100644
--- a/tests/pypi.scm
+++ b/tests/pypi.scm
@@ -42,6 +42,9 @@
       }, {
         \"url\": \"https://example.com/foo-1.0.0.tar.gz\";,
         \"packagetype\": \"sdist\",
+      }, {
+        \"url\": \"https://example.com/foo-1.0.0-py2.py3-none-any.whl\";,
+        \"packagetype\": \"bdist_wheel\",
       }
     ]
   }
@@ -56,6 +59,18 @@
 bar
 baz > 13.37")
 
+(define test-metadata
+  "{
+  \"run_requires\": [
+    {
+      \"requires\": [
+        \"bar\",
+        \"baz (>13.37)\"
+      ]
+    }
+  ]
+}")
+
 (test-begin "pypi")
 
 (test-assert "pypi->guix-package"
@@ -77,6 +92,65 @@ baz > 13.37")
                  (delete-file-recursively "foo-1.0.0")
                  (set! test-source-hash
                        (call-with-input-file file-name port-sha256))))
+             ("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")
+         ('version "1.0.0")
+         ('source ('origin
+                    ('method 'url-fetch)
+                    ('uri (pypi-uri "foo" version))
+                    ('sha256
+                     ('base32
+                      (? string? hash)))))
+         ('build-system 'python-build-system)
+         ('inputs
+          ('quasiquote
+           (("python-bar" ('unquote 'python-bar))
+            ("python-baz" ('unquote 'python-baz))
+            ("python-setuptools" ('unquote 'python-setuptools)))))
+         ('home-page "http://example.com";)
+         ('synopsis "summary")
+         ('description "summary")
+         ('license 'lgpl2.0))
+       (string=? (bytevector->nix-base32-string
+                  test-source-hash)
+                 hash))
+      (x
+       (pk 'fail x #f)))))
+
+(test-assert "pypi->guix-package, wheels"
+  ;; Replace network resources with sample data.
+  (mock ((guix import utils) url-fetch
+         (lambda (url file-name)
+           (match url
+             ("https://pypi.python.org/pypi/foo/json";
+              (with-output-to-file file-name
+                (lambda ()
+                  (display test-json))))
+             ("https://example.com/foo-1.0.0.tar.gz";
+               (begin
+                 (mkdir "foo-1.0.0")
+                 (with-output-to-file "foo-1.0.0/requirements.txt"
+                   (lambda ()
+                     (display test-requirements)))
+                 (system* "tar" "czvf" file-name "foo-1.0.0/")
+                 (delete-file-recursively "foo-1.0.0")
+                 (set! test-source-hash
+                       (call-with-input-file file-name port-sha256))))
+             ("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.json"
+                   (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" zip-file "foo-1.0.0.dist-info/metadata.json")
+                   (rename-file zip-file file-name))
+                 (delete-file-recursively "foo-1.0.0.dist-info")))
              (_ (error "Unexpected URL: " url)))))
     (match (pypi->guix-package "foo")
       (('package
-- 
2.6.2