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.
This commit is contained in:
parent
2efb3ddaa4
commit
1b3e968512
12
Makefile.am
12
Makefile.am
|
@ -75,7 +75,9 @@ MODULES = \
|
||||||
guix/build/syscalls.scm \
|
guix/build/syscalls.scm \
|
||||||
guix/build/emacs-utils.scm \
|
guix/build/emacs-utils.scm \
|
||||||
guix/packages.scm \
|
guix/packages.scm \
|
||||||
guix/snix.scm \
|
guix/import/utils.scm \
|
||||||
|
guix/import/snix.scm \
|
||||||
|
guix/import/pypi.scm \
|
||||||
guix/scripts/download.scm \
|
guix/scripts/download.scm \
|
||||||
guix/scripts/build.scm \
|
guix/scripts/build.scm \
|
||||||
guix/scripts/archive.scm \
|
guix/scripts/archive.scm \
|
||||||
|
@ -89,6 +91,8 @@ MODULES = \
|
||||||
guix/scripts/refresh.scm \
|
guix/scripts/refresh.scm \
|
||||||
guix/scripts/system.scm \
|
guix/scripts/system.scm \
|
||||||
guix/scripts/lint.scm \
|
guix/scripts/lint.scm \
|
||||||
|
guix/scripts/import/nix.scm \
|
||||||
|
guix/scripts/import/pypi.scm \
|
||||||
guix.scm \
|
guix.scm \
|
||||||
$(GNU_SYSTEM_MODULES)
|
$(GNU_SYSTEM_MODULES)
|
||||||
|
|
||||||
|
@ -162,6 +166,12 @@ SCM_TESTS = \
|
||||||
tests/syscalls.scm \
|
tests/syscalls.scm \
|
||||||
tests/lint.scm
|
tests/lint.scm
|
||||||
|
|
||||||
|
if HAVE_GUILE_JSON
|
||||||
|
|
||||||
|
SCM_TESTS += tests/pypi.scm
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
SH_TESTS = \
|
SH_TESTS = \
|
||||||
tests/guix-build.sh \
|
tests/guix-build.sh \
|
||||||
tests/guix-download.sh \
|
tests/guix-download.sh \
|
||||||
|
|
|
@ -61,6 +61,10 @@ if test "x$GUILD" = "x"; then
|
||||||
AC_MSG_ERROR(['guild' binary not found; please check your guile-2.x installation.])
|
AC_MSG_ERROR(['guild' binary not found; please check your guile-2.x installation.])
|
||||||
fi
|
fi
|
||||||
|
|
||||||
|
dnl guile-json is used for the PyPI package importer
|
||||||
|
GUILE_MODULE_AVAILABLE([have_guile_json], [(json)])
|
||||||
|
AM_CONDITIONAL([HAVE_GUILE_JSON], [test "x$have_guile_json" = "xyes"])
|
||||||
|
|
||||||
dnl Make sure we have a full-fledged Guile.
|
dnl Make sure we have a full-fledged Guile.
|
||||||
GUIX_ASSERT_GUILE_FEATURES([regex posix socket net-db threads])
|
GUIX_ASSERT_GUILE_FEATURES([regex posix socket net-db threads])
|
||||||
|
|
||||||
|
|
|
@ -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))))
|
|
@ -16,7 +16,7 @@
|
||||||
;;; You should have received a copy of the GNU General Public License
|
;;; You should have received a copy of the GNU General Public License
|
||||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(define-module (guix snix)
|
(define-module (guix import snix)
|
||||||
#:use-module (sxml ssax)
|
#:use-module (sxml ssax)
|
||||||
#:use-module (ice-9 popen)
|
#:use-module (ice-9 popen)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
|
@ -32,6 +32,7 @@
|
||||||
#:use-module (system foreign)
|
#:use-module (system foreign)
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module (rnrs bytevectors)
|
||||||
#:use-module (guix utils)
|
#:use-module (guix utils)
|
||||||
|
#:use-module (guix import utils)
|
||||||
#:use-module (guix base32)
|
#:use-module (guix base32)
|
||||||
#:use-module (guix config)
|
#:use-module (guix config)
|
||||||
#:use-module (guix gnu-maintenance)
|
#:use-module (guix gnu-maintenance)
|
||||||
|
@ -318,34 +319,6 @@ attributes, or #f if NAME cannot be found."
|
||||||
;;; Conversion of "Nix expressions" to "Guix expressions".
|
;;; Conversion of "Nix expressions" to "Guix expressions".
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
(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))))))
|
|
||||||
|
|
||||||
(define (snix-derivation->guix-package derivation)
|
(define (snix-derivation->guix-package derivation)
|
||||||
"Return the `package' s-expression corresponding to SNix DERIVATION, a
|
"Return the `package' s-expression corresponding to SNix DERIVATION, a
|
||||||
Nixpkgs `stdenv.mkDerivation'-style derivation, and the original source
|
Nixpkgs `stdenv.mkDerivation'-style derivation, and the original source
|
|
@ -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))))))
|
|
@ -1,5 +1,6 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
||||||
|
;;; Copyright © 2014 David Thompson <davet@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -18,15 +19,16 @@
|
||||||
|
|
||||||
(define-module (guix scripts import)
|
(define-module (guix scripts import)
|
||||||
#:use-module (guix ui)
|
#:use-module (guix ui)
|
||||||
#:use-module (guix snix)
|
|
||||||
#:use-module (guix utils)
|
#:use-module (guix utils)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-37)
|
#:use-module (srfi srfi-37)
|
||||||
|
#:use-module (ice-9 format)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 pretty-print)
|
#:use-module (ice-9 pretty-print)
|
||||||
#:export (guix-import))
|
#:export (%standard-import-options
|
||||||
|
guix-import))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
@ -61,15 +63,30 @@ rather than \\n."
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; Command-line options.
|
;;; Command line options.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
(define %default-options
|
(define %standard-import-options '())
|
||||||
'())
|
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Entry point.
|
||||||
|
;;;
|
||||||
|
|
||||||
|
(define importers '("nix" "pypi"))
|
||||||
|
|
||||||
|
(define (resolve-importer name)
|
||||||
|
(let ((module (resolve-interface
|
||||||
|
`(guix scripts import ,(string->symbol name))))
|
||||||
|
(proc (string->symbol (string-append "guix-import-" name))))
|
||||||
|
(module-ref module proc)))
|
||||||
|
|
||||||
(define (show-help)
|
(define (show-help)
|
||||||
(display (_ "Usage: guix import NIXPKGS ATTRIBUTE
|
(display (_ "Usage: guix import IMPORTER ARGS ...
|
||||||
Import and convert the Nix expression ATTRIBUTE of NIXPKGS.\n"))
|
Run IMPORTER with ARGS.\n"))
|
||||||
|
(newline)
|
||||||
|
(display (_ "IMPORTER must be one of the importers listed below:\n"))
|
||||||
|
(format #t "~{ ~a~%~}" importers)
|
||||||
(display (_ "
|
(display (_ "
|
||||||
-h, --help display this help and exit"))
|
-h, --help display this help and exit"))
|
||||||
(display (_ "
|
(display (_ "
|
||||||
|
@ -77,43 +94,19 @@ Import and convert the Nix expression ATTRIBUTE of NIXPKGS.\n"))
|
||||||
(newline)
|
(newline)
|
||||||
(show-bug-report-information))
|
(show-bug-report-information))
|
||||||
|
|
||||||
(define %options
|
|
||||||
;; Specification of the command-line options.
|
|
||||||
(list (option '(#\h "help") #f #f
|
|
||||||
(lambda args
|
|
||||||
(show-help)
|
|
||||||
(exit 0)))
|
|
||||||
(option '(#\V "version") #f #f
|
|
||||||
(lambda args
|
|
||||||
(show-version-and-exit "guix import")))))
|
|
||||||
|
|
||||||
|
|
||||||
;;;
|
|
||||||
;;; Entry point.
|
|
||||||
;;;
|
|
||||||
|
|
||||||
(define (guix-import . args)
|
(define (guix-import . 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
|
(match args
|
||||||
((nixpkgs attribute)
|
(()
|
||||||
(let-values (((expr loc)
|
(format (current-error-port)
|
||||||
(nixpkgs->guix-package nixpkgs attribute)))
|
(_ "guix import: missing importer name~%")))
|
||||||
(format #t ";; converted from ~a:~a~%~%"
|
((or ("-h") ("--help"))
|
||||||
(location-file loc) (location-line loc))
|
(show-help)
|
||||||
(pretty-print expr (newline-rewriting-port (current-output-port)))))
|
(exit 0))
|
||||||
(_
|
(("--version")
|
||||||
(leave (_ "wrong number of arguments~%"))))))
|
(show-version-and-exit "guix import"))
|
||||||
|
((importer args ...)
|
||||||
|
(if (member importer importers)
|
||||||
|
(let ((expr (apply (resolve-importer importer) args)))
|
||||||
|
(pretty-print expr (newline-rewriting-port (current-output-port))))
|
||||||
|
(format (current-error-port)
|
||||||
|
(_ "guix import: invalid importer~%"))))))
|
||||||
|
|
|
@ -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))
|
|
@ -17,14 +17,14 @@
|
||||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(define-module (test-snix)
|
(define-module (test-snix)
|
||||||
#:use-module (guix snix)
|
#:use-module (guix import snix)
|
||||||
#:use-module ((guix utils) #:select (%nixpkgs-directory))
|
#:use-module ((guix utils) #:select (%nixpkgs-directory))
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-64)
|
#:use-module (srfi srfi-64)
|
||||||
#:use-module (ice-9 match))
|
#:use-module (ice-9 match))
|
||||||
|
|
||||||
(define factorize-uri
|
(define factorize-uri
|
||||||
(@@ (guix snix) factorize-uri))
|
(@@ (guix import snix) factorize-uri))
|
||||||
|
|
||||||
(define-syntax-rule (every? proc lists ...)
|
(define-syntax-rule (every? proc lists ...)
|
||||||
(not (not (every proc lists ...))))
|
(not (not (every proc lists ...))))
|
||||||
|
|
Loading…
Reference in New Issue