* [PATCH] import: Add PyPI importer. @ 2014-09-27 21:15 David Thompson 2014-09-27 21:19 ` David Thompson 2014-09-27 21:49 ` Ludovic Courtès 0 siblings, 2 replies; 12+ messages in thread From: David Thompson @ 2014-09-27 21:15 UTC (permalink / raw) To: guix-devel [-- Attachment #1: Type: text/plain, Size: 264 bytes --] Happy first day of the Guix hackathon, everyone! I spent my day working on generalizing the 'guix import' UI to allow for using a PyPI importer in addition to the pre-existing Nix importer. It's now at the point where I stop coding and open it up for review. :) [-- Attachment #2: 0001-import-Add-PyPI-importer.patch --] [-- Type: text/x-diff, Size: 59118 bytes --] From b3ec259fd097034631cf311040af7aa12f7c5ebc Mon Sep 17 00:00:00 2001 From: David Thompson <dthompson2@worcester.edu> Date: Sat, 27 Sep 2014 10:16:23 -0400 Subject: [PATCH] import: Add PyPI importer. * guix/snix.scm: Delete. * guix/import/snix.scm: New file. * guix/scripts/import/nix.scm: New file. * guix/import/pypi.scm: New file. * guix/scripts/import/pypi.scm: New file. * Makefile.am (MODULES): Add new files and remove 'guix/snix.scm'. * guix/scripts/import.scm (%default-options, %options): Delete. (importers): New variable. (show-help): List importers. (guix-import): Factor out Nix-specific logic. Delegate to correct importer based upon first argument. --- Makefile.am | 5 +- guix/import/pypi.scm | 210 +++++++++++++++++++ guix/import/snix.scm | 474 +++++++++++++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 69 +++---- guix/scripts/import/nix.scm | 87 ++++++++ guix/scripts/import/pypi.scm | 80 ++++++++ guix/snix.scm | 474 ------------------------------------------- 7 files changed, 879 insertions(+), 520 deletions(-) create mode 100644 guix/import/pypi.scm create mode 100644 guix/import/snix.scm create mode 100644 guix/scripts/import/nix.scm create mode 100644 guix/scripts/import/pypi.scm delete mode 100644 guix/snix.scm diff --git a/Makefile.am b/Makefile.am index 1f2c4db..c5af9c1 100644 --- a/Makefile.am +++ b/Makefile.am @@ -73,7 +73,8 @@ MODULES = \ guix/build/syscalls.scm \ guix/build/emacs-utils.scm \ guix/packages.scm \ - guix/snix.scm \ + guix/import/snix.scm \ + guix/import/pypi.scm \ guix/scripts/download.scm \ guix/scripts/build.scm \ guix/scripts/archive.scm \ @@ -87,6 +88,8 @@ MODULES = \ guix/scripts/refresh.scm \ guix/scripts/system.scm \ guix/scripts/lint.scm \ + guix/scripts/import/nix.scm \ + guix/scripts/import/pypi.scm \ guix.scm \ $(GNU_SYSTEM_MODULES) diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm new file mode 100644 index 0000000..8d0172d --- /dev/null +++ b/guix/import/pypi.scm @@ -0,0 +1,210 @@ +;;; 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 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 tarball-url->string-append + (let ((tar.gz-regex (make-regexp "\\.tar\\.gz$")) + (tarball-regex (make-regexp ".*-(.*)\\.tar\\.gz"))) + (lambda (url name version) + "Return a `string-append' s-expression used for building a generic form +of URL for the package NAME where VERSION is replaced by a `version' +variable." + (define (package-version? part) + (string=? part version)) + + (define (ends-in-tar.gz? part) + (regexp-exec tar.gz-regex part)) + + (define (fold-strings lst) + (fold-right + (match-lambda* + ((elem ()) + (list elem)) + (((? string? elem) ((? string? prev) . rest)) + (cons (string-append elem prev) rest)) + ((elem (memo ...)) + (cons elem memo))) + '() lst)) + + (let ((uri (string->uri url))) + (fold-strings + (cons* 'string-append + (symbol->string (uri-scheme uri)) "://" + (uri-host uri) + (flatten + (join + (map (match-lambda + ((? package-version? _) + 'version) + ((? ends-in-tar.gz? part) + (let ((matches (regexp-exec tarball-regex part))) + `(,name "-" version ".tar.gz"))) + (part part)) + (string-split (uri-path uri) #\/)) + "/")))))))) + +(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 ,name) + (version ,version) + (source (origin + (method url-fetch) + (uri ,(tarball-url->string-append source-url name 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 (string-append "python-" + (snake-case (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)))) diff --git a/guix/import/snix.scm b/guix/import/snix.scm new file mode 100644 index 0000000..2f8fbbb --- /dev/null +++ b/guix/import/snix.scm @@ -0,0 +1,474 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2010, 2011, 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 snix) + #:use-module (sxml ssax) + #:use-module (ice-9 popen) + #:use-module (ice-9 match) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 format) + #:use-module (ice-9 regex) + #:use-module (ice-9 vlist) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-37) + #:use-module (system foreign) + #:use-module (rnrs bytevectors) + #:use-module (guix utils) + #:use-module (guix base32) + #:use-module (guix config) + #:use-module (guix gnu-maintenance) + #:export (open-nixpkgs + xml->snix + nixpkgs->guix-package)) + +;;; Commentary: +;;; +;;; Converting Nix code to s-expressions, and then to Guix `package' +;;; declarations, using the XML output of `nix-instantiate'. +;;; +;;; Code: + +\f +;;; +;;; SNix. +;;; + +;; Nix object types visible in the XML output of `nix-instantiate' and +;; mapping to S-expressions (we map to sexps, not records, so that we +;; can do pattern matching): +;; +;; at (at varpat attrspat) +;; attr (attribute loc name value) +;; attrs (attribute-set attributes) +;; attrspat (attribute-set-pattern patterns) +;; bool #f|#t +;; derivation (derivation drv-path out-path attributes) +;; ellipsis '... +;; expr (snix loc body ...) +;; function (function loc at|attrspat|varpat) +;; int int +;; list list +;; null 'null +;; path string +;; string string +;; unevaluated 'unevaluated +;; varpat (varpat name) +;; +;; Initially ATTRIBUTES in `derivation' and `attribute-set' was a promise; +;; however, handling `repeated' nodes makes it impossible to do anything +;; lazily because the whole SXML tree has to be traversed to maintain the +;; list of known derivations. + +(define (xml-element->snix elem attributes body derivations) + "Return an SNix element corresponding to XML element ELEM." + + (define (loc) + (location (assq-ref attributes 'path) + (assq-ref attributes 'line) + (assq-ref attributes 'column))) + + (case elem + ((at) + (values `(at ,(car body) ,(cadr body)) derivations)) + ((attr) + (let ((name (assq-ref attributes 'name))) + (cond ((null? body) + (values `(attribute-pattern ,name) derivations)) + ((and (pair? body) (null? (cdr body))) + (values `(attribute ,(loc) ,name ,(car body)) + derivations)) + (else + (error "invalid attribute body" name (loc) body))))) + ((attrs) + (values `(attribute-set ,(reverse body)) derivations)) + ((attrspat) + (values `(attribute-set-pattern ,body) derivations)) + ((bool) + (values (string-ci=? "true" (assq-ref attributes 'value)) + derivations)) + ((derivation) + (let ((drv-path (assq-ref attributes 'drvPath)) + (out-path (assq-ref attributes 'outPath))) + (if (equal? body '(repeated)) + (let ((body (vhash-assoc drv-path derivations))) + (if (pair? body) + (values `(derivation ,drv-path ,out-path ,(cdr body)) + derivations) + + ;; DRV-PATH hasn't been encountered yet but may be later + ;; (see <http://article.gmane.org/gmane.linux.distributions.nixos/5946>.) + ;; Return an `unresolved' node. + (values `(unresolved + ,(lambda (derivations) + (let ((body (vhash-assoc drv-path derivations))) + (if (pair? body) + `(derivation ,drv-path ,out-path + ,(cdr body)) + (error "no previous occurrence of derivation" + drv-path))))) + derivations))) + (values `(derivation ,drv-path ,out-path ,body) + (vhash-cons drv-path body derivations))))) + ((ellipsis) + (values '... derivations)) + ((expr) + (values `(snix ,(loc) ,@body) derivations)) + ((function) + (values `(function ,(loc) ,body) derivations)) + ((int) + (values (string->number (assq-ref attributes 'value)) + derivations)) + ((list) + (values body derivations)) + ((null) + (values 'null derivations)) + ((path) + (values (assq-ref attributes 'value) derivations)) + ((repeated) + (values 'repeated derivations)) + ((string) + (values (assq-ref attributes 'value) derivations)) + ((unevaluated) + (values 'unevaluated derivations)) + ((varpat) + (values `(varpat ,(assq-ref attributes 'name)) derivations)) + (else (error "unhandled Nix XML element" elem)))) + +(define (resolve snix derivations) + "Return a new SNix tree where `unresolved' nodes from SNIX have been +replaced by the result of their application to DERIVATIONS, a vhash." + (let loop ((node snix) + (seen vlist-null)) + (if (vhash-assq node seen) + (values node seen) + (match node + (('unresolved proc) + (let ((n (proc derivations))) + (values n seen))) + ((tag body ...) + (let ((body+seen (fold (lambda (n body+seen) + (call-with-values + (lambda () + (loop n (cdr body+seen))) + (lambda (n* seen) + (cons (cons n* (car body+seen)) + (vhash-consq n #t seen))))) + (cons '() (vhash-consq node #t seen)) + body))) + (values (cons tag (reverse (car body+seen))) + (vhash-consq node #t (cdr body+seen))))) + (anything + (values anything seen)))))) + +(define xml->snix + (let ((parse + (ssax:make-parser NEW-LEVEL-SEED + (lambda (elem-gi attributes namespaces expected-content + seed) + (cons '() (cdr seed))) + + FINISH-ELEMENT + (lambda (elem-gi attributes namespaces parent-seed + seed) + (let ((snix (car seed)) + (derivations (cdr seed))) + (let-values (((snix derivations) + (xml-element->snix elem-gi + attributes + snix + derivations))) + (cons (cons snix (car parent-seed)) + derivations)))) + + CHAR-DATA-HANDLER + (lambda (string1 string2 seed) + ;; Discard inter-node strings, which are blanks. + seed)))) + (lambda (port) + "Return the SNix represention of TREE, an SXML tree as returned by +parsing the XML output of `nix-instantiate' on Nixpkgs." + (match (parse port (cons '() vlist-null)) + (((snix) . derivations) + (resolve snix derivations)))))) + +(define (attribute-value attribute) + "Return the value of ATTRIBUTE." + (match attribute + (('attribute _ _ value) value))) + +(define (derivation-source derivation) + "Return the \"src\" attribute of DERIVATION or #f if not found." + (match derivation + (('derivation _ _ (attributes ...)) + (find-attribute-by-name "src" attributes)))) + +(define (derivation-output-path derivation) + "Return the output path of DERIVATION." + (match derivation + (('derivation _ out-path _) + out-path) + (_ #f))) + +(define (source-output-path src) + "Return the output path of SRC, the \"src\" attribute of a derivation." + (derivation-output-path (attribute-value src))) + +(define (source-urls src) + "Return the URLs of SRC, the \"src\" attribute of a derivation." + (match src + (('attribute _ _ ('derivation _ _ (attributes ...))) + (match (find-attribute-by-name "urls" attributes) + (('attribute _ _ value) + value))) + (_ #f))) + +(define (source-sha256 src) + "Return the sha256 of SRC, the \"src\" attribute of a derivation, as a +bytevector." + (match src + (('attribute _ _ ('derivation _ _ (attributes ...))) + (match (find-attribute-by-name "outputHash" attributes) + (('attribute _ _ value) + (match value + ((= string-length 52) + (nix-base32-string->bytevector value)) + ((= string-length 64) + (base16-string->bytevector value)) + (_ + (error "unsupported hash format" value)))))) + (_ #f))) + +(define (derivation-source-output-path derivation) + "Return the output path of the \"src\" attribute of DERIVATION or #f +if DERIVATION lacks an \"src\" attribute." + (and=> (derivation-source derivation) source-output-path)) + +(define* (open-nixpkgs nixpkgs #:optional attribute) + "Return an input pipe to the XML representation of Nixpkgs. When +ATTRIBUTE is true, only that attribute is considered." + (with-fluids ((%default-port-encoding "UTF-8")) + (let ((cross-system (format #f "{ + config = \"i686-guix-linux-gnu\"; + libc = \"glibc\"; + arch = \"guix\"; + withTLS = true; + float = \"hard\"; + openssl.system = \"linux-generic32\"; + platform = (import ~a/pkgs/top-level/platforms.nix).sheevaplug; +}" nixpkgs))) + (apply open-pipe* OPEN_READ + %nix-instantiate "--strict" "--eval-only" "--xml" + + ;; Pass a dummy `crossSystem' argument so that `buildInputs' and + ;; `nativeBuildInputs' are not coalesced. + ;; XXX: This is hacky and has other problems. + ;"--arg" "crossSystem" cross-system + + `(,@(if attribute + `("-A" ,attribute) + '()) + ,nixpkgs))))) + +(define (pipe-failed? pipe) + "Close pipe and return its status if it failed." + (let ((status (close-pipe pipe))) + (if (or (status:term-sig status) + (not (= (status:exit-val status) 0))) + status + #f))) + +(define (find-attribute-by-name name attributes) + "Return attribute NAME in ATTRIBUTES, an attribute set or list of SNix +attributes, or #f if NAME cannot be found." + (find (lambda (a) + (match a + (('attribute _ (? (cut string=? <> name)) _) + a) + (_ #f))) + (match attributes + (('attribute-set (attributes ...)) + attributes) + (_ + attributes)))) + +(define (package-source-output-path package) + "Return the output path of the \"src\" derivation of PACKAGE." + (derivation-source-output-path (attribute-value package))) + +\f +;;; +;;; 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) + "Return the `package' s-expression corresponding to SNix DERIVATION, a +Nixpkgs `stdenv.mkDerivation'-style derivation, and the original source +location of DERIVATION." + (match derivation + (('derivation _ _ (attributes ...)) + (let*-values (((full-name loc) + (match (find-attribute-by-name "name" attributes) + (('attribute loc _ value) + (values value loc)) + (_ + (values #f #f)))) + ((name version) + (package-name->name+version full-name))) + (define (convert-inputs type) + ;; Convert the derivation's input from a list of SNix derivations to + ;; a list of name/variable pairs. + (match (and=> (find-attribute-by-name type attributes) + attribute-value) + (#f + '()) + ((inputs ...) + ;; Inputs can be either derivations or the null value. + (filter-map (match-lambda + (('derivation _ _ (attributes ...)) + (let* ((full-name + (attribute-value + (find-attribute-by-name "name" attributes))) + (name (package-name->name+version full-name))) + (list name + (list 'unquote (string->symbol name))))) + ('null #f)) + inputs)))) + + (define (maybe-inputs guix-name inputs) + (match inputs + (() + '()) + ((inputs ...) + (list (list guix-name + (list 'quasiquote inputs)))))) + + (define (pretty-uri uri version) + (if version + (match (factorize-uri uri version) + ((items ...) + `(string-append ,@items)) + (x x)) + uri)) + + (define (license-variable license) + ;; Return the name of the (guix licenses) variable for LICENSE. + (match license + ("GPLv2+" 'gpl2+) + ("GPLv3+" 'gpl3+) + ("LGPLv2+" 'lgpl2.1+) + ("LGPLv2.1+" 'lgpl2.1+) + ("LGPLv3+" 'lgpl3+) + (_ license))) + + (let* ((source (find-attribute-by-name "src" attributes)) + (urls (source-urls source)) + (sha256 (source-sha256 source)) + (meta (and=> (find-attribute-by-name "meta" attributes) + attribute-value))) + (values + `(package + (name ,name) + (version ,version) + (source (origin + (method url-fetch) + (uri ,(pretty-uri (car urls) version)) + (sha256 + (base32 + ,(bytevector->nix-base32-string sha256))))) + (build-system gnu-build-system) + + ;; When doing a native Nixpkgs build, `buildInputs' is empty and + ;; everything is in `nativeBuildInputs'. So we can't distinguish + ;; between both, here. + ;; + ;; Note that `nativeBuildInputs' was renamed from + ;; `buildNativeInputs' in Nixpkgs sometime around March 2013. + ,@(maybe-inputs 'inputs + (convert-inputs "nativeBuildInputs")) + ,@(maybe-inputs 'propagated-inputs + (convert-inputs "propagatedNativeBuildInputs")) + + (home-page ,(and=> (find-attribute-by-name "homepage" meta) + attribute-value)) + (synopsis + ;; For GNU packages, prefer the official synopsis. + ,(or (false-if-exception + (and=> (find (lambda (gnu-package) + (equal? (gnu-package-name gnu-package) + name)) + (official-gnu-packages)) + gnu-package-doc-summary)) + (and=> (find-attribute-by-name "description" meta) + attribute-value))) + (description + ;; Likewise, prefer the official description of GNU packages. + ,(or (false-if-exception + (and=> (find (lambda (gnu-package) + (equal? (gnu-package-name gnu-package) + name)) + (official-gnu-packages)) + gnu-package-doc-description)) + (and=> (find-attribute-by-name "longDescription" meta) + attribute-value))) + (license ,(and=> (find-attribute-by-name "license" meta) + (compose license-variable attribute-value)))) + loc)))))) + +(define (nixpkgs->guix-package nixpkgs attribute) + "Evaluate ATTRIBUTE in NIXPKGS, the file name of a Nixpkgs checkout, +and return the `package' s-expression corresponding to that package." + (let ((port (open-nixpkgs nixpkgs attribute))) + (match (xml->snix port) + (('snix loc (and drv ('derivation _ ...))) + (and (not (pipe-failed? port)) + (snix-derivation->guix-package drv))) + (_ + (not (pipe-failed? port)))))) + +;;; snix.scm ends here diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 6f75017..296d10c 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -1,5 +1,6 @@ ;;; 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. ;;; @@ -18,8 +19,9 @@ (define-module (guix scripts import) #:use-module (guix ui) - #:use-module (guix snix) #:use-module (guix utils) + #:use-module (guix scripts import nix) + #:use-module (guix scripts import pypi) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) @@ -61,15 +63,19 @@ rather than \\n." \f ;;; -;;; Command-line options. +;;; Entry point. ;;; -(define %default-options - '()) +(define importers + `(("nix" . ,guix-import-nix) + ("pypi" . ,guix-import-pypi))) (define (show-help) - (display (_ "Usage: guix import NIXPKGS ATTRIBUTE -Import and convert the Nix expression ATTRIBUTE of NIXPKGS.\n")) + (display (_ "Usage: guix import IMPORTER ARGS ... +Run IMPORTER with ARGS.\n")) + (newline) + (display (_ "IMPORTER must be one of the importers listed below:\n")) + (format #t "~{ ~a~%~}" (map car importers)) (display (_ " -h, --help display this help and exit")) (display (_ " @@ -77,43 +83,16 @@ Import and convert the Nix expression ATTRIBUTE of NIXPKGS.\n")) (newline) (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"))))) - -\f -;;; -;;; Entry point. -;;; - (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 - ((nixpkgs attribute) - (let-values (((expr loc) - (nixpkgs->guix-package nixpkgs attribute))) - (format #t ";; converted from ~a:~a~%~%" - (location-file loc) (location-line loc)) - (pretty-print expr (newline-rewriting-port (current-output-port))))) - (_ - (leave (_ "wrong number of arguments~%")))))) + (match args + (() + (format (current-error-port) + (_ "guix import: missing importer name~%"))) + ((or ("-h") ("--help")) + (show-help) + (exit 0)) + (("--version") + (show-version-and-exit "guix import")) + ((importer args ...) + (let ((expr (apply (assoc-ref importers importer) args))) + (pretty-print expr (newline-rewriting-port (current-output-port))))))) diff --git a/guix/scripts/import/nix.scm b/guix/scripts/import/nix.scm new file mode 100644 index 0000000..2097952 --- /dev/null +++ b/guix/scripts/import/nix.scm @@ -0,0 +1,87 @@ +;;; 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 (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:export (guix-import-nix)) + +\f +;;; +;;; 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. + (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 nix"))))) + +\f +;;; +;;; 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~%")))))) diff --git a/guix/scripts/import/pypi.scm b/guix/scripts/import/pypi.scm new file mode 100644 index 0000000..970b8c2 --- /dev/null +++ b/guix/scripts/import/pypi.scm @@ -0,0 +1,80 @@ +;;; 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 (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:export (guix-import-pypi)) + +\f +;;; +;;; 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. + (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 pypi"))))) + +\f +;;; +;;; 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))))) diff --git a/guix/snix.scm b/guix/snix.scm deleted file mode 100644 index a77433b..0000000 --- a/guix/snix.scm +++ /dev/null @@ -1,474 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2010, 2011, 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 snix) - #:use-module (sxml ssax) - #:use-module (ice-9 popen) - #:use-module (ice-9 match) - #:use-module (ice-9 rdelim) - #:use-module (ice-9 format) - #:use-module (ice-9 regex) - #:use-module (ice-9 vlist) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-9) - #:use-module (srfi srfi-11) - #:use-module (srfi srfi-26) - #:use-module (srfi srfi-37) - #:use-module (system foreign) - #:use-module (rnrs bytevectors) - #:use-module (guix utils) - #:use-module (guix base32) - #:use-module (guix config) - #:use-module (guix gnu-maintenance) - #:export (open-nixpkgs - xml->snix - nixpkgs->guix-package)) - -;;; Commentary: -;;; -;;; Converting Nix code to s-expressions, and then to Guix `package' -;;; declarations, using the XML output of `nix-instantiate'. -;;; -;;; Code: - -\f -;;; -;;; SNix. -;;; - -;; Nix object types visible in the XML output of `nix-instantiate' and -;; mapping to S-expressions (we map to sexps, not records, so that we -;; can do pattern matching): -;; -;; at (at varpat attrspat) -;; attr (attribute loc name value) -;; attrs (attribute-set attributes) -;; attrspat (attribute-set-pattern patterns) -;; bool #f|#t -;; derivation (derivation drv-path out-path attributes) -;; ellipsis '... -;; expr (snix loc body ...) -;; function (function loc at|attrspat|varpat) -;; int int -;; list list -;; null 'null -;; path string -;; string string -;; unevaluated 'unevaluated -;; varpat (varpat name) -;; -;; Initially ATTRIBUTES in `derivation' and `attribute-set' was a promise; -;; however, handling `repeated' nodes makes it impossible to do anything -;; lazily because the whole SXML tree has to be traversed to maintain the -;; list of known derivations. - -(define (xml-element->snix elem attributes body derivations) - "Return an SNix element corresponding to XML element ELEM." - - (define (loc) - (location (assq-ref attributes 'path) - (assq-ref attributes 'line) - (assq-ref attributes 'column))) - - (case elem - ((at) - (values `(at ,(car body) ,(cadr body)) derivations)) - ((attr) - (let ((name (assq-ref attributes 'name))) - (cond ((null? body) - (values `(attribute-pattern ,name) derivations)) - ((and (pair? body) (null? (cdr body))) - (values `(attribute ,(loc) ,name ,(car body)) - derivations)) - (else - (error "invalid attribute body" name (loc) body))))) - ((attrs) - (values `(attribute-set ,(reverse body)) derivations)) - ((attrspat) - (values `(attribute-set-pattern ,body) derivations)) - ((bool) - (values (string-ci=? "true" (assq-ref attributes 'value)) - derivations)) - ((derivation) - (let ((drv-path (assq-ref attributes 'drvPath)) - (out-path (assq-ref attributes 'outPath))) - (if (equal? body '(repeated)) - (let ((body (vhash-assoc drv-path derivations))) - (if (pair? body) - (values `(derivation ,drv-path ,out-path ,(cdr body)) - derivations) - - ;; DRV-PATH hasn't been encountered yet but may be later - ;; (see <http://article.gmane.org/gmane.linux.distributions.nixos/5946>.) - ;; Return an `unresolved' node. - (values `(unresolved - ,(lambda (derivations) - (let ((body (vhash-assoc drv-path derivations))) - (if (pair? body) - `(derivation ,drv-path ,out-path - ,(cdr body)) - (error "no previous occurrence of derivation" - drv-path))))) - derivations))) - (values `(derivation ,drv-path ,out-path ,body) - (vhash-cons drv-path body derivations))))) - ((ellipsis) - (values '... derivations)) - ((expr) - (values `(snix ,(loc) ,@body) derivations)) - ((function) - (values `(function ,(loc) ,body) derivations)) - ((int) - (values (string->number (assq-ref attributes 'value)) - derivations)) - ((list) - (values body derivations)) - ((null) - (values 'null derivations)) - ((path) - (values (assq-ref attributes 'value) derivations)) - ((repeated) - (values 'repeated derivations)) - ((string) - (values (assq-ref attributes 'value) derivations)) - ((unevaluated) - (values 'unevaluated derivations)) - ((varpat) - (values `(varpat ,(assq-ref attributes 'name)) derivations)) - (else (error "unhandled Nix XML element" elem)))) - -(define (resolve snix derivations) - "Return a new SNix tree where `unresolved' nodes from SNIX have been -replaced by the result of their application to DERIVATIONS, a vhash." - (let loop ((node snix) - (seen vlist-null)) - (if (vhash-assq node seen) - (values node seen) - (match node - (('unresolved proc) - (let ((n (proc derivations))) - (values n seen))) - ((tag body ...) - (let ((body+seen (fold (lambda (n body+seen) - (call-with-values - (lambda () - (loop n (cdr body+seen))) - (lambda (n* seen) - (cons (cons n* (car body+seen)) - (vhash-consq n #t seen))))) - (cons '() (vhash-consq node #t seen)) - body))) - (values (cons tag (reverse (car body+seen))) - (vhash-consq node #t (cdr body+seen))))) - (anything - (values anything seen)))))) - -(define xml->snix - (let ((parse - (ssax:make-parser NEW-LEVEL-SEED - (lambda (elem-gi attributes namespaces expected-content - seed) - (cons '() (cdr seed))) - - FINISH-ELEMENT - (lambda (elem-gi attributes namespaces parent-seed - seed) - (let ((snix (car seed)) - (derivations (cdr seed))) - (let-values (((snix derivations) - (xml-element->snix elem-gi - attributes - snix - derivations))) - (cons (cons snix (car parent-seed)) - derivations)))) - - CHAR-DATA-HANDLER - (lambda (string1 string2 seed) - ;; Discard inter-node strings, which are blanks. - seed)))) - (lambda (port) - "Return the SNix represention of TREE, an SXML tree as returned by -parsing the XML output of `nix-instantiate' on Nixpkgs." - (match (parse port (cons '() vlist-null)) - (((snix) . derivations) - (resolve snix derivations)))))) - -(define (attribute-value attribute) - "Return the value of ATTRIBUTE." - (match attribute - (('attribute _ _ value) value))) - -(define (derivation-source derivation) - "Return the \"src\" attribute of DERIVATION or #f if not found." - (match derivation - (('derivation _ _ (attributes ...)) - (find-attribute-by-name "src" attributes)))) - -(define (derivation-output-path derivation) - "Return the output path of DERIVATION." - (match derivation - (('derivation _ out-path _) - out-path) - (_ #f))) - -(define (source-output-path src) - "Return the output path of SRC, the \"src\" attribute of a derivation." - (derivation-output-path (attribute-value src))) - -(define (source-urls src) - "Return the URLs of SRC, the \"src\" attribute of a derivation." - (match src - (('attribute _ _ ('derivation _ _ (attributes ...))) - (match (find-attribute-by-name "urls" attributes) - (('attribute _ _ value) - value))) - (_ #f))) - -(define (source-sha256 src) - "Return the sha256 of SRC, the \"src\" attribute of a derivation, as a -bytevector." - (match src - (('attribute _ _ ('derivation _ _ (attributes ...))) - (match (find-attribute-by-name "outputHash" attributes) - (('attribute _ _ value) - (match value - ((= string-length 52) - (nix-base32-string->bytevector value)) - ((= string-length 64) - (base16-string->bytevector value)) - (_ - (error "unsupported hash format" value)))))) - (_ #f))) - -(define (derivation-source-output-path derivation) - "Return the output path of the \"src\" attribute of DERIVATION or #f -if DERIVATION lacks an \"src\" attribute." - (and=> (derivation-source derivation) source-output-path)) - -(define* (open-nixpkgs nixpkgs #:optional attribute) - "Return an input pipe to the XML representation of Nixpkgs. When -ATTRIBUTE is true, only that attribute is considered." - (with-fluids ((%default-port-encoding "UTF-8")) - (let ((cross-system (format #f "{ - config = \"i686-guix-linux-gnu\"; - libc = \"glibc\"; - arch = \"guix\"; - withTLS = true; - float = \"hard\"; - openssl.system = \"linux-generic32\"; - platform = (import ~a/pkgs/top-level/platforms.nix).sheevaplug; -}" nixpkgs))) - (apply open-pipe* OPEN_READ - %nix-instantiate "--strict" "--eval-only" "--xml" - - ;; Pass a dummy `crossSystem' argument so that `buildInputs' and - ;; `nativeBuildInputs' are not coalesced. - ;; XXX: This is hacky and has other problems. - ;"--arg" "crossSystem" cross-system - - `(,@(if attribute - `("-A" ,attribute) - '()) - ,nixpkgs))))) - -(define (pipe-failed? pipe) - "Close pipe and return its status if it failed." - (let ((status (close-pipe pipe))) - (if (or (status:term-sig status) - (not (= (status:exit-val status) 0))) - status - #f))) - -(define (find-attribute-by-name name attributes) - "Return attribute NAME in ATTRIBUTES, an attribute set or list of SNix -attributes, or #f if NAME cannot be found." - (find (lambda (a) - (match a - (('attribute _ (? (cut string=? <> name)) _) - a) - (_ #f))) - (match attributes - (('attribute-set (attributes ...)) - attributes) - (_ - attributes)))) - -(define (package-source-output-path package) - "Return the output path of the \"src\" derivation of PACKAGE." - (derivation-source-output-path (attribute-value package))) - -\f -;;; -;;; 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) - "Return the `package' s-expression corresponding to SNix DERIVATION, a -Nixpkgs `stdenv.mkDerivation'-style derivation, and the original source -location of DERIVATION." - (match derivation - (('derivation _ _ (attributes ...)) - (let*-values (((full-name loc) - (match (find-attribute-by-name "name" attributes) - (('attribute loc _ value) - (values value loc)) - (_ - (values #f #f)))) - ((name version) - (package-name->name+version full-name))) - (define (convert-inputs type) - ;; Convert the derivation's input from a list of SNix derivations to - ;; a list of name/variable pairs. - (match (and=> (find-attribute-by-name type attributes) - attribute-value) - (#f - '()) - ((inputs ...) - ;; Inputs can be either derivations or the null value. - (filter-map (match-lambda - (('derivation _ _ (attributes ...)) - (let* ((full-name - (attribute-value - (find-attribute-by-name "name" attributes))) - (name (package-name->name+version full-name))) - (list name - (list 'unquote (string->symbol name))))) - ('null #f)) - inputs)))) - - (define (maybe-inputs guix-name inputs) - (match inputs - (() - '()) - ((inputs ...) - (list (list guix-name - (list 'quasiquote inputs)))))) - - (define (pretty-uri uri version) - (if version - (match (factorize-uri uri version) - ((items ...) - `(string-append ,@items)) - (x x)) - uri)) - - (define (license-variable license) - ;; Return the name of the (guix licenses) variable for LICENSE. - (match license - ("GPLv2+" 'gpl2+) - ("GPLv3+" 'gpl3+) - ("LGPLv2+" 'lgpl2.1+) - ("LGPLv2.1+" 'lgpl2.1+) - ("LGPLv3+" 'lgpl3+) - (_ license))) - - (let* ((source (find-attribute-by-name "src" attributes)) - (urls (source-urls source)) - (sha256 (source-sha256 source)) - (meta (and=> (find-attribute-by-name "meta" attributes) - attribute-value))) - (values - `(package - (name ,name) - (version ,version) - (source (origin - (method url-fetch) - (uri ,(pretty-uri (car urls) version)) - (sha256 - (base32 - ,(bytevector->nix-base32-string sha256))))) - (build-system gnu-build-system) - - ;; When doing a native Nixpkgs build, `buildInputs' is empty and - ;; everything is in `nativeBuildInputs'. So we can't distinguish - ;; between both, here. - ;; - ;; Note that `nativeBuildInputs' was renamed from - ;; `buildNativeInputs' in Nixpkgs sometime around March 2013. - ,@(maybe-inputs 'inputs - (convert-inputs "nativeBuildInputs")) - ,@(maybe-inputs 'propagated-inputs - (convert-inputs "propagatedNativeBuildInputs")) - - (home-page ,(and=> (find-attribute-by-name "homepage" meta) - attribute-value)) - (synopsis - ;; For GNU packages, prefer the official synopsis. - ,(or (false-if-exception - (and=> (find (lambda (gnu-package) - (equal? (gnu-package-name gnu-package) - name)) - (official-gnu-packages)) - gnu-package-doc-summary)) - (and=> (find-attribute-by-name "description" meta) - attribute-value))) - (description - ;; Likewise, prefer the official description of GNU packages. - ,(or (false-if-exception - (and=> (find (lambda (gnu-package) - (equal? (gnu-package-name gnu-package) - name)) - (official-gnu-packages)) - gnu-package-doc-description)) - (and=> (find-attribute-by-name "longDescription" meta) - attribute-value))) - (license ,(and=> (find-attribute-by-name "license" meta) - (compose license-variable attribute-value)))) - loc)))))) - -(define (nixpkgs->guix-package nixpkgs attribute) - "Evaluate ATTRIBUTE in NIXPKGS, the file name of a Nixpkgs checkout, -and return the `package' s-expression corresponding to that package." - (let ((port (open-nixpkgs nixpkgs attribute))) - (match (xml->snix port) - (('snix loc (and drv ('derivation _ ...))) - (and (not (pipe-failed? port)) - (snix-derivation->guix-package drv))) - (_ - (not (pipe-failed? port)))))) - -;;; snix.scm ends here -- 2.1.0 [-- Attachment #3: Type: text/plain, Size: 189 bytes --] Thanks in advance for the review, it's a big patch. -- David Thompson Web Developer - Free Software Foundation - http://fsf.org GPG Key: 0FF1D807 Support the FSF: https://fsf.org/donate ^ permalink raw reply related [flat|nested] 12+ messages in thread
* Re: [PATCH] import: Add PyPI importer. 2014-09-27 21:15 [PATCH] import: Add PyPI importer David Thompson @ 2014-09-27 21:19 ` David Thompson 2014-09-27 21:35 ` Ludovic Courtès 2014-09-27 21:49 ` Ludovic Courtès 1 sibling, 1 reply; 12+ messages in thread From: David Thompson @ 2014-09-27 21:19 UTC (permalink / raw) To: guix-devel I should mention that the PyPI import requires the guile-json library. How should this be handled in our build scripts? -- David Thompson Web Developer - Free Software Foundation - http://fsf.org GPG Key: 0FF1D807 Support the FSF: https://fsf.org/donate ^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [PATCH] import: Add PyPI importer. 2014-09-27 21:19 ` David Thompson @ 2014-09-27 21:35 ` Ludovic Courtès 2014-09-29 11:23 ` David Thompson 0 siblings, 1 reply; 12+ messages in thread From: Ludovic Courtès @ 2014-09-27 21:35 UTC (permalink / raw) To: David Thompson; +Cc: guix-devel David Thompson <dthompson2@worcester.edu> skribis: > I should mention that the PyPI import requires the guile-json library. > How should this be handled in our build scripts? I think it’s fine to install it whether or not guile-json is available. Now, when there are tests ;-), there’ll have to be an Automake conditional to decide whether or not to run those tests that require guile-json. Ludo’. ^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [PATCH] import: Add PyPI importer. 2014-09-27 21:35 ` Ludovic Courtès @ 2014-09-29 11:23 ` David Thompson 2014-09-29 12:24 ` Ludovic Courtès 0 siblings, 1 reply; 12+ messages in thread From: David Thompson @ 2014-09-29 11:23 UTC (permalink / raw) To: Ludovic Courtès; +Cc: guix-devel Ludovic Courtès <ludo@gnu.org> writes: > David Thompson <dthompson2@worcester.edu> skribis: > >> I should mention that the PyPI import requires the guile-json library. >> How should this be handled in our build scripts? > > I think it’s fine to install it whether or not guile-json is available. > Now, when there are tests ;-), there’ll have to be an Automake > conditional to decide whether or not to run those tests that require > guile-json. Oh yeah, almost forgot about the Automake rule! My autotools skills are weak so I'm not sure how to write this. Could you point me in the right direction? Thanks! -- David Thompson Web Developer - Free Software Foundation - http://fsf.org GPG Key: 0FF1D807 Support the FSF: https://fsf.org/donate ^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [PATCH] import: Add PyPI importer. 2014-09-29 11:23 ` David Thompson @ 2014-09-29 12:24 ` Ludovic Courtès 2014-09-29 23:31 ` David Thompson 0 siblings, 1 reply; 12+ messages in thread From: Ludovic Courtès @ 2014-09-29 12:24 UTC (permalink / raw) To: David Thompson; +Cc: guix-devel David Thompson <dthompson2@worcester.edu> skribis: > Ludovic Courtès <ludo@gnu.org> writes: > >> David Thompson <dthompson2@worcester.edu> skribis: >> >>> I should mention that the PyPI import requires the guile-json library. >>> How should this be handled in our build scripts? >> >> I think it’s fine to install it whether or not guile-json is available. >> Now, when there are tests ;-), there’ll have to be an Automake >> conditional to decide whether or not to run those tests that require >> guile-json. > > Oh yeah, almost forgot about the Automake rule! My autotools skills are > weak so I'm not sure how to write this. Could you point me in the right > direction? In configure.ac, do something like: GUILE_MODULE_AVAILABLE([have_guile_json], [(json)]) AM_CONDITIONAL([HAVE_GUILE_JSON], [text "x$have_guile_json" = "xyes"]) and in Makefile.am: if HAVE_GUILE_JSON TESTS += tests/pypi.scm endif Ludo’. ^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [PATCH] import: Add PyPI importer. 2014-09-29 12:24 ` Ludovic Courtès @ 2014-09-29 23:31 ` David Thompson 2014-09-30 5:49 ` Alex Kost 0 siblings, 1 reply; 12+ messages in thread From: David Thompson @ 2014-09-29 23:31 UTC (permalink / raw) To: Ludovic Courtès; +Cc: guix-devel Ludovic Courtès <ludo@gnu.org> writes: > David Thompson <dthompson2@worcester.edu> skribis: > >> Oh yeah, almost forgot about the Automake rule! My autotools skills are >> weak so I'm not sure how to write this. Could you point me in the right >> direction? > > In configure.ac, do something like: > > GUILE_MODULE_AVAILABLE([have_guile_json], [(json)]) > AM_CONDITIONAL([HAVE_GUILE_JSON], [text "x$have_guile_json" = "xyes"]) > > and in Makefile.am: > > if HAVE_GUILE_JSON > TESTS += tests/pypi.scm > endif Done and pushed! Thanks! -- David Thompson Web Developer - Free Software Foundation - http://fsf.org GPG Key: 0FF1D807 Support the FSF: https://fsf.org/donate ^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [PATCH] import: Add PyPI importer. 2014-09-29 23:31 ` David Thompson @ 2014-09-30 5:49 ` Alex Kost 2014-09-30 7:13 ` Ludovic Courtès 2014-09-30 11:55 ` David Thompson 0 siblings, 2 replies; 12+ messages in thread From: Alex Kost @ 2014-09-30 5:49 UTC (permalink / raw) To: David Thompson; +Cc: guix-devel [-- Attachment #1: Type: text/plain, Size: 845 bytes --] David Thompson (2014-09-30 03:31 +0400) wrote: > Ludovic Courtès <ludo@gnu.org> writes: > >> David Thompson <dthompson2@worcester.edu> skribis: >> >>> Oh yeah, almost forgot about the Automake rule! My autotools skills are >>> weak so I'm not sure how to write this. Could you point me in the right >>> direction? >> >> In configure.ac, do something like: >> >> GUILE_MODULE_AVAILABLE([have_guile_json], [(json)]) >> AM_CONDITIONAL([HAVE_GUILE_JSON], [text "x$have_guile_json" = "xyes"]) >> >> and in Makefile.am: >> >> if HAVE_GUILE_JSON >> TESTS += tests/pypi.scm >> endif > > Done and pushed! Thanks! Hello, I don't have guile-json and "make" has failed for me because (guix import pypi) wants json module. Is it required now? Perhaps it would be safe (?) to adjust “Makefile.am” like this: [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-build-Build-pypi-modules-only-if-guile-json-is-avail.patch --] [-- Type: text/x-diff, Size: 1169 bytes --] From 85054932667d57224dde1d18c381d7d7c0a95dd4 Mon Sep 17 00:00:00 2001 From: Alex Kost <alezost@gmail.com> Date: Tue, 30 Sep 2014 09:41:59 +0400 Subject: [PATCH] build: Build pypi modules only if 'guile-json' is available. * Makefile.am (MODULES): Wrap 'guix/import/pypi.scm' and 'guix/scripts/import/pypi.scm' in 'if HAVE_GUILE_JSON'. --- Makefile.am | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/Makefile.am b/Makefile.am index a1a87c0..eba34af 100644 --- a/Makefile.am +++ b/Makefile.am @@ -77,7 +77,6 @@ MODULES = \ guix/packages.scm \ guix/import/utils.scm \ guix/import/snix.scm \ - guix/import/pypi.scm \ guix/scripts/download.scm \ guix/scripts/build.scm \ guix/scripts/archive.scm \ @@ -92,7 +91,6 @@ MODULES = \ guix/scripts/system.scm \ guix/scripts/lint.scm \ guix/scripts/import/nix.scm \ - guix/scripts/import/pypi.scm \ guix.scm \ $(GNU_SYSTEM_MODULES) @@ -168,6 +166,10 @@ SCM_TESTS = \ if HAVE_GUILE_JSON +MODULES += \ + guix/import/pypi.scm \ + guix/scripts/import/pypi.scm + SCM_TESTS += tests/pypi.scm endif -- 2.1.0 ^ permalink raw reply related [flat|nested] 12+ messages in thread
* Re: [PATCH] import: Add PyPI importer. 2014-09-30 5:49 ` Alex Kost @ 2014-09-30 7:13 ` Ludovic Courtès 2014-09-30 11:55 ` David Thompson 1 sibling, 0 replies; 12+ messages in thread From: Ludovic Courtès @ 2014-09-30 7:13 UTC (permalink / raw) To: Alex Kost; +Cc: guix-devel [-- Attachment #1: Type: text/plain, Size: 959 bytes --] Alex Kost <alezost@gmail.com> skribis: > David Thompson (2014-09-30 03:31 +0400) wrote: > >> Ludovic Courtès <ludo@gnu.org> writes: >> >>> David Thompson <dthompson2@worcester.edu> skribis: >>> >>>> Oh yeah, almost forgot about the Automake rule! My autotools skills are >>>> weak so I'm not sure how to write this. Could you point me in the right >>>> direction? >>> >>> In configure.ac, do something like: >>> >>> GUILE_MODULE_AVAILABLE([have_guile_json], [(json)]) >>> AM_CONDITIONAL([HAVE_GUILE_JSON], [text "x$have_guile_json" = "xyes"]) >>> >>> and in Makefile.am: >>> >>> if HAVE_GUILE_JSON >>> TESTS += tests/pypi.scm >>> endif >> >> Done and pushed! Thanks! Woo! > Hello, I don't have guile-json and "make" has failed for me because > (guix import pypi) wants json module. Is it required now? > > Perhaps it would be safe (?) to adjust “Makefile.am” like this: Alternately, we could do this: [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: Type: text/x-patch, Size: 403 bytes --] diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index d0e776e..da8bd04 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -23,7 +23,7 @@ #:use-module (ice-9 regex) #:use-module (srfi srfi-1) #:use-module (rnrs bytevectors) - #:use-module (json) + #:autoload (json) (json->scm) #:use-module (web uri) #:use-module (guix utils) #:use-module (guix import utils) [-- Attachment #3: Type: text/plain, Size: 305 bytes --] That way, the importer would still be compiled (with a warning) and installed, so that if the user eventually installed guile-json, it will work. However, that would fail with old Guile versions: <http://bugs.gnu.org/12202>. So your patch is probably the right way. OK to commit! Ludo’. ^ permalink raw reply related [flat|nested] 12+ messages in thread
* Re: [PATCH] import: Add PyPI importer. 2014-09-30 5:49 ` Alex Kost 2014-09-30 7:13 ` Ludovic Courtès @ 2014-09-30 11:55 ` David Thompson 1 sibling, 0 replies; 12+ messages in thread From: David Thompson @ 2014-09-30 11:55 UTC (permalink / raw) To: Alex Kost; +Cc: guix-devel Alex Kost <alezost@gmail.com> writes: > Hello, I don't have guile-json and "make" has failed for me because > (guix import pypi) wants json module. Is it required now? > > Perhaps it would be safe (?) to adjust “Makefile.am” like this: > Sorry about that. Thanks for fixing it! -- David Thompson Web Developer - Free Software Foundation - http://fsf.org GPG Key: 0FF1D807 Support the FSF: https://fsf.org/donate ^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [PATCH] import: Add PyPI importer. 2014-09-27 21:15 [PATCH] import: Add PyPI importer David Thompson 2014-09-27 21:19 ` David Thompson @ 2014-09-27 21:49 ` Ludovic Courtès 2014-09-28 23:48 ` David Thompson 1 sibling, 1 reply; 12+ messages in thread From: Ludovic Courtès @ 2014-09-27 21:49 UTC (permalink / raw) To: David Thompson; +Cc: guix-devel David Thompson <dthompson2@worcester.edu> skribis: > I spent my day working on generalizing the 'guix import' UI to allow for > using a PyPI importer in addition to the pre-existing Nix importer. > It's now at the point where I stop coding and open it up for review. :) Heheh, cool! :-) Overall looks good to me. Some comments below: > From b3ec259fd097034631cf311040af7aa12f7c5ebc Mon Sep 17 00:00:00 2001 > From: David Thompson <dthompson2@worcester.edu> > Date: Sat, 27 Sep 2014 10:16:23 -0400 > Subject: [PATCH] import: Add PyPI importer. > > * guix/snix.scm: Delete. > * guix/import/snix.scm: New file. > * guix/scripts/import/nix.scm: New file. This is good. > * guix/import/pypi.scm: New file. > * guix/scripts/import/pypi.scm: New file. Nice too. I wonder if there may be shared options between all the importers (like an option for import & live build.) That can still be addressed by exporting an option list from (guix scripts import), like (guix scripts build) does, I think. > * Makefile.am (MODULES): Add new files and remove 'guix/snix.scm'. > * guix/scripts/import.scm (%default-options, %options): Delete. > (importers): New variable. > (show-help): List importers. > (guix-import): Factor out Nix-specific logic. Delegate to correct importer > based upon first argument. Make sure to adjust tests/snix.scm. Also, it’d be cool to have tests for (guix import pypi), at least for the part that is concerned with parsing JSON and producing a package object. > +(define tarball-url->string-append > + (let ((tar.gz-regex (make-regexp "\\.tar\\.gz$")) > + (tarball-regex (make-regexp ".*-(.*)\\.tar\\.gz"))) > + (lambda (url name version) > + "Return a `string-append' s-expression used for building a generic form > +of URL for the package NAME where VERSION is replaced by a `version' > +variable." This is similar to what snix has, and i think it should be shared (see below.) > +(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, Namely, what do you think of having importers return directly a ‘package’ object? Then there could be a shared ‘package->sexp’ procedure, that would to the fancy ‘string-append’ thing like above. And, eventually, we can add an option to do live builds of the generated package objects. That can also be done in the next iteration, though. > +(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." This one from snix is redundant with ‘tarball-url->string-append’ (and maybe less sophisticated?). Thanks! Ludo’. ^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [PATCH] import: Add PyPI importer. 2014-09-27 21:49 ` Ludovic Courtès @ 2014-09-28 23:48 ` David Thompson 2014-09-29 7:04 ` Ludovic Courtès 0 siblings, 1 reply; 12+ messages in thread From: David Thompson @ 2014-09-28 23:48 UTC (permalink / raw) To: Ludovic Courtès; +Cc: guix-devel [-- Attachment #1: Type: text/plain, Size: 2636 bytes --] Ludovic Courtès <ludo@gnu.org> writes: > I wonder if there may be shared options between all the importers > (like an option for import & live build.) > > That can still be addressed by exporting an option list from (guix > scripts import), like (guix scripts build) does, I think. > Done. Added an empty options list for now. To avoid circular dependencies, I had to lazily resolve the importer procedures in guix/scripts/import.scm. >> * Makefile.am (MODULES): Add new files and remove 'guix/snix.scm'. >> * guix/scripts/import.scm (%default-options, %options): Delete. >> (importers): New variable. >> (show-help): List importers. >> (guix-import): Factor out Nix-specific logic. Delegate to correct importer >> based upon first argument. > > Make sure to adjust tests/snix.scm. > > Also, it’d be cool to have tests for (guix import pypi), at least for > the part that is concerned with parsing JSON and producing a package > object. > Done. >> +(define tarball-url->string-append >> + (let ((tar.gz-regex (make-regexp "\\.tar\\.gz$")) >> + (tarball-regex (make-regexp ".*-(.*)\\.tar\\.gz"))) >> + (lambda (url name version) >> + "Return a `string-append' s-expression used for building a generic form >> +of URL for the package NAME where VERSION is replaced by a `version' >> +variable." > > This is similar to what snix has, and i think it should be shared (see > below.) > >> +(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, > > Namely, what do you think of having importers return directly a > ‘package’ object? Then there could be a shared ‘package->sexp’ > procedure, that would to the fancy ‘string-append’ thing like above. > > And, eventually, we can add an option to do live builds of the generated > package objects. > > That can also be done in the next iteration, though. > I think this is best saved for another patch since it involves modifying the snix code. I agree that it is a good idea. >> +(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." > > This one from snix is redundant with ‘tarball-url->string-append’ (and > maybe less sophisticated?). > 'factorize-uri' is better, so I'm using that now. I created a new module '(guix import utils)' for commonly used import procedures. New patch attached. [-- Attachment #2: 0001-import-Add-PyPI-importer.patch --] [-- Type: text/x-diff, Size: 64490 bytes --] From 0696b70fd31630791b5125625a3a15ea0dfdaf1d Mon Sep 17 00:00:00 2001 From: David Thompson <dthompson2@worcester.edu> Date: Sat, 27 Sep 2014 10:16:23 -0400 Subject: [PATCH] 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. * Makefile.am (MODULES): Add new files and remove 'guix/snix.scm'. (SCM_TESTS): Add 'tests/pypi.scm'. * 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. --- Makefile.am | 9 +- guix/import/pypi.scm | 169 +++++++++++++++ guix/import/snix.scm | 447 ++++++++++++++++++++++++++++++++++++++++ guix/import/utils.scm | 51 +++++ guix/scripts/import.scm | 85 ++++---- guix/scripts/import/nix.scm | 89 ++++++++ guix/scripts/import/pypi.scm | 83 ++++++++ guix/snix.scm | 474 ------------------------------------------- tests/pypi.scm | 102 ++++++++++ tests/snix.scm | 4 +- 10 files changed, 989 insertions(+), 524 deletions(-) create mode 100644 guix/import/pypi.scm create mode 100644 guix/import/snix.scm create mode 100644 guix/import/utils.scm create mode 100644 guix/scripts/import/nix.scm create mode 100644 guix/scripts/import/pypi.scm delete mode 100644 guix/snix.scm create mode 100644 tests/pypi.scm diff --git a/Makefile.am b/Makefile.am index 3c22a77..2925171 100644 --- a/Makefile.am +++ b/Makefile.am @@ -75,7 +75,9 @@ MODULES = \ guix/build/syscalls.scm \ guix/build/emacs-utils.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/build.scm \ guix/scripts/archive.scm \ @@ -89,6 +91,8 @@ MODULES = \ guix/scripts/refresh.scm \ guix/scripts/system.scm \ guix/scripts/lint.scm \ + guix/scripts/import/nix.scm \ + guix/scripts/import/pypi.scm \ guix.scm \ $(GNU_SYSTEM_MODULES) @@ -160,7 +164,8 @@ SCM_TESTS = \ tests/union.scm \ tests/profiles.scm \ tests/syscalls.scm \ - tests/lint.scm + tests/lint.scm \ + tests/pypi.scm SH_TESTS = \ tests/guix-build.sh \ diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm new file mode 100644 index 0000000..d0e776e --- /dev/null +++ b/guix/import/pypi.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)))) diff --git a/guix/import/snix.scm b/guix/import/snix.scm new file mode 100644 index 0000000..bcc4d6b --- /dev/null +++ b/guix/import/snix.scm @@ -0,0 +1,447 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2010, 2011, 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 snix) + #:use-module (sxml ssax) + #:use-module (ice-9 popen) + #:use-module (ice-9 match) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 format) + #:use-module (ice-9 regex) + #:use-module (ice-9 vlist) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-37) + #:use-module (system foreign) + #:use-module (rnrs bytevectors) + #:use-module (guix utils) + #:use-module (guix import utils) + #:use-module (guix base32) + #:use-module (guix config) + #:use-module (guix gnu-maintenance) + #:export (open-nixpkgs + xml->snix + nixpkgs->guix-package)) + +;;; Commentary: +;;; +;;; Converting Nix code to s-expressions, and then to Guix `package' +;;; declarations, using the XML output of `nix-instantiate'. +;;; +;;; Code: + +\f +;;; +;;; SNix. +;;; + +;; Nix object types visible in the XML output of `nix-instantiate' and +;; mapping to S-expressions (we map to sexps, not records, so that we +;; can do pattern matching): +;; +;; at (at varpat attrspat) +;; attr (attribute loc name value) +;; attrs (attribute-set attributes) +;; attrspat (attribute-set-pattern patterns) +;; bool #f|#t +;; derivation (derivation drv-path out-path attributes) +;; ellipsis '... +;; expr (snix loc body ...) +;; function (function loc at|attrspat|varpat) +;; int int +;; list list +;; null 'null +;; path string +;; string string +;; unevaluated 'unevaluated +;; varpat (varpat name) +;; +;; Initially ATTRIBUTES in `derivation' and `attribute-set' was a promise; +;; however, handling `repeated' nodes makes it impossible to do anything +;; lazily because the whole SXML tree has to be traversed to maintain the +;; list of known derivations. + +(define (xml-element->snix elem attributes body derivations) + "Return an SNix element corresponding to XML element ELEM." + + (define (loc) + (location (assq-ref attributes 'path) + (assq-ref attributes 'line) + (assq-ref attributes 'column))) + + (case elem + ((at) + (values `(at ,(car body) ,(cadr body)) derivations)) + ((attr) + (let ((name (assq-ref attributes 'name))) + (cond ((null? body) + (values `(attribute-pattern ,name) derivations)) + ((and (pair? body) (null? (cdr body))) + (values `(attribute ,(loc) ,name ,(car body)) + derivations)) + (else + (error "invalid attribute body" name (loc) body))))) + ((attrs) + (values `(attribute-set ,(reverse body)) derivations)) + ((attrspat) + (values `(attribute-set-pattern ,body) derivations)) + ((bool) + (values (string-ci=? "true" (assq-ref attributes 'value)) + derivations)) + ((derivation) + (let ((drv-path (assq-ref attributes 'drvPath)) + (out-path (assq-ref attributes 'outPath))) + (if (equal? body '(repeated)) + (let ((body (vhash-assoc drv-path derivations))) + (if (pair? body) + (values `(derivation ,drv-path ,out-path ,(cdr body)) + derivations) + + ;; DRV-PATH hasn't been encountered yet but may be later + ;; (see <http://article.gmane.org/gmane.linux.distributions.nixos/5946>.) + ;; Return an `unresolved' node. + (values `(unresolved + ,(lambda (derivations) + (let ((body (vhash-assoc drv-path derivations))) + (if (pair? body) + `(derivation ,drv-path ,out-path + ,(cdr body)) + (error "no previous occurrence of derivation" + drv-path))))) + derivations))) + (values `(derivation ,drv-path ,out-path ,body) + (vhash-cons drv-path body derivations))))) + ((ellipsis) + (values '... derivations)) + ((expr) + (values `(snix ,(loc) ,@body) derivations)) + ((function) + (values `(function ,(loc) ,body) derivations)) + ((int) + (values (string->number (assq-ref attributes 'value)) + derivations)) + ((list) + (values body derivations)) + ((null) + (values 'null derivations)) + ((path) + (values (assq-ref attributes 'value) derivations)) + ((repeated) + (values 'repeated derivations)) + ((string) + (values (assq-ref attributes 'value) derivations)) + ((unevaluated) + (values 'unevaluated derivations)) + ((varpat) + (values `(varpat ,(assq-ref attributes 'name)) derivations)) + (else (error "unhandled Nix XML element" elem)))) + +(define (resolve snix derivations) + "Return a new SNix tree where `unresolved' nodes from SNIX have been +replaced by the result of their application to DERIVATIONS, a vhash." + (let loop ((node snix) + (seen vlist-null)) + (if (vhash-assq node seen) + (values node seen) + (match node + (('unresolved proc) + (let ((n (proc derivations))) + (values n seen))) + ((tag body ...) + (let ((body+seen (fold (lambda (n body+seen) + (call-with-values + (lambda () + (loop n (cdr body+seen))) + (lambda (n* seen) + (cons (cons n* (car body+seen)) + (vhash-consq n #t seen))))) + (cons '() (vhash-consq node #t seen)) + body))) + (values (cons tag (reverse (car body+seen))) + (vhash-consq node #t (cdr body+seen))))) + (anything + (values anything seen)))))) + +(define xml->snix + (let ((parse + (ssax:make-parser NEW-LEVEL-SEED + (lambda (elem-gi attributes namespaces expected-content + seed) + (cons '() (cdr seed))) + + FINISH-ELEMENT + (lambda (elem-gi attributes namespaces parent-seed + seed) + (let ((snix (car seed)) + (derivations (cdr seed))) + (let-values (((snix derivations) + (xml-element->snix elem-gi + attributes + snix + derivations))) + (cons (cons snix (car parent-seed)) + derivations)))) + + CHAR-DATA-HANDLER + (lambda (string1 string2 seed) + ;; Discard inter-node strings, which are blanks. + seed)))) + (lambda (port) + "Return the SNix represention of TREE, an SXML tree as returned by +parsing the XML output of `nix-instantiate' on Nixpkgs." + (match (parse port (cons '() vlist-null)) + (((snix) . derivations) + (resolve snix derivations)))))) + +(define (attribute-value attribute) + "Return the value of ATTRIBUTE." + (match attribute + (('attribute _ _ value) value))) + +(define (derivation-source derivation) + "Return the \"src\" attribute of DERIVATION or #f if not found." + (match derivation + (('derivation _ _ (attributes ...)) + (find-attribute-by-name "src" attributes)))) + +(define (derivation-output-path derivation) + "Return the output path of DERIVATION." + (match derivation + (('derivation _ out-path _) + out-path) + (_ #f))) + +(define (source-output-path src) + "Return the output path of SRC, the \"src\" attribute of a derivation." + (derivation-output-path (attribute-value src))) + +(define (source-urls src) + "Return the URLs of SRC, the \"src\" attribute of a derivation." + (match src + (('attribute _ _ ('derivation _ _ (attributes ...))) + (match (find-attribute-by-name "urls" attributes) + (('attribute _ _ value) + value))) + (_ #f))) + +(define (source-sha256 src) + "Return the sha256 of SRC, the \"src\" attribute of a derivation, as a +bytevector." + (match src + (('attribute _ _ ('derivation _ _ (attributes ...))) + (match (find-attribute-by-name "outputHash" attributes) + (('attribute _ _ value) + (match value + ((= string-length 52) + (nix-base32-string->bytevector value)) + ((= string-length 64) + (base16-string->bytevector value)) + (_ + (error "unsupported hash format" value)))))) + (_ #f))) + +(define (derivation-source-output-path derivation) + "Return the output path of the \"src\" attribute of DERIVATION or #f +if DERIVATION lacks an \"src\" attribute." + (and=> (derivation-source derivation) source-output-path)) + +(define* (open-nixpkgs nixpkgs #:optional attribute) + "Return an input pipe to the XML representation of Nixpkgs. When +ATTRIBUTE is true, only that attribute is considered." + (with-fluids ((%default-port-encoding "UTF-8")) + (let ((cross-system (format #f "{ + config = \"i686-guix-linux-gnu\"; + libc = \"glibc\"; + arch = \"guix\"; + withTLS = true; + float = \"hard\"; + openssl.system = \"linux-generic32\"; + platform = (import ~a/pkgs/top-level/platforms.nix).sheevaplug; +}" nixpkgs))) + (apply open-pipe* OPEN_READ + %nix-instantiate "--strict" "--eval-only" "--xml" + + ;; Pass a dummy `crossSystem' argument so that `buildInputs' and + ;; `nativeBuildInputs' are not coalesced. + ;; XXX: This is hacky and has other problems. + ;"--arg" "crossSystem" cross-system + + `(,@(if attribute + `("-A" ,attribute) + '()) + ,nixpkgs))))) + +(define (pipe-failed? pipe) + "Close pipe and return its status if it failed." + (let ((status (close-pipe pipe))) + (if (or (status:term-sig status) + (not (= (status:exit-val status) 0))) + status + #f))) + +(define (find-attribute-by-name name attributes) + "Return attribute NAME in ATTRIBUTES, an attribute set or list of SNix +attributes, or #f if NAME cannot be found." + (find (lambda (a) + (match a + (('attribute _ (? (cut string=? <> name)) _) + a) + (_ #f))) + (match attributes + (('attribute-set (attributes ...)) + attributes) + (_ + attributes)))) + +(define (package-source-output-path package) + "Return the output path of the \"src\" derivation of PACKAGE." + (derivation-source-output-path (attribute-value package))) + +\f +;;; +;;; Conversion of "Nix expressions" to "Guix expressions". +;;; + +(define (snix-derivation->guix-package derivation) + "Return the `package' s-expression corresponding to SNix DERIVATION, a +Nixpkgs `stdenv.mkDerivation'-style derivation, and the original source +location of DERIVATION." + (match derivation + (('derivation _ _ (attributes ...)) + (let*-values (((full-name loc) + (match (find-attribute-by-name "name" attributes) + (('attribute loc _ value) + (values value loc)) + (_ + (values #f #f)))) + ((name version) + (package-name->name+version full-name))) + (define (convert-inputs type) + ;; Convert the derivation's input from a list of SNix derivations to + ;; a list of name/variable pairs. + (match (and=> (find-attribute-by-name type attributes) + attribute-value) + (#f + '()) + ((inputs ...) + ;; Inputs can be either derivations or the null value. + (filter-map (match-lambda + (('derivation _ _ (attributes ...)) + (let* ((full-name + (attribute-value + (find-attribute-by-name "name" attributes))) + (name (package-name->name+version full-name))) + (list name + (list 'unquote (string->symbol name))))) + ('null #f)) + inputs)))) + + (define (maybe-inputs guix-name inputs) + (match inputs + (() + '()) + ((inputs ...) + (list (list guix-name + (list 'quasiquote inputs)))))) + + (define (pretty-uri uri version) + (if version + (match (factorize-uri uri version) + ((items ...) + `(string-append ,@items)) + (x x)) + uri)) + + (define (license-variable license) + ;; Return the name of the (guix licenses) variable for LICENSE. + (match license + ("GPLv2+" 'gpl2+) + ("GPLv3+" 'gpl3+) + ("LGPLv2+" 'lgpl2.1+) + ("LGPLv2.1+" 'lgpl2.1+) + ("LGPLv3+" 'lgpl3+) + (_ license))) + + (let* ((source (find-attribute-by-name "src" attributes)) + (urls (source-urls source)) + (sha256 (source-sha256 source)) + (meta (and=> (find-attribute-by-name "meta" attributes) + attribute-value))) + (values + `(package + (name ,name) + (version ,version) + (source (origin + (method url-fetch) + (uri ,(pretty-uri (car urls) version)) + (sha256 + (base32 + ,(bytevector->nix-base32-string sha256))))) + (build-system gnu-build-system) + + ;; When doing a native Nixpkgs build, `buildInputs' is empty and + ;; everything is in `nativeBuildInputs'. So we can't distinguish + ;; between both, here. + ;; + ;; Note that `nativeBuildInputs' was renamed from + ;; `buildNativeInputs' in Nixpkgs sometime around March 2013. + ,@(maybe-inputs 'inputs + (convert-inputs "nativeBuildInputs")) + ,@(maybe-inputs 'propagated-inputs + (convert-inputs "propagatedNativeBuildInputs")) + + (home-page ,(and=> (find-attribute-by-name "homepage" meta) + attribute-value)) + (synopsis + ;; For GNU packages, prefer the official synopsis. + ,(or (false-if-exception + (and=> (find (lambda (gnu-package) + (equal? (gnu-package-name gnu-package) + name)) + (official-gnu-packages)) + gnu-package-doc-summary)) + (and=> (find-attribute-by-name "description" meta) + attribute-value))) + (description + ;; Likewise, prefer the official description of GNU packages. + ,(or (false-if-exception + (and=> (find (lambda (gnu-package) + (equal? (gnu-package-name gnu-package) + name)) + (official-gnu-packages)) + gnu-package-doc-description)) + (and=> (find-attribute-by-name "longDescription" meta) + attribute-value))) + (license ,(and=> (find-attribute-by-name "license" meta) + (compose license-variable attribute-value)))) + loc)))))) + +(define (nixpkgs->guix-package nixpkgs attribute) + "Evaluate ATTRIBUTE in NIXPKGS, the file name of a Nixpkgs checkout, +and return the `package' s-expression corresponding to that package." + (let ((port (open-nixpkgs nixpkgs attribute))) + (match (xml->snix port) + (('snix loc (and drv ('derivation _ ...))) + (and (not (pipe-failed? port)) + (snix-derivation->guix-package drv))) + (_ + (not (pipe-failed? port)))))) + +;;; snix.scm ends here diff --git a/guix/import/utils.scm b/guix/import/utils.scm new file mode 100644 index 0000000..062cfc5 --- /dev/null +++ b/guix/import/utils.scm @@ -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)))))) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 6f75017..e9576ba 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -1,5 +1,6 @@ ;;; 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. ;;; @@ -18,15 +19,16 @@ (define-module (guix scripts import) #:use-module (guix ui) - #:use-module (guix snix) #:use-module (guix utils) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (ice-9 pretty-print) - #:export (guix-import)) + #:export (%standard-import-options + guix-import)) \f ;;; @@ -61,15 +63,30 @@ rather than \\n." \f ;;; -;;; Command-line options. +;;; Command line options. ;;; -(define %default-options - '()) +(define %standard-import-options '()) + +\f +;;; +;;; 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) - (display (_ "Usage: guix import NIXPKGS ATTRIBUTE -Import and convert the Nix expression ATTRIBUTE of NIXPKGS.\n")) + (display (_ "Usage: guix import IMPORTER ARGS ... +Run IMPORTER with ARGS.\n")) + (newline) + (display (_ "IMPORTER must be one of the importers listed below:\n")) + (format #t "~{ ~a~%~}" importers) (display (_ " -h, --help display this help and exit")) (display (_ " @@ -77,43 +94,19 @@ Import and convert the Nix expression ATTRIBUTE of NIXPKGS.\n")) (newline) (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"))))) - -\f -;;; -;;; Entry point. -;;; - (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 - ((nixpkgs attribute) - (let-values (((expr loc) - (nixpkgs->guix-package nixpkgs attribute))) - (format #t ";; converted from ~a:~a~%~%" - (location-file loc) (location-line loc)) - (pretty-print expr (newline-rewriting-port (current-output-port))))) - (_ - (leave (_ "wrong number of arguments~%")))))) + (match args + (() + (format (current-error-port) + (_ "guix import: missing importer name~%"))) + ((or ("-h") ("--help")) + (show-help) + (exit 0)) + (("--version") + (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~%")))))) diff --git a/guix/scripts/import/nix.scm b/guix/scripts/import/nix.scm new file mode 100644 index 0000000..2dc2677 --- /dev/null +++ b/guix/scripts/import/nix.scm @@ -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)) + +\f +;;; +;;; 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)) + +\f +;;; +;;; 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~%")))))) diff --git a/guix/scripts/import/pypi.scm b/guix/scripts/import/pypi.scm new file mode 100644 index 0000000..0aaa23a --- /dev/null +++ b/guix/scripts/import/pypi.scm @@ -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)) + +\f +;;; +;;; 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)) + +\f +;;; +;;; 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))))) diff --git a/guix/snix.scm b/guix/snix.scm deleted file mode 100644 index a77433b..0000000 --- a/guix/snix.scm +++ /dev/null @@ -1,474 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2010, 2011, 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 snix) - #:use-module (sxml ssax) - #:use-module (ice-9 popen) - #:use-module (ice-9 match) - #:use-module (ice-9 rdelim) - #:use-module (ice-9 format) - #:use-module (ice-9 regex) - #:use-module (ice-9 vlist) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-9) - #:use-module (srfi srfi-11) - #:use-module (srfi srfi-26) - #:use-module (srfi srfi-37) - #:use-module (system foreign) - #:use-module (rnrs bytevectors) - #:use-module (guix utils) - #:use-module (guix base32) - #:use-module (guix config) - #:use-module (guix gnu-maintenance) - #:export (open-nixpkgs - xml->snix - nixpkgs->guix-package)) - -;;; Commentary: -;;; -;;; Converting Nix code to s-expressions, and then to Guix `package' -;;; declarations, using the XML output of `nix-instantiate'. -;;; -;;; Code: - -\f -;;; -;;; SNix. -;;; - -;; Nix object types visible in the XML output of `nix-instantiate' and -;; mapping to S-expressions (we map to sexps, not records, so that we -;; can do pattern matching): -;; -;; at (at varpat attrspat) -;; attr (attribute loc name value) -;; attrs (attribute-set attributes) -;; attrspat (attribute-set-pattern patterns) -;; bool #f|#t -;; derivation (derivation drv-path out-path attributes) -;; ellipsis '... -;; expr (snix loc body ...) -;; function (function loc at|attrspat|varpat) -;; int int -;; list list -;; null 'null -;; path string -;; string string -;; unevaluated 'unevaluated -;; varpat (varpat name) -;; -;; Initially ATTRIBUTES in `derivation' and `attribute-set' was a promise; -;; however, handling `repeated' nodes makes it impossible to do anything -;; lazily because the whole SXML tree has to be traversed to maintain the -;; list of known derivations. - -(define (xml-element->snix elem attributes body derivations) - "Return an SNix element corresponding to XML element ELEM." - - (define (loc) - (location (assq-ref attributes 'path) - (assq-ref attributes 'line) - (assq-ref attributes 'column))) - - (case elem - ((at) - (values `(at ,(car body) ,(cadr body)) derivations)) - ((attr) - (let ((name (assq-ref attributes 'name))) - (cond ((null? body) - (values `(attribute-pattern ,name) derivations)) - ((and (pair? body) (null? (cdr body))) - (values `(attribute ,(loc) ,name ,(car body)) - derivations)) - (else - (error "invalid attribute body" name (loc) body))))) - ((attrs) - (values `(attribute-set ,(reverse body)) derivations)) - ((attrspat) - (values `(attribute-set-pattern ,body) derivations)) - ((bool) - (values (string-ci=? "true" (assq-ref attributes 'value)) - derivations)) - ((derivation) - (let ((drv-path (assq-ref attributes 'drvPath)) - (out-path (assq-ref attributes 'outPath))) - (if (equal? body '(repeated)) - (let ((body (vhash-assoc drv-path derivations))) - (if (pair? body) - (values `(derivation ,drv-path ,out-path ,(cdr body)) - derivations) - - ;; DRV-PATH hasn't been encountered yet but may be later - ;; (see <http://article.gmane.org/gmane.linux.distributions.nixos/5946>.) - ;; Return an `unresolved' node. - (values `(unresolved - ,(lambda (derivations) - (let ((body (vhash-assoc drv-path derivations))) - (if (pair? body) - `(derivation ,drv-path ,out-path - ,(cdr body)) - (error "no previous occurrence of derivation" - drv-path))))) - derivations))) - (values `(derivation ,drv-path ,out-path ,body) - (vhash-cons drv-path body derivations))))) - ((ellipsis) - (values '... derivations)) - ((expr) - (values `(snix ,(loc) ,@body) derivations)) - ((function) - (values `(function ,(loc) ,body) derivations)) - ((int) - (values (string->number (assq-ref attributes 'value)) - derivations)) - ((list) - (values body derivations)) - ((null) - (values 'null derivations)) - ((path) - (values (assq-ref attributes 'value) derivations)) - ((repeated) - (values 'repeated derivations)) - ((string) - (values (assq-ref attributes 'value) derivations)) - ((unevaluated) - (values 'unevaluated derivations)) - ((varpat) - (values `(varpat ,(assq-ref attributes 'name)) derivations)) - (else (error "unhandled Nix XML element" elem)))) - -(define (resolve snix derivations) - "Return a new SNix tree where `unresolved' nodes from SNIX have been -replaced by the result of their application to DERIVATIONS, a vhash." - (let loop ((node snix) - (seen vlist-null)) - (if (vhash-assq node seen) - (values node seen) - (match node - (('unresolved proc) - (let ((n (proc derivations))) - (values n seen))) - ((tag body ...) - (let ((body+seen (fold (lambda (n body+seen) - (call-with-values - (lambda () - (loop n (cdr body+seen))) - (lambda (n* seen) - (cons (cons n* (car body+seen)) - (vhash-consq n #t seen))))) - (cons '() (vhash-consq node #t seen)) - body))) - (values (cons tag (reverse (car body+seen))) - (vhash-consq node #t (cdr body+seen))))) - (anything - (values anything seen)))))) - -(define xml->snix - (let ((parse - (ssax:make-parser NEW-LEVEL-SEED - (lambda (elem-gi attributes namespaces expected-content - seed) - (cons '() (cdr seed))) - - FINISH-ELEMENT - (lambda (elem-gi attributes namespaces parent-seed - seed) - (let ((snix (car seed)) - (derivations (cdr seed))) - (let-values (((snix derivations) - (xml-element->snix elem-gi - attributes - snix - derivations))) - (cons (cons snix (car parent-seed)) - derivations)))) - - CHAR-DATA-HANDLER - (lambda (string1 string2 seed) - ;; Discard inter-node strings, which are blanks. - seed)))) - (lambda (port) - "Return the SNix represention of TREE, an SXML tree as returned by -parsing the XML output of `nix-instantiate' on Nixpkgs." - (match (parse port (cons '() vlist-null)) - (((snix) . derivations) - (resolve snix derivations)))))) - -(define (attribute-value attribute) - "Return the value of ATTRIBUTE." - (match attribute - (('attribute _ _ value) value))) - -(define (derivation-source derivation) - "Return the \"src\" attribute of DERIVATION or #f if not found." - (match derivation - (('derivation _ _ (attributes ...)) - (find-attribute-by-name "src" attributes)))) - -(define (derivation-output-path derivation) - "Return the output path of DERIVATION." - (match derivation - (('derivation _ out-path _) - out-path) - (_ #f))) - -(define (source-output-path src) - "Return the output path of SRC, the \"src\" attribute of a derivation." - (derivation-output-path (attribute-value src))) - -(define (source-urls src) - "Return the URLs of SRC, the \"src\" attribute of a derivation." - (match src - (('attribute _ _ ('derivation _ _ (attributes ...))) - (match (find-attribute-by-name "urls" attributes) - (('attribute _ _ value) - value))) - (_ #f))) - -(define (source-sha256 src) - "Return the sha256 of SRC, the \"src\" attribute of a derivation, as a -bytevector." - (match src - (('attribute _ _ ('derivation _ _ (attributes ...))) - (match (find-attribute-by-name "outputHash" attributes) - (('attribute _ _ value) - (match value - ((= string-length 52) - (nix-base32-string->bytevector value)) - ((= string-length 64) - (base16-string->bytevector value)) - (_ - (error "unsupported hash format" value)))))) - (_ #f))) - -(define (derivation-source-output-path derivation) - "Return the output path of the \"src\" attribute of DERIVATION or #f -if DERIVATION lacks an \"src\" attribute." - (and=> (derivation-source derivation) source-output-path)) - -(define* (open-nixpkgs nixpkgs #:optional attribute) - "Return an input pipe to the XML representation of Nixpkgs. When -ATTRIBUTE is true, only that attribute is considered." - (with-fluids ((%default-port-encoding "UTF-8")) - (let ((cross-system (format #f "{ - config = \"i686-guix-linux-gnu\"; - libc = \"glibc\"; - arch = \"guix\"; - withTLS = true; - float = \"hard\"; - openssl.system = \"linux-generic32\"; - platform = (import ~a/pkgs/top-level/platforms.nix).sheevaplug; -}" nixpkgs))) - (apply open-pipe* OPEN_READ - %nix-instantiate "--strict" "--eval-only" "--xml" - - ;; Pass a dummy `crossSystem' argument so that `buildInputs' and - ;; `nativeBuildInputs' are not coalesced. - ;; XXX: This is hacky and has other problems. - ;"--arg" "crossSystem" cross-system - - `(,@(if attribute - `("-A" ,attribute) - '()) - ,nixpkgs))))) - -(define (pipe-failed? pipe) - "Close pipe and return its status if it failed." - (let ((status (close-pipe pipe))) - (if (or (status:term-sig status) - (not (= (status:exit-val status) 0))) - status - #f))) - -(define (find-attribute-by-name name attributes) - "Return attribute NAME in ATTRIBUTES, an attribute set or list of SNix -attributes, or #f if NAME cannot be found." - (find (lambda (a) - (match a - (('attribute _ (? (cut string=? <> name)) _) - a) - (_ #f))) - (match attributes - (('attribute-set (attributes ...)) - attributes) - (_ - attributes)))) - -(define (package-source-output-path package) - "Return the output path of the \"src\" derivation of PACKAGE." - (derivation-source-output-path (attribute-value package))) - -\f -;;; -;;; 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) - "Return the `package' s-expression corresponding to SNix DERIVATION, a -Nixpkgs `stdenv.mkDerivation'-style derivation, and the original source -location of DERIVATION." - (match derivation - (('derivation _ _ (attributes ...)) - (let*-values (((full-name loc) - (match (find-attribute-by-name "name" attributes) - (('attribute loc _ value) - (values value loc)) - (_ - (values #f #f)))) - ((name version) - (package-name->name+version full-name))) - (define (convert-inputs type) - ;; Convert the derivation's input from a list of SNix derivations to - ;; a list of name/variable pairs. - (match (and=> (find-attribute-by-name type attributes) - attribute-value) - (#f - '()) - ((inputs ...) - ;; Inputs can be either derivations or the null value. - (filter-map (match-lambda - (('derivation _ _ (attributes ...)) - (let* ((full-name - (attribute-value - (find-attribute-by-name "name" attributes))) - (name (package-name->name+version full-name))) - (list name - (list 'unquote (string->symbol name))))) - ('null #f)) - inputs)))) - - (define (maybe-inputs guix-name inputs) - (match inputs - (() - '()) - ((inputs ...) - (list (list guix-name - (list 'quasiquote inputs)))))) - - (define (pretty-uri uri version) - (if version - (match (factorize-uri uri version) - ((items ...) - `(string-append ,@items)) - (x x)) - uri)) - - (define (license-variable license) - ;; Return the name of the (guix licenses) variable for LICENSE. - (match license - ("GPLv2+" 'gpl2+) - ("GPLv3+" 'gpl3+) - ("LGPLv2+" 'lgpl2.1+) - ("LGPLv2.1+" 'lgpl2.1+) - ("LGPLv3+" 'lgpl3+) - (_ license))) - - (let* ((source (find-attribute-by-name "src" attributes)) - (urls (source-urls source)) - (sha256 (source-sha256 source)) - (meta (and=> (find-attribute-by-name "meta" attributes) - attribute-value))) - (values - `(package - (name ,name) - (version ,version) - (source (origin - (method url-fetch) - (uri ,(pretty-uri (car urls) version)) - (sha256 - (base32 - ,(bytevector->nix-base32-string sha256))))) - (build-system gnu-build-system) - - ;; When doing a native Nixpkgs build, `buildInputs' is empty and - ;; everything is in `nativeBuildInputs'. So we can't distinguish - ;; between both, here. - ;; - ;; Note that `nativeBuildInputs' was renamed from - ;; `buildNativeInputs' in Nixpkgs sometime around March 2013. - ,@(maybe-inputs 'inputs - (convert-inputs "nativeBuildInputs")) - ,@(maybe-inputs 'propagated-inputs - (convert-inputs "propagatedNativeBuildInputs")) - - (home-page ,(and=> (find-attribute-by-name "homepage" meta) - attribute-value)) - (synopsis - ;; For GNU packages, prefer the official synopsis. - ,(or (false-if-exception - (and=> (find (lambda (gnu-package) - (equal? (gnu-package-name gnu-package) - name)) - (official-gnu-packages)) - gnu-package-doc-summary)) - (and=> (find-attribute-by-name "description" meta) - attribute-value))) - (description - ;; Likewise, prefer the official description of GNU packages. - ,(or (false-if-exception - (and=> (find (lambda (gnu-package) - (equal? (gnu-package-name gnu-package) - name)) - (official-gnu-packages)) - gnu-package-doc-description)) - (and=> (find-attribute-by-name "longDescription" meta) - attribute-value))) - (license ,(and=> (find-attribute-by-name "license" meta) - (compose license-variable attribute-value)))) - loc)))))) - -(define (nixpkgs->guix-package nixpkgs attribute) - "Evaluate ATTRIBUTE in NIXPKGS, the file name of a Nixpkgs checkout, -and return the `package' s-expression corresponding to that package." - (let ((port (open-nixpkgs nixpkgs attribute))) - (match (xml->snix port) - (('snix loc (and drv ('derivation _ ...))) - (and (not (pipe-failed? port)) - (snix-derivation->guix-package drv))) - (_ - (not (pipe-failed? port)))))) - -;;; snix.scm ends here diff --git a/tests/pypi.scm b/tests/pypi.scm new file mode 100644 index 0000000..da4d03f --- /dev/null +++ b/tests/pypi.scm @@ -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 (stub (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. + (stub ((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") + +\f +(exit (= (test-runner-fail-count (test-runner-current)) 0)) diff --git a/tests/snix.scm b/tests/snix.scm index 9d692e9..2318780 100644 --- a/tests/snix.scm +++ b/tests/snix.scm @@ -17,14 +17,14 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (test-snix) - #:use-module (guix snix) + #:use-module (guix import snix) #:use-module ((guix utils) #:select (%nixpkgs-directory)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-64) #:use-module (ice-9 match)) (define factorize-uri - (@@ (guix snix) factorize-uri)) + (@@ (guix import snix) factorize-uri)) (define-syntax-rule (every? proc lists ...) (not (not (every proc lists ...)))) -- 2.1.0 [-- Attachment #3: Type: text/plain, Size: 136 bytes --] -- David Thompson Web Developer - Free Software Foundation - http://fsf.org GPG Key: 0FF1D807 Support the FSF: https://fsf.org/donate ^ permalink raw reply related [flat|nested] 12+ messages in thread
* Re: [PATCH] import: Add PyPI importer. 2014-09-28 23:48 ` David Thompson @ 2014-09-29 7:04 ` Ludovic Courtès 0 siblings, 0 replies; 12+ messages in thread From: Ludovic Courtès @ 2014-09-29 7:04 UTC (permalink / raw) To: David Thompson; +Cc: guix-devel David Thompson <dthompson2@worcester.edu> skribis: > Ludovic Courtès <ludo@gnu.org> writes: > >> I wonder if there may be shared options between all the importers >> (like an option for import & live build.) >> >> That can still be addressed by exporting an option list from (guix >> scripts import), like (guix scripts build) does, I think. >> > > Done. Added an empty options list for now. To avoid circular > dependencies, I had to lazily resolve the importer procedures in > guix/scripts/import.scm. Yes, and it’s probably a good idea to do like this anyway, so that (guix scripts import) doesn’t really have to know about the existing importers. [...] >>> +(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, >> >> Namely, what do you think of having importers return directly a >> ‘package’ object? Then there could be a shared ‘package->sexp’ >> procedure, that would to the fancy ‘string-append’ thing like above. >> >> And, eventually, we can add an option to do live builds of the generated >> package objects. >> >> That can also be done in the next iteration, though. >> > > I think this is best saved for another patch since it involves modifying > the snix code. I agree that it is a good idea. OK. >>> +(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." >> >> This one from snix is redundant with ‘tarball-url->string-append’ (and >> maybe less sophisticated?). >> > > 'factorize-uri' is better, so I'm using that now. I created a new > module '(guix import utils)' for commonly used import procedures. > > New patch attached. Perfect, OK to push! Ludo’. ^ permalink raw reply [flat|nested] 12+ messages in thread
end of thread, other threads:[~2014-09-30 11:55 UTC | newest] Thread overview: 12+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2014-09-27 21:15 [PATCH] import: Add PyPI importer David Thompson 2014-09-27 21:19 ` David Thompson 2014-09-27 21:35 ` Ludovic Courtès 2014-09-29 11:23 ` David Thompson 2014-09-29 12:24 ` Ludovic Courtès 2014-09-29 23:31 ` David Thompson 2014-09-30 5:49 ` Alex Kost 2014-09-30 7:13 ` Ludovic Courtès 2014-09-30 11:55 ` David Thompson 2014-09-27 21:49 ` Ludovic Courtès 2014-09-28 23:48 ` David Thompson 2014-09-29 7:04 ` Ludovic Courtès
Code repositories for project(s) associated with this public inbox https://git.savannah.gnu.org/cgit/guix.git This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).