From mboxrd@z Thu Jan 1 00:00:00 1970 From: David Craven Subject: [PATCH 06/12] import: Add importer for rust crates. Date: Thu, 22 Sep 2016 15:18:57 +0200 Message-ID: <20160922131903.1606-6-david@craven.ch> References: <20160922131903.1606-1-david@craven.ch> Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:43345) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bn3ul-0004WV-8n for guix-devel@gnu.org; Thu, 22 Sep 2016 09:20:12 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bn3uT-0001bR-J7 for guix-devel@gnu.org; Thu, 22 Sep 2016 09:19:47 -0400 Received: from so254-10.mailgun.net ([198.61.254.10]:37652) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bn3uS-0001X9-4G for guix-devel@gnu.org; Thu, 22 Sep 2016 09:19:29 -0400 In-Reply-To: <20160922131903.1606-1-david@craven.ch> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org * guix/import/crate.scm (crate-fetch, make-crate-sexp, crate->guix-package, guix-package->crate-name, string->license, crate-name->package-name): New variables. * guix/scripts/import/crate.scm (%default-options, show-help, %options, guix-import-crate): New variables. * guix/scripts/import.scm (importers): Add crate to list of importers. * tests/crate.scm (test-json, test-source-hash, guix-package->crate-name, crate->guix-package): New variables. --- guix/import/crate.scm | 91 +++++++++++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 2 +- guix/scripts/import/crate.scm | 94 +++++++++++++++++++++++++++++++++++++++++++ tests/crate.scm | 87 +++++++++++++++++++++++++++++++++++++++ 4 files changed, 273 insertions(+), 1 deletion(-) create mode 100644 guix/import/crate.scm create mode 100644 guix/scripts/import/crate.scm create mode 100644 tests/crate.scm diff --git a/guix/import/crate.scm b/guix/import/crate.scm new file mode 100644 index 0000000..3cc17f2 --- /dev/null +++ b/guix/import/crate.scm @@ -0,0 +1,91 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 David Craven +;;; +;;; 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 . + +(define-module (guix import crate) + #:use-module (gnu packages rust) + #:use-module ((guix download) #:prefix download:) + #:use-module (guix import utils) + #:use-module ((guix licenses) #:prefix license:) + #:use-module (guix packages) + #:use-module (guix upstream) + #:use-module (guix utils) + #:use-module (ice-9 match) + #:use-module (json) + #:use-module (srfi srfi-1) + #:export (crate->guix-package + guix-package->crate-name)) + +(define (crate-fetch name) + "Return an alist representation of the crates.io metadata for the package NAME, +or #f on failure." + ;; XXX: We want to silence the download progress report, which is especially + ;; annoying for 'guix refresh', but we have to use a file port. + (call-with-output-file "/dev/null" + (lambda (null) + (with-error-to-port null + (lambda () + (json-fetch (string-append "https://crates.io/api/v1/crates/" + name))))))) + +;; TODO: Import inputs and native-inputs +(define (make-crate-sexp name version home-page synopsis description license) + "Return the `package' s-expression for a rust package with the given NAME, +VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." + (call-with-temporary-output-file + (lambda (temp port) + (and (url-fetch (crate-uri name version) temp) + `(package + (name ,(crate-name->package-name name)) + (version ,version) + (source (origin + (method url-fetch) + (uri (crate-uri ,name version)) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + ,(guix-hash-url temp))))) + (build-system cargo-build-system) + (home-page ,home-page) + (synopsis ,synopsis) + (description ,(beautify-description description)) + (license ,(match license + (() #f) + ((license) license) + (_ `(list ,@license))))))))) + +(define (crate->guix-package crate-name) + "Fetch the metadata for CRATE-NAME from crates.io, and return the +`package' s-expression corresponding to that package, or #f on failure." + (let ((crate (crate-fetch crate-name))) + (let ((name (assoc-ref* crate "crate" "name")) + (version (assoc-ref* crate "crate" "max_version")) + (home-page (assoc-ref* crate "crate" "homepage")) + (synopsis (assoc-ref* crate "crate" "description")) + (description (assoc-ref* crate "crate" "description")) + (license (string->license (assoc-ref* crate "crate" "license")))) + (make-crate-sexp name version home-page synopsis description license)))) + +(define (guix-package->crate-name package) + "Return the crate NAME of a PACKAGE." + (string-join (cdr (string-split (package-name package) #\-)) "-")) + +(define (string->license string) + (map spdx-string->license (string-split string #\/))) + +(define (crate-name->package-name name) + (string-append "rust-" name)) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index e54744f..c671686 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -73,7 +73,7 @@ rather than \\n." ;;; Entry point. ;;; -(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa" "gem" "cran")) +(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa" "gem" "cran" "crate")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm new file mode 100644 index 0000000..4337a0b --- /dev/null +++ b/guix/scripts/import/crate.scm @@ -0,0 +1,94 @@ + +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 David Thompson +;;; Copyright © 2016 David Craven +;;; +;;; 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 . + +(define-module (guix scripts import crate) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix scripts) + #:use-module (guix import crate) + #: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-crate)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + '()) + +(define (show-help) + (display (_ "Usage: guix import crate PACKAGE-NAME +Import and convert the crate.io 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 crate"))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-crate . 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) + (let ((sexp (crate->guix-package package-name))) + (unless sexp + (leave (_ "failed to download meta-data for package '~a'~%") + package-name)) + sexp)) + (() + (leave (_ "too few arguments~%"))) + ((many ...) + (leave (_ "too many arguments~%")))))) diff --git a/tests/crate.scm b/tests/crate.scm new file mode 100644 index 0000000..71b3567 --- /dev/null +++ b/tests/crate.scm @@ -0,0 +1,87 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 David Thompson +;;; Copyright © 2016 David Craven +;;; +;;; 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 . + +(define-module (test-crate) + #:use-module (guix import crate) + #:use-module (guix base32) + #:use-module (guix hash) + #:use-module (guix tests) + #:use-module (ice-9 match) + #:use-module (srfi srfi-64)) + +(define test-json + "{ + \"crate\": { + \"max_version\": \"1.0.0\", + \"name\": \"foo\", + \"license\": \"MIT/Apache-2.0\", + \"description\": \"summary\", + \"homepage\": \"http://example.com\", + } +}") + +(define test-source-hash + "") + +(test-begin "crate") + +(test-equal "guix-package->crate-name" + "rustc-serialize" + (guix-package->crate-name + (dummy-package "rust-rustc-serialize"))) + +(test-assert "crate->guix-package" + ;; Replace network resources with sample data. + (mock ((guix import utils) url-fetch + (lambda (url file-name) + (match url + ("https://crates.io/api/v1/crates/foo" + (with-output-to-file file-name + (lambda () + (display test-json)))) + ("https://crates.io/api/v1/crates/foo/1.0.0/download" + (with-output-to-file file-name + (lambda () + (display "empty file\n"))) + (set! test-source-hash + (call-with-input-file file-name port-sha256))) + (_ (error "Unexpected URL: " url))))) + (match (crate->guix-package "foo") + (('package + ('name "rust-foo") + ('version "1.0.0") + ('source ('origin + ('method 'url-fetch) + ('uri ('crate-uri "foo" 'version)) + ('file-name ('string-append 'name "-" 'version ".tar.gz")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'cargo-build-system) + ('home-page "http://example.com") + ('synopsis "summary") + ('description "summary") + ('license ('list 'license:expat 'license:asl2.0))) + (string=? (bytevector->nix-base32-string + test-source-hash) + hash)) + (x + (pk 'fail x #f))))) + +(test-end "crate") -- 2.9.0