ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

import: pypi: Include optional test inputs as native-inputs.

Browse source 
* guix/import/pypi.scm (maybe-inputs): Add INPUT-TYPE argument, and use it.
(test-section?): New predicate.
(parse-requires.txt): Collect the optional test inputs, and return them as the
second element of the returned list.
(parse-wheel-metadata): Likewise.
(guess-requirements): Adapt.
(make-pypi-sexp): Likewise, and include the test inputs requirements as native
inputs in the returned package expression.

* tests/pypi.scm (test-requires.txt): Include a test section in the
test-requires.txt data.
(test-requires.txt-beaker): New variable.
("parse-requires.txt"): Adapt.
("parse-requires.txt - Beaker"): New test.
("parse-wheel-metadata, with extras"): Adapt.
("parse-wheel-metadata, with extras - Jedi"): Adapt.
("pypi->guix-package, no wheel"): Re-indent, and add the expected
native-inputs.
("pypi->guix-package, wheels"): Likewise.
This commit is contained in:
Maxim Cournoyer 2019-03-28 23:12:26 -04:00
parent f801c6215d
commit d514276b93
No known key found for this signature in database
GPG key ID: 1260E46482E63562
2 changed files with 166 additions and 90 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

177
guix/import/pypi.scm
View file

@ -4,6 +4,7 @@
;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -26,6 +27,7 @@ (define-module (guix import pypi)
#:use-module (ice-9 receive) #:use-module (ice-9 receive)
#:use-module ((ice-9 rdelim) #:select (read-line)) #:use-module ((ice-9 rdelim) #:select (read-line))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (srfi srfi-35) #:use-module (srfi srfi-35)
@ -107,14 +109,15 @@ (define (wheel-url->extracted-directory wheel-url)
((name version _ ...) ((name version _ ...)
(string-append name "-" version ".dist-info")))) (string-append name "-" version ".dist-info"))))
(define (maybe-inputs package-inputs) (define (maybe-inputs package-inputs input-type)
"Given a list of PACKAGE-INPUTS, tries to generate the 'inputs' field of a "Given a list of PACKAGE-INPUTS, tries to generate the 'inputs' field of a
package definition." package definition. INPUT-TYPE, a symbol, is used to populate the name of
the input field."
(match package-inputs (match package-inputs
(() (()
'()) '())
((package-inputs ...) ((package-inputs ...)
`((propagated-inputs (,'quasiquote ,package-inputs)))))) `((,input-type (,'quasiquote ,package-inputs))))))
(define %requirement-name-regexp (define %requirement-name-regexp
;; Regexp to match the requirement name in a requirement specification. ;; Regexp to match the requirement name in a requirement specification.
@ -154,9 +157,19 @@ (define (specification->requirement-name spec)
(or (regexp-exec %requirement-name-regexp spec) (or (regexp-exec %requirement-name-regexp spec)
(error (G_ "Could not extract requirement name in spec:") spec)))) (error (G_ "Could not extract requirement name in spec:") spec))))
(define (test-section? name)
"Return #t if the section name contains 'test' or 'dev'."
(any (cut string-contains-ci name <>)
'("test" "dev")))
(define (parse-requires.txt requires.txt) (define (parse-requires.txt requires.txt)
"Given REQUIRES.TXT, a Setuptools requires.txt file, return a list of "Given REQUIRES.TXT, a Setuptools requires.txt file, return a list of lists
requirement names." of requirements.
The first list contains the required dependencies while the second the
optional test dependencies. Note that currently, optional, non-test
dependencies are omitted since these can be difficult or expensive to
satisfy."
(define (comment? line) (define (comment? line)
;; Return #t if the given LINE is a comment, #f otherwise. ;; Return #t if the given LINE is a comment, #f otherwise.
@ -168,26 +181,49 @@ (define (section-header? line)
(call-with-input-file requires.txt (call-with-input-file requires.txt
(lambda (port) (lambda (port)
(let loop ((result '())) (let loop ((required-deps '())
(test-deps '())
(inside-test-section? #f)
(optional? #f))
(let ((line (read-line port))) (let ((line (read-line port)))
;; Stop when a section is encountered, as sections contain optional
;; (extra) requirements. Non-optional requirements must appear
;; before any section is defined.
(cond (cond
((or (eof-object? line) (section-header? line)) ((eof-object? line)
;; Duplicates can occur, since the same requirement can be ;; Duplicates can occur, since the same requirement can be
;; listed multiple times with different conditional markers, e.g. ;; listed multiple times with different conditional markers, e.g.
;; pytest >= 3 ; python_version >= "3.3" ;; pytest >= 3 ; python_version >= "3.3"
;; pytest < 3 ; python_version < "3.3" ;; pytest < 3 ; python_version < "3.3"
(reverse (delete-duplicates result))) (map (compose reverse delete-duplicates)
(list required-deps test-deps)))
((or (string-null? line) (comment? line)) ((or (string-null? line) (comment? line))
(loop result)) (loop required-deps test-deps inside-test-section? optional?))
(else ((section-header? line)
;; Encountering a section means that all the requirements
;; listed below are optional. Since we want to pick only the
;; test dependencies from the optional dependencies, we must
;; track those separately.
(loop required-deps test-deps (test-section? line) #t))
(inside-test-section?
(loop required-deps
(cons (specification->requirement-name line)
test-deps)
inside-test-section? optional?))
((not optional?)
(loop (cons (specification->requirement-name line) (loop (cons (specification->requirement-name line)
result))))))))) required-deps)
test-deps inside-test-section? optional?))
(optional?
;; Skip optional items.
(loop required-deps test-deps inside-test-section? optional?))
(else
(warning (G_ "parse-requires.txt reached an unexpected \
condition on line ~a~%") line))))))))
(define (parse-wheel-metadata metadata) (define (parse-wheel-metadata metadata)
"Given METADATA, a Wheel metadata file, return a list of requirement names." "Given METADATA, a Wheel metadata file, return a list of lists of
requirements.
Refer to the documentation of PARSE-REQUIRES.TXT for a description of the
returned value."
;; METADATA is a RFC-2822-like, header based file. ;; METADATA is a RFC-2822-like, header based file.
(define (requires-dist-header? line) (define (requires-dist-header? line)
@ -201,21 +237,29 @@ (define (extra? line)
;; Return #t if the given LINE is an "extra" requirement. ;; Return #t if the given LINE is an "extra" requirement.
(string-match "extra == '(.*)'" line)) (string-match "extra == '(.*)'" line))
(define (test-requirement? line)
(and=> (match:substring (extra? line) 1) test-section?))
(call-with-input-file metadata (call-with-input-file metadata
(lambda (port) (lambda (port)
(let loop ((requirements '())) (let loop ((required-deps '())
(test-deps '()))
(let ((line (read-line port))) (let ((line (read-line port)))
;; Stop at the first 'Provides-Extra' section: the non-optional
;; requirements appear before the optional ones.
(cond (cond
((eof-object? line) ((eof-object? line)
(reverse (delete-duplicates requirements))) (map (compose reverse delete-duplicates)
(list required-deps test-deps)))
((and (requires-dist-header? line) (not (extra? line))) ((and (requires-dist-header? line) (not (extra? line)))
(loop (cons (specification->requirement-name (loop (cons (specification->requirement-name
(requires-dist-value line)) (requires-dist-value line))
requirements))) required-deps)
test-deps))
((and (requires-dist-header? line) (test-requirement? line))
(loop required-deps
(cons (specification->requirement-name (requires-dist-value line))
test-deps)))
(else (else
(loop requirements)))))))) (loop required-deps test-deps)))))))) ;skip line
(define (guess-requirements source-url wheel-url archive) (define (guess-requirements source-url wheel-url archive)
"Given SOURCE-URL, WHEEL-URL and an ARCHIVE of the package, return a list "Given SOURCE-URL, WHEEL-URL and an ARCHIVE of the package, return a list
@ -268,37 +312,46 @@ (define (guess-requirements-from-source)
(() (()
(warning (G_ "Cannot guess requirements from source archive:\ (warning (G_ "Cannot guess requirements from source archive:\
no requires.txt file found.~%")) no requires.txt file found.~%"))
'()) (list '() '()))
(else (parse-requires.txt (first requires.txt-files))))))) (else (parse-requires.txt (first requires.txt-files)))))))
(begin (begin
(warning (G_ "Unsupported archive format; \ (warning (G_ "Unsupported archive format; \
cannot determine package dependencies from source archive: ~a~%") cannot determine package dependencies from source archive: ~a~%")
(basename source-url)) (basename source-url))
'()))) (list '() '()))))
;; First, try to compute the requirements using the wheel, else, fallback to ;; First, try to compute the requirements using the wheel, else, fallback to
;; reading the "requires.txt" from the egg-info directory from the source ;; reading the "requires.txt" from the egg-info directory from the source
;; tarball. ;; archive.
(or (guess-requirements-from-wheel) (or (guess-requirements-from-wheel)
(guess-requirements-from-source))) (guess-requirements-from-source)))
(define (compute-inputs source-url wheel-url archive) (define (compute-inputs source-url wheel-url archive)
"Given the SOURCE-URL of an already downloaded ARCHIVE, return a list of "Given the SOURCE-URL and WHEEL-URL of an already downloaded ARCHIVE, return
name/variable pairs describing the required inputs of this package. Also a pair of lists, each consisting of a list of name/variable pairs, for the
propagated inputs and the native inputs, respectively. Also
return the unaltered list of upstream dependency names." return the unaltered list of upstream dependency names."
(let ((dependencies
(remove (cut string=? "argparse" <>) (define (strip-argparse deps)
(guess-requirements source-url wheel-url archive)))) (remove (cut string=? "argparse" <>) deps))
(values (sort
(map (lambda (input) (define (requirement->package-name/sort deps)
(let ((guix-name (python->package-name input))) (sort
(list guix-name (list 'unquote (string->symbol guix-name))))) (map (lambda (input)
dependencies) (let ((guix-name (python->package-name input)))
(lambda args (list guix-name (list 'unquote (string->symbol guix-name)))))
(match args deps)
(((a _ ...) (b _ ...)) (lambda args
(string-ci<? a b))))) (match args
dependencies))) (((a _ ...) (b _ ...))
(string-ci<? a b))))))
(define process-requirements
(compose requirement->package-name/sort strip-argparse))
(let ((dependencies (guess-requirements source-url wheel-url archive)))
(values (map process-requirements dependencies)
(concatenate dependencies))))
(define (make-pypi-sexp name version source-url wheel-url home-page synopsis (define (make-pypi-sexp name version source-url wheel-url home-page synopsis
description license) description license)
@ -307,29 +360,31 @@ (define (make-pypi-sexp name version source-url wheel-url home-page synopsis
(call-with-temporary-output-file (call-with-temporary-output-file
(lambda (temp port) (lambda (temp port)
(and (url-fetch source-url temp) (and (url-fetch source-url temp)
(receive (input-package-names upstream-dependency-names) (receive (guix-dependencies upstream-dependencies)
(compute-inputs source-url wheel-url temp) (compute-inputs source-url wheel-url temp)
(values (match guix-dependencies
`(package ((required-inputs test-inputs)
(name ,(python->package-name name)) (values
(version ,version) `(package
(source (origin (name ,(python->package-name name))
(method url-fetch) (version ,version)
(source (origin
;; Sometimes 'pypi-uri' doesn't quite work due to mixed (method url-fetch)
;; cases in NAME, for instance, as is the case with ;; Sometimes 'pypi-uri' doesn't quite work due to mixed
;; "uwsgi". In that case, fall back to a full URL. ;; cases in NAME, for instance, as is the case with
(uri (pypi-uri ,(string-downcase name) version)) ;; "uwsgi". In that case, fall back to a full URL.
(sha256 (uri (pypi-uri ,(string-downcase name) version))
(base32 (sha256
,(guix-hash-url temp))))) (base32
(build-system python-build-system) ,(guix-hash-url temp)))))
,@(maybe-inputs input-package-names) (build-system python-build-system)
(home-page ,home-page) ,@(maybe-inputs required-inputs 'propagated-inputs)
(synopsis ,synopsis) ,@(maybe-inputs test-inputs 'native-inputs)
(description ,description) (home-page ,home-page)
(license ,(license->symbol license))) (synopsis ,synopsis)
upstream-dependency-names)))))) (description ,description)
(license ,(license->symbol license)))
upstream-dependencies))))))))
(define pypi->guix-package (define pypi->guix-package
(memoize (memoize

79
tests/pypi.scm
View file

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -68,11 +69,6 @@ (define test-specifications
(define test-requires.txt "\ (define test-requires.txt "\
# A comment # A comment
# A comment after a space # A comment after a space
bar
baz > 13.37
")
(define test-requires-with-sections "\
foo ~= 3 foo ~= 3
bar != 2 bar != 2
@ -80,12 +76,25 @@ (define test-requires-with-sections "\
pytest (>=2.5.0) pytest (>=2.5.0)
") ")
;; Beaker contains only optional dependencies.
(define test-requires.txt-beaker "\
[crypto]
pycryptopp>=0.5.12
[cryptography]
cryptography
[testsuite]
Mock
coverage
")
(define test-metadata "\ (define test-metadata "\
Classifier: Programming Language :: Python :: 3.7 Classifier: Programming Language :: Python :: 3.7
Requires-Dist: baz ~= 3 Requires-Dist: baz ~= 3
Requires-Dist: bar != 2 Requires-Dist: bar != 2
Provides-Extra: test Provides-Extra: test
pytest (>=2.5.0) Requires-Dist: pytest (>=2.5.0) ; extra == 'test'
") ")
(define test-metadata-with-extras " (define test-metadata-with-extras "
@ -139,25 +148,31 @@ (define test-metadata-with-extras-jedi "\
'("Fizzy" "PickyThing" "SomethingWithMarker" "requests" "pip") '("Fizzy" "PickyThing" "SomethingWithMarker" "requests" "pip")
(map specification->requirement-name test-specifications)) (map specification->requirement-name test-specifications))
(test-equal "parse-requires.txt, with sections" (test-equal "parse-requires.txt"
'("foo" "bar") (list '("foo" "bar") '("pytest"))
(mock ((ice-9 ports) call-with-input-file (mock ((ice-9 ports) call-with-input-file
call-with-input-string) call-with-input-string)
(parse-requires.txt test-requires-with-sections))) (parse-requires.txt test-requires.txt)))
(test-equal "parse-requires.txt - Beaker"
(list '() '("Mock" "coverage"))
(mock ((ice-9 ports) call-with-input-file
call-with-input-string)
(parse-requires.txt test-requires.txt-beaker)))
(test-equal "parse-wheel-metadata, with extras" (test-equal "parse-wheel-metadata, with extras"
'("wrapt" "bar") (list '("wrapt" "bar") '("tox" "bumpversion"))
(mock ((ice-9 ports) call-with-input-file (mock ((ice-9 ports) call-with-input-file
call-with-input-string) call-with-input-string)
(parse-wheel-metadata test-metadata-with-extras))) (parse-wheel-metadata test-metadata-with-extras)))
(test-equal "parse-wheel-metadata, with extras - Jedi" (test-equal "parse-wheel-metadata, with extras - Jedi"
'("parso") (list '("parso") '("pytest"))
(mock ((ice-9 ports) call-with-input-file (mock ((ice-9 ports) call-with-input-file
call-with-input-string) call-with-input-string)
(parse-wheel-metadata test-metadata-with-extras-jedi))) (parse-wheel-metadata test-metadata-with-extras-jedi)))
(test-assert "pypi->guix-package" (test-assert "pypi->guix-package, no wheel"
;; Replace network resources with sample data. ;; Replace network resources with sample data.
(mock ((guix import utils) url-fetch (mock ((guix import utils) url-fetch
(lambda (url file-name) (lambda (url file-name)
@ -198,7 +213,10 @@ (define test-metadata-with-extras-jedi "\
('propagated-inputs ('propagated-inputs
('quasiquote ('quasiquote
(("python-bar" ('unquote 'python-bar)) (("python-bar" ('unquote 'python-bar))
("python-baz" ('unquote 'python-baz))))) ("python-foo" ('unquote 'python-foo)))))
('native-inputs
('quasiquote
(("python-pytest" ('unquote 'python-pytest)))))
('home-page "http://example.com") ('home-page "http://example.com")
('synopsis "summary") ('synopsis "summary")
('description "summary") ('description "summary")
@ -219,25 +237,25 @@ (define test-metadata-with-extras-jedi "\
(begin (begin
(mkdir-p "foo-1.0.0/foo.egg-info/") (mkdir-p "foo-1.0.0/foo.egg-info/")
(with-output-to-file "foo-1.0.0/foo.egg-info/requires.txt" (with-output-to-file "foo-1.0.0/foo.egg-info/requires.txt"
(lambda () (lambda ()
(display "wrong data to make sure we're testing wheels "))) (display "wrong data to make sure we're testing wheels ")))
(parameterize ((current-output-port (%make-void-port "rw+"))) (parameterize ((current-output-port (%make-void-port "rw+")))
(system* "tar" "czvf" file-name "foo-1.0.0/")) (system* "tar" "czvf" file-name "foo-1.0.0/"))
(delete-file-recursively "foo-1.0.0") (delete-file-recursively "foo-1.0.0")
(set! test-source-hash (set! test-source-hash
(call-with-input-file file-name port-sha256)))) (call-with-input-file file-name port-sha256))))
("https://example.com/foo-1.0.0-py2.py3-none-any.whl" ("https://example.com/foo-1.0.0-py2.py3-none-any.whl"
(begin (begin
(mkdir "foo-1.0.0.dist-info") (mkdir "foo-1.0.0.dist-info")
(with-output-to-file "foo-1.0.0.dist-info/METADATA" (with-output-to-file "foo-1.0.0.dist-info/METADATA"
(lambda () (lambda ()
(display test-metadata))) (display test-metadata)))
(let ((zip-file (string-append file-name ".zip"))) (let ((zip-file (string-append file-name ".zip")))
;; zip always adds a "zip" extension to the file it creates, ;; zip always adds a "zip" extension to the file it creates,
;; so we need to rename it. ;; so we need to rename it.
(system* "zip" zip-file "foo-1.0.0.dist-info/METADATA") (system* "zip" "-q" zip-file "foo-1.0.0.dist-info/METADATA")
(rename-file zip-file file-name)) (rename-file zip-file file-name))
(delete-file-recursively "foo-1.0.0.dist-info"))) (delete-file-recursively "foo-1.0.0.dist-info")))
(_ (error "Unexpected URL: " url))))) (_ (error "Unexpected URL: " url)))))
(mock ((guix http-client) http-fetch (mock ((guix http-client) http-fetch
(lambda (url . rest) (lambda (url . rest)
@ -265,6 +283,9 @@ (define test-metadata-with-extras-jedi "\
('quasiquote ('quasiquote
(("python-bar" ('unquote 'python-bar)) (("python-bar" ('unquote 'python-bar))
("python-baz" ('unquote 'python-baz))))) ("python-baz" ('unquote 'python-baz)))))
('native-inputs
('quasiquote
(("python-pytest" ('unquote 'python-pytest)))))
('home-page "http://example.com") ('home-page "http://example.com")
('synopsis "summary") ('synopsis "summary")
('description "summary") ('description "summary")