Browse Source
import: Add PyPI importer.
import: Add PyPI importer.
* guix/snix.scm: Delete. * guix/import/snix.scm: New file. * guix/import/pypi.scm: New file. * guix/import/utils.scm: New file. * guix/scripts/import/nix.scm: New file. * guix/scripts/import/pypi.scm: New file. * tests/pypi.scm: New file. * tests/snix.scm: Import (guix import snix) module. * guix/scripts/import.scm (%default-options, %options): Delete. (%standard-import-options, importers): New variables. (show-help): List importers. (guix-import): Factor out Nix-specific logic. Delegate to correct importer based upon first argument. * configure.ac (HAVE_GUILE_JSON): New conditional. * Makefile.am (MODULES): Add new files and remove 'guix/snix.scm'. (SCM_TESTS): Add 'tests/pypi.scm' if guile-json is installed.version-0.8.3
David Thompson
8 years ago
10 changed files with 552 additions and 78 deletions
-
12Makefile.am
-
4configure.ac
-
169guix/import/pypi.scm
-
31guix/import/snix.scm
-
51guix/import/utils.scm
-
85guix/scripts/import.scm
-
89guix/scripts/import/nix.scm
-
83guix/scripts/import/pypi.scm
-
102tests/pypi.scm
-
4tests/snix.scm
@ -0,0 +1,169 @@ |
|||
;;; GNU Guix --- Functional package management for GNU |
|||
;;; Copyright © 2014 David Thompson <davet@gnu.org> |
|||
;;; |
|||
;;; This file is part of GNU Guix. |
|||
;;; |
|||
;;; GNU Guix is free software; you can redistribute it and/or modify it |
|||
;;; under the terms of the GNU General Public License as published by |
|||
;;; the Free Software Foundation; either version 3 of the License, or (at |
|||
;;; your option) any later version. |
|||
;;; |
|||
;;; GNU Guix is distributed in the hope that it will be useful, but |
|||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
|||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|||
;;; GNU General Public License for more details. |
|||
;;; |
|||
;;; You should have received a copy of the GNU General Public License |
|||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
|||
|
|||
(define-module (guix import pypi) |
|||
#:use-module (ice-9 binary-ports) |
|||
#:use-module (ice-9 match) |
|||
#:use-module (ice-9 pretty-print) |
|||
#:use-module (ice-9 regex) |
|||
#:use-module (srfi srfi-1) |
|||
#:use-module (rnrs bytevectors) |
|||
#:use-module (json) |
|||
#:use-module (web uri) |
|||
#:use-module (guix utils) |
|||
#:use-module (guix import utils) |
|||
#:use-module (guix base32) |
|||
#:use-module (guix hash) |
|||
#:use-module (guix packages) |
|||
#:use-module (guix licenses) |
|||
#:use-module (guix build-system python) |
|||
#:use-module ((guix build download) #:prefix build:) |
|||
#:use-module (gnu packages python) |
|||
#:export (pypi->guix-package)) |
|||
|
|||
(define (hash-table->alist table) |
|||
"Return an alist represenation of TABLE." |
|||
(map (match-lambda |
|||
((key . (lst ...)) |
|||
(cons key |
|||
(map (lambda (x) |
|||
(if (hash-table? x) |
|||
(hash-table->alist x) |
|||
x)) |
|||
lst))) |
|||
((key . (? hash-table? table)) |
|||
(cons key (hash-table->alist table))) |
|||
(pair pair)) |
|||
(hash-map->list cons table))) |
|||
|
|||
(define (flatten lst) |
|||
"Return a list that recursively concatenates all sub-lists of LIST." |
|||
(fold-right |
|||
(match-lambda* |
|||
(((sub-list ...) memo) |
|||
(append (flatten sub-list) memo)) |
|||
((elem memo) |
|||
(cons elem memo))) |
|||
'() lst)) |
|||
|
|||
(define (join lst delimiter) |
|||
"Return a list that contains the elements of LST, each separated by |
|||
DELIMETER." |
|||
(match lst |
|||
(() '()) |
|||
((elem) |
|||
(list elem)) |
|||
((elem . rest) |
|||
(cons* elem delimiter (join rest delimiter))))) |
|||
|
|||
(define (assoc-ref* alist key . rest) |
|||
"Return the value for KEY from ALIST. For each additional key specified, |
|||
recursively apply the procedure to the sub-list." |
|||
(if (null? rest) |
|||
(assoc-ref alist key) |
|||
(apply assoc-ref* (assoc-ref alist key) rest))) |
|||
|
|||
(define string->license |
|||
(match-lambda |
|||
("GNU LGPL" lgpl2.0) |
|||
("GPL" gpl3) |
|||
((or "BSD" "BSD License") bsd-3) |
|||
((or "MIT" "MIT license" "Expat license") expat) |
|||
("Public domain" public-domain) |
|||
(_ #f))) |
|||
|
|||
(define (url-fetch url file-name) |
|||
"Save the contents of URL to FILE-NAME." |
|||
(parameterize ((current-output-port (current-error-port))) |
|||
(build:url-fetch url file-name))) |
|||
|
|||
(define (json-fetch url) |
|||
"Return an alist representation of the JSON resource URL." |
|||
(call-with-temporary-output-file |
|||
(lambda (temp port) |
|||
(and (url-fetch url temp) |
|||
(hash-table->alist |
|||
(call-with-input-file temp json->scm)))))) |
|||
|
|||
(define (pypi-fetch name) |
|||
"Return an alist representation of the PyPI metadata for the package NAME." |
|||
(json-fetch (string-append "https://pypi.python.org/pypi/" name "/json"))) |
|||
|
|||
(define (latest-source-release pypi-package) |
|||
"Return the latest source release for PYPI-PACKAGE." |
|||
(let ((releases (assoc-ref* pypi-package "releases" |
|||
(assoc-ref* pypi-package "info" "version")))) |
|||
(or (find (lambda (release) |
|||
(string=? "sdist" (assoc-ref release "packagetype"))) |
|||
releases) |
|||
(error "No source release found for pypi package: " |
|||
(assoc-ref* pypi-package "info" "name") |
|||
(assoc-ref* pypi-package "info" "version"))))) |
|||
|
|||
(define (snake-case str) |
|||
"Return a downcased version of the string STR where dashes are replaced with |
|||
underscores." |
|||
(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 (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 ,(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)) |
|||
license)))) |
|||
|
|||
(define (pypi->guix-package package-name) |
|||
"Fetch the metadata for PACKAGE-NAME from pypi.python.org, and return the |
|||
`package' s-expression corresponding to that package." |
|||
(let ((package (pypi-fetch package-name))) |
|||
(let ((name (assoc-ref* package "info" "name")) |
|||
(version (assoc-ref* package "info" "version")) |
|||
(release (assoc-ref (latest-source-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 |
|||
description license)))) |
|||
@ -0,0 +1,51 @@ |
|||
;;; GNU Guix --- Functional package management for GNU |
|||
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> |
|||
;;; |
|||
;;; This file is part of GNU Guix. |
|||
;;; |
|||
;;; GNU Guix is free software; you can redistribute it and/or modify it |
|||
;;; under the terms of the GNU General Public License as published by |
|||
;;; the Free Software Foundation; either version 3 of the License, or (at |
|||
;;; your option) any later version. |
|||
;;; |
|||
;;; GNU Guix is distributed in the hope that it will be useful, but |
|||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
|||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|||
;;; GNU General Public License for more details. |
|||
;;; |
|||
;;; You should have received a copy of the GNU General Public License |
|||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
|||
|
|||
(define-module (guix import utils) |
|||
#:use-module (ice-9 match) |
|||
#:use-module (ice-9 regex) |
|||
#:use-module (srfi srfi-1) |
|||
#:export (factorize-uri)) |
|||
|
|||
(define (factorize-uri uri version) |
|||
"Factorize URI, a package tarball URI as a string, such that any occurrences |
|||
of the string VERSION is replaced by the symbol 'version." |
|||
(let ((version-rx (make-regexp (regexp-quote version)))) |
|||
(match (regexp-exec version-rx uri) |
|||
(#f |
|||
uri) |
|||
(_ |
|||
(let ((indices (fold-matches version-rx uri |
|||
'((0)) |
|||
(lambda (m result) |
|||
(match result |
|||
(((start) rest ...) |
|||
`((,(match:end m)) |
|||
(,start . ,(match:start m)) |
|||
,@rest))))))) |
|||
(fold (lambda (index result) |
|||
(match index |
|||
((start) |
|||
(cons (substring uri start) |
|||
result)) |
|||
((start . end) |
|||
(cons* (substring uri start end) |
|||
'version |
|||
result)))) |
|||
'() |
|||
indices)))))) |
|||
@ -0,0 +1,89 @@ |
|||
;;; GNU Guix --- Functional package management for GNU |
|||
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> |
|||
;;; Copyright © 2014 David Thompson <davet@gnu.org> |
|||
;;; |
|||
;;; This file is part of GNU Guix. |
|||
;;; |
|||
;;; GNU Guix is free software; you can redistribute it and/or modify it |
|||
;;; under the terms of the GNU General Public License as published by |
|||
;;; the Free Software Foundation; either version 3 of the License, or (at |
|||
;;; your option) any later version. |
|||
;;; |
|||
;;; GNU Guix is distributed in the hope that it will be useful, but |
|||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
|||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|||
;;; GNU General Public License for more details. |
|||
;;; |
|||
;;; You should have received a copy of the GNU General Public License |
|||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
|||
|
|||
(define-module (guix scripts import nix) |
|||
#:use-module (guix ui) |
|||
#:use-module (guix utils) |
|||
#:use-module (guix import snix) |
|||
#:use-module (guix scripts import) |
|||
#:use-module (srfi srfi-1) |
|||
#:use-module (srfi srfi-11) |
|||
#:use-module (srfi srfi-37) |
|||
#:use-module (ice-9 match) |
|||
#:export (guix-import-nix)) |
|||
|
|||
|
|||
;;; |
|||
;;; Command-line options. |
|||
;;; |
|||
|
|||
(define %default-options |
|||
'()) |
|||
|
|||
(define (show-help) |
|||
(display (_ "Usage: guix import nix NIXPKGS ATTRIBUTE |
|||
Import and convert the Nix expression ATTRIBUTE of NIXPKGS.\n")) |
|||
(display (_ " |
|||
-h, --help display this help and exit")) |
|||
(display (_ " |
|||
-V, --version display version information and exit")) |
|||
(newline) |
|||
(show-bug-report-information)) |
|||
|
|||
(define %options |
|||
;; Specification of the command-line options. |
|||
(cons* (option '(#\h "help") #f #f |
|||
(lambda args |
|||
(show-help) |
|||
(exit 0))) |
|||
(option '(#\V "version") #f #f |
|||
(lambda args |
|||
(show-version-and-exit "guix import nix"))) |
|||
%standard-import-options)) |
|||
|
|||
|
|||
;;; |
|||
;;; Entry point. |
|||
;;; |
|||
|
|||
(define (guix-import-nix . args) |
|||
(define (parse-options) |
|||
;; Return the alist of option values. |
|||
(args-fold* args %options |
|||
(lambda (opt name arg result) |
|||
(leave (_ "~A: unrecognized option~%") name)) |
|||
(lambda (arg result) |
|||
(alist-cons 'argument arg result)) |
|||
%default-options)) |
|||
|
|||
(let* ((opts (parse-options)) |
|||
(args (filter-map (match-lambda |
|||
(('argument . value) |
|||
value) |
|||
(_ #f)) |
|||
(reverse opts)))) |
|||
(match args |
|||
((nixpkgs attribute) |
|||
(let-values (((expr loc) |
|||
(nixpkgs->guix-package nixpkgs attribute))) |
|||
(format #t ";; converted from ~a:~a~%~%" |
|||
(location-file loc) (location-line loc)) |
|||
expr)) |
|||
(_ |
|||
(leave (_ "wrong number of arguments~%")))))) |
|||
@ -0,0 +1,83 @@ |
|||
;;; GNU Guix --- Functional package management for GNU |
|||
;;; Copyright © 2014 David Thompson <davet@gnu.org> |
|||
;;; |
|||
;;; This file is part of GNU Guix. |
|||
;;; |
|||
;;; GNU Guix is free software; you can redistribute it and/or modify it |
|||
;;; under the terms of the GNU General Public License as published by |
|||
;;; the Free Software Foundation; either version 3 of the License, or (at |
|||
;;; your option) any later version. |
|||
;;; |
|||
;;; GNU Guix is distributed in the hope that it will be useful, but |
|||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
|||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|||
;;; GNU General Public License for more details. |
|||
;;; |
|||
;;; You should have received a copy of the GNU General Public License |
|||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
|||
|
|||
(define-module (guix scripts import pypi) |
|||
#:use-module (guix ui) |
|||
#:use-module (guix utils) |
|||
#:use-module (guix import pypi) |
|||
#:use-module (guix scripts import) |
|||
#:use-module (srfi srfi-1) |
|||
#:use-module (srfi srfi-11) |
|||
#:use-module (srfi srfi-37) |
|||
#:use-module (ice-9 match) |
|||
#:use-module (ice-9 format) |
|||
#:export (guix-import-pypi)) |
|||
|
|||
|
|||
;;; |
|||
;;; Command-line options. |
|||
;;; |
|||
|
|||
(define %default-options |
|||
'()) |
|||
|
|||
(define (show-help) |
|||
(display (_ "Usage: guix import pypi PACKAGE-NAME |
|||
Import and convert the PyPI package for PACKAGE-NAME.\n")) |
|||
(display (_ " |
|||
-h, --help display this help and exit")) |
|||
(display (_ " |
|||
-V, --version display version information and exit")) |
|||
(newline) |
|||
(show-bug-report-information)) |
|||
|
|||
(define %options |
|||
;; Specification of the command-line options. |
|||
(cons* (option '(#\h "help") #f #f |
|||
(lambda args |
|||
(show-help) |
|||
(exit 0))) |
|||
(option '(#\V "version") #f #f |
|||
(lambda args |
|||
(show-version-and-exit "guix import pypi"))) |
|||
%standard-import-options)) |
|||
|
|||
|
|||
;;; |
|||
;;; Entry point. |
|||
;;; |
|||
|
|||
(define (guix-import-pypi . args) |
|||
(define (parse-options) |
|||
;; Return the alist of option values. |
|||
(args-fold* args %options |
|||
(lambda (opt name arg result) |
|||
(leave (_ "~A: unrecognized option~%") name)) |
|||
(lambda (arg result) |
|||
(alist-cons 'argument arg result)) |
|||
%default-options)) |
|||
|
|||
(let* ((opts (parse-options)) |
|||
(args (filter-map (match-lambda |
|||
(('argument . value) |
|||
value) |
|||
(_ #f)) |
|||
(reverse opts)))) |
|||
(match args |
|||
((package-name) |
|||
(pypi->guix-package package-name))))) |
|||
@ -0,0 +1,102 @@ |
|||
;;; GNU Guix --- Functional package management for GNU |
|||
;;; Copyright © 2014 David Thompson <davet@gnu.org> |
|||
;;; |
|||
;;; This file is part of GNU Guix. |
|||
;;; |
|||
;;; GNU Guix is free software; you can redistribute it and/or modify it |
|||
;;; under the terms of the GNU General Public License as published by |
|||
;;; the Free Software Foundation; either version 3 of the License, or (at |
|||
;;; your option) any later version. |
|||
;;; |
|||
;;; GNU Guix is distributed in the hope that it will be useful, but |
|||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
|||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|||
;;; GNU General Public License for more details. |
|||
;;; |
|||
;;; You should have received a copy of the GNU General Public License |
|||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
|||
|
|||
(define-module (test-pypi) |
|||
#:use-module (guix import pypi) |
|||
#:use-module (guix base32) |
|||
#:use-module (guix hash) |
|||
#:use-module (srfi srfi-64) |
|||
#:use-module (ice-9 match)) |
|||
|
|||
(define-syntax-rule (mock (module proc replacement) body ...) |
|||
(let* ((m (resolve-module 'module)) |
|||
(original (module-ref m 'proc))) |
|||
(dynamic-wind |
|||
(lambda () (module-set! m 'proc replacement)) |
|||
(lambda () body ...) |
|||
(lambda () (module-set! m 'proc original))))) |
|||
|
|||
(define test-json |
|||
"{ |
|||
\"info\": { |
|||
\"version\": \"1.0.0\", |
|||
\"name\": \"foo\", |
|||
\"license\": \"GNU LGPL\", |
|||
\"summary\": \"summary\", |
|||
\"home_page\": \"http://example.com\", |
|||
}, |
|||
\"releases\": { |
|||
\"1.0.0\": [ |
|||
{ |
|||
\"url\": \"https://example.com/foo-1.0.0.egg\", |
|||
\"packagetype\": \"bdist_egg\", |
|||
}, { |
|||
\"url\": \"https://example.com/foo-1.0.0.tar.gz\", |
|||
\"packagetype\": \"sdist\", |
|||
} |
|||
] |
|||
} |
|||
}") |
|||
|
|||
(define test-source |
|||
"foobar") |
|||
|
|||
(test-begin "pypi") |
|||
|
|||
(test-assert "pypi->guix-package" |
|||
;; Replace network resources with sample data. |
|||
(mock ((guix import pypi) url-fetch |
|||
(lambda (url file-name) |
|||
(with-output-to-file file-name |
|||
(lambda () |
|||
(display |
|||
(match url |
|||
("https://pypi.python.org/pypi/foo/json" |
|||
test-json) |
|||
("https://example.com/foo-1.0.0.tar.gz" |
|||
test-source) |
|||
(_ (error "Unexpected URL: " url)))))))) |
|||
(match (pypi->guix-package "foo") |
|||
(('package |
|||
('name "python-foo") |
|||
('version "1.0.0") |
|||
('source ('origin |
|||
('method 'url-fetch) |
|||
('uri ('string-append "https://example.com/foo-" |
|||
'version ".tar.gz")) |
|||
('sha256 |
|||
('base32 |
|||
(? string? hash))))) |
|||
('build-system 'python-build-system) |
|||
('inputs |
|||
('quasiquote |
|||
(("python-setuptools" ('unquote 'python-setuptools))))) |
|||
('home-page "http://example.com") |
|||
('synopsis "summary") |
|||
('description "summary") |
|||
('license 'lgpl2.0)) |
|||
(string=? (bytevector->nix-base32-string |
|||
(call-with-input-string test-source port-sha256)) |
|||
hash)) |
|||
(x |
|||
(pk 'fail x #f))))) |
|||
|
|||
(test-end "pypi") |
|||
|
|||
|
|||
(exit (= (test-runner-fail-count (test-runner-current)) 0)) |
|||
Write
Preview
Loading…
Cancel
Save
Reference in new issue