Cyril Roelandt <tipec...@gmail.com> writes:
> * guix/import/pypi.scm (compute-inputs, guess-requirements): New procedures.
> ---
> guix/import/pypi.scm | 149
> ++++++++++++++++++++++++++++++++++++++++-----------
> 1 file changed, 118 insertions(+), 31 deletions(-)
>
> diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
> index 8567cad..1091deb 100644
> --- a/guix/import/pypi.scm
> +++ b/guix/import/pypi.scm
> @@ -21,6 +21,7 @@
> #:use-module (ice-9 match)
> #:use-module (ice-9 pretty-print)
> #:use-module (ice-9 regex)
> + #:use-module ((ice-9 rdelim) #:select (read-line))
> #:use-module (srfi srfi-1)
> #:use-module (rnrs bytevectors)
> #:use-module (json)
> @@ -77,42 +78,128 @@ or #f on failure."
> with dashes."
> (string-join (string-split (string-downcase str) #\_) "-"))
>
> -(define (guix-hash-url url)
> - "Download the resource at URL and return the hash in nix-base32 format."
> - (call-with-temporary-output-file
> - (lambda (temp port)
> - (and (url-fetch url temp)
> - (bytevector->nix-base32-string
> - (call-with-input-file temp port-sha256))))))
> +(define (guix-hash-url filename)
> + "Return the hash of FILENAME in nix-base32 format."
> + (bytevector->nix-base32-string
> + (call-with-input-file filename port-sha256)))
> +
> +(define (guix-name name)
> + (if (string-prefix? "python-" name)
> + (snake-case name)
> + (string-append "python-" (snake-case name))))
> +
> +(define (maybe-inputs guix-name inputs)
> + (match inputs
> + (()
> + '())
> + ((inputs ...)
> + `((,guix-name (,'quasiquote ,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."
> +
> + (define (tarball-directory url)
> + "Given the URL of the package's tarball, return the name of the directory
> +that will be created upon decompressing it."
> + ;; TODO: Support more archive formats.
> + (let ((basename (substring url (+ 1 (string-rindex url #\/)))))
> + (cond
> + ((string-suffix? ".tar.gz" basename)
> + (string-drop-right basename 7))
> + ((string-suffix? ".tar.bz2" basename)
> + (string-drop-right basename 8))
> + (else #f))))
> +
> + (define (clean-requirement s)
> + "Given a requirement LINE, as can be found in a Python requirements.txt
> +file, remove everything other than the actual name of the required package,
> and
> +return it."
> + (string-take s
> + (or (string-index s (lambda (c)
> + (member c '(#\< #\> #\= #\#))))
> + (string-length s))))
> +
> + (define (comment? line)
> + "Return #t if the given LINE is a comment, #f otherwise."
> + (eq? (string-ref line 0) #\#))
Couldn't there be any amount of whitespace before the "#"?
> +
> + (define (read-requirements requirements-file)
> + "Given REQUIREMENTS-FILE, a Python requirements.txt file, return a list
> of
> +name/variable pairs describing the requirements."
> + (call-with-input-file requirements-file
> + (lambda (port)
> + (let loop ((result '()))
> + (let ((line (read-line port)))
> + (if (eof-object? line)
> + result
> + (cond
> + ((or (string-null? line) (comment? line))
> + (loop result))
> + (else
> + (loop (cons (guix-name (clean-requirement line))
> + result))))))))))
> +
> + (let ((dirname (tarball-directory source-url)))
> + (if (string? dirname)
> + (let ((req-file (string-append dirname "/requirements.txt")))
> + ;; TODO: support more formats.
> + (if (zero? (system* "tar" "xf" tarball req-file))
> + (dynamic-wind
> + (const #t)
> + (lambda ()
> + (read-requirements req-file))
> + (lambda ()
> + (delete-file req-file)
> + (rmdir dirname)))
> + '()))
> + '())))
> +
> +(define (compute-inputs source-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
> + (map (lambda (input)
> + (list input (list 'unquote (string->symbol input))))
Could be rephrased as:
`(,input (,'unqoute ,(string->symbol input)))
Not sure if it's a good idea, though. Ludo? ;)
> + (append '("python-setuptools")
> + ;; Argparse has been part of Python since 2.7.
> + (filter (lambda (input)
> + (not (string=? "python-argparse" input)))
> + (guess-requirements source-url tarball))))
Rather than using 'filter' with a predicate that uses 'not', use
'remove' instead.
(remove (cut string=? "python-argparse" <>)
(guess-requirements source-url tarball))
> + (lambda args
> + (match args
> + (((a _ ...) (b _ ...))
> + (string-ci<? a b))))))
>
> (define (make-pypi-sexp name version source-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."
> - `(package
> - (name ,(if (string-prefix? "python-" name)
> - (snake-case name)
> - (string-append "python-" (snake-case name))))
> - (version ,version)
> - (source (origin
> - (method url-fetch)
> - (uri (string-append ,@(factorize-uri source-url version)))
> - (sha256
> - (base32
> - ,(guix-hash-url source-url)))))
> - (build-system python-build-system)
> - (inputs
> - `(("python-setuptools" ,python-setuptools)))
> - (home-page ,home-page)
> - (synopsis ,synopsis)
> - (description ,description)
> - (license ,(assoc-ref `((,lgpl2.0 . lgpl2.0)
> - (,gpl3 . gpl3)
> - (,bsd-3 . bsd-3)
> - (,expat . expat)
> - (,public-domain . public-domain)
> - (,asl2.0 . asl2.0))
> - license))))
> + (call-with-temporary-output-file
> + (lambda (temp port)
> + (and (url-fetch source-url temp)
> + `(package
> + (name ,(guix-name name))
> + (version ,version)
> + (source (origin
> + (method url-fetch)
> + (uri (string-append ,@(factorize-uri source-url
> version)))
> + (sha256
> + (base32
> + ,(guix-hash-url temp)))))
> + (build-system python-build-system)
> + ,@(maybe-inputs 'inputs
> + (compute-inputs source-url temp))
> + (home-page ,home-page)
> + (synopsis ,synopsis)
> + (description ,description)
> + (license ,(assoc-ref `((,lgpl2.0 . lgpl2.0)
> + (,gpl3 . gpl3)
> + (,bsd-3 . bsd-3)
> + (,expat . expat)
> + (,public-domain . public-domain)
> + (,asl2.0 . asl2.0))
> + license)))))))
>
> (define (pypi->guix-package package-name)
> "Fetch the metadata for PACKAGE-NAME from pypi.python.org, and return the
> --
> 1.8.4.rc3
>
>
And as Ludo requested, a test case would be good.
Thanks!
--
David Thompson
Web Developer - Free Software Foundation - http://fsf.org
GPG Key: 0FF1D807
Support the FSF: https://fsf.org/donate
