ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

import: Add importer for rust crates.

Browse source 
* guix/import/crate.scm: New file.
* guix/scripts/import/crate.scm: New file.
* guix/scripts/import.scm (importers): Add crate importer.
* tests/crate.scm: New file.
* doc/guix.texi: Add crate importer to table.
* Makefile.am (MODULES, SCM_TESTS): Add files.
This commit is contained in:
David Craven 2016-09-22 11:40:58 +02:00
parent bb3f36ed4c
commit 3e0c036584
No known key found for this signature in database
GPG key ID: C5E051C79C0BECDB
7 changed files with 332 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
Makefile.am
View file

@ -122,6 +122,7 @@ MODULES = \
guix/import/snix.scm \
guix/import/cabal.scm \
guix/import/cran.scm \
guix/import/crate.scm \
guix/import/hackage.scm \
guix/import/elpa.scm \
guix/scripts.scm \
@ -141,6 +142,7 @@ MODULES = \
guix/scripts/lint.scm \
guix/scripts/challenge.scm \
guix/scripts/import/cran.scm \
guix/scripts/import/crate.scm \
guix/scripts/import/gnu.scm \
guix/scripts/import/nix.scm \
guix/scripts/import/hackage.scm \
@ -282,7 +284,8 @@ if HAVE_GUILE_JSON
SCM_TESTS += \
tests/pypi.scm \
tests/cpan.scm \
tests/gem.scm
tests/gem.scm \
tests/crate.scm
endif

5
doc/guix.texi
View file

@ -5267,6 +5267,11 @@ signatures,, emacs, The GNU Emacs Manual}).
identifier.
@end itemize
@end table
@item crate
@cindex crate
Import metadata from the crates.io Rust package repository
@uref{https://crates.io, crates.io}.
@end table
The structure of the @command{guix import} code is modular. It would be

125
guix/import/crate.scm Normal file
View file

@ -0,0 +1,125 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 David Craven <david@craven.ch>
;;;
;;; 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 crate)
#:use-module (guix base32)
#:use-module (guix build-system cargo)
#:use-module ((guix download) #:prefix download:)
#:use-module (guix hash)
#:use-module (guix http-client)
#:use-module (guix import json)
#:use-module (guix import utils)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix upstream)
#:use-module (guix utils)
#:use-module (ice-9 match)
#:use-module (ice-9 pretty-print) ; recursive
#:use-module (json)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
#:use-module (srfi srfi-26)
#:export (crate->guix-package
guix-package->crate-name))
(define (crate-fetch crate-name callback)
"Fetch the metadata for CRATE-NAME from crates.io and call the callback."
(define (crates->inputs crates)
(sort (map (cut assoc-ref <> "crate_id") crates) string-ci<?))
(define (string->license string)
(map spdx-string->license (string-split string #\/)))
(define (crate-kind-predicate kind)
(lambda (dep) (string=? (assoc-ref dep "kind") kind)))
(and-let* ((crate-json (json-fetch (string-append crate-url crate-name)))
(crate (assoc-ref crate-json "crate"))
(name (assoc-ref crate "name"))
(version (assoc-ref crate "max_version"))
(home-page (assoc-ref crate "homepage"))
(synopsis (assoc-ref crate "description"))
(description (assoc-ref crate "description"))
(license (string->license (assoc-ref crate "license")))
(path (string-append "/" version "/dependencies"))
(deps-json (json-fetch (string-append crate-url name path)))
(deps (assoc-ref deps-json "dependencies"))
(input-crates (filter (crate-kind-predicate "normal") deps))
(native-input-crates
(filter (lambda (dep)
(not ((crate-kind-predicate "normal") dep))) deps))
(inputs (crates->inputs input-crates))
(native-inputs (crates->inputs native-input-crates)))
(callback #:name name #:version version
#:inputs inputs #:native-inputs native-inputs
#:home-page home-page #:synopsis synopsis
#:description description #:license license)))
(define* (make-crate-sexp #:key name version inputs native-inputs
home-page synopsis description license
#:allow-other-keys)
"Return the `package' s-expression for a rust package with the given NAME,
VERSION, INPUTS, NATIVE-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
(let* ((port (http-fetch (crate-uri name version)))
(guix-name (crate-name->package-name name))
(inputs (map crate-name->package-name inputs))
(native-inputs (map crate-name->package-name native-inputs))
(pkg `(package
(name ,guix-name)
(version ,version)
(source (origin
(method url-fetch)
(uri (crate-uri ,name version))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
,(bytevector->nix-base32-string (port-sha256 port))))))
(build-system cargo-build-system)
,@(maybe-native-inputs native-inputs)
,@(maybe-inputs inputs)
(home-page ,home-page)
(synopsis ,synopsis)
(description ,(beautify-description description))
(license ,(match license
(() #f)
((license) license)
(_ `(list ,@license)))))))
(close-port port)
pkg))
(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."
(crate-fetch crate-name make-crate-sexp))
(define (guix-package->crate-name package)
"Return the crate name of PACKAGE."
(and-let* ((origin (package-source package))
(uri (origin-uri origin))
(crate-url? uri)
(len (string-length crate-url))
(path (xsubstring uri len))
(parts (string-split path #\/)))
(match parts
((name _ ...) name))))
(define (crate-name->package-name name)
(string-append "rust-" (string-join (string-split name #\_) "-")))

2
guix/scripts/import.scm
View file

@ -73,7 +73,7 @@ (define %standard-import-options '())
;;; 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

94
guix/scripts/import/crate.scm Normal file
View file

@ -0,0 +1,94 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;;
;;; 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 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~%"))))))

1
guix/scripts/refresh.scm
View file

@ -39,6 +39,7 @@ (define-module (guix scripts refresh)
%kernel.org-updater))
#:use-module (guix import elpa)
#:use-module (guix import cran)
#:use-module (guix import crate)
#:use-module (guix import hackage)
#:use-module (guix gnupg)
#:use-module (gnu packages)

102
tests/crate.scm Normal file
View file

@ -0,0 +1,102 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;;
;;; 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-crate)
#:use-module (guix import crate)
#:use-module (guix base32)
#:use-module (guix build-system cargo)
#:use-module (guix hash)
#:use-module (guix tests)
#:use-module (ice-9 iconv)
#:use-module (ice-9 match)
#:use-module (srfi srfi-64))
(define test-crate
"{
\"crate\": {
\"max_version\": \"1.0.0\",
\"name\": \"foo\",
\"license\": \"MIT/Apache-2.0\",
\"description\": \"summary\",
\"homepage\": \"http://example.com\",
}
}")
(define test-dependencies
"{
\"dependencies\": [
{
\"crate_id\": \"bar\",
\"kind\": \"normal\",
}
]
}")
(define test-source-hash
"")
(test-begin "crate")
(test-equal "guix-package->crate-name"
"rustc-serialize"
(guix-package->crate-name
(dummy-package
"rust-rustc-serialize"
(source (dummy-origin
(uri (crate-uri "rustc-serialize" "1.0")))))))
(test-assert "crate->guix-package"
;; Replace network resources with sample data.
(mock ((guix http-client) http-fetch
(lambda (url)
(match url
("https://crates.io/api/v1/crates/foo"
(open-input-string test-crate))
("https://crates.io/api/v1/crates/foo/1.0.0/download"
(set! test-source-hash
(bytevector->nix-base32-string
(sha256 (string->bytevector "empty file\n" "utf-8"))))
(open-input-string "empty file\n"))
("https://crates.io/api/v1/crates/foo/1.0.0/dependencies"
(open-input-string test-dependencies))
(_ (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)
('inputs
('quasiquote
(("rust-bar" ('unquote 'rust-bar)))))
('home-page "http://example.com")
('synopsis "summary")
('description "summary")
('license ('list 'license:expat 'license:asl2.0)))
(string=? test-source-hash hash))
(x
(pk 'fail x #f)))))
(test-end "crate")