From a3528e0b3333864528805150a16caad88c07fd7a Mon Sep 17 00:00:00 2001
From: Brian Leung <bkleung89@gmail.com>
Date: Sat, 20 Jul 2019 21:35:14 +0200
Subject: [PATCH] gnu: Add crate-recursive-import.
* guix/import/crate.scm (crate-recursive-import): New variable.
* guix/script/import/crate.scm: Add recursive option.
* guix/tests/crate.scm (crate-recursive-import): New test.
---
---
guix/import/crate.scm | 28 +++++++----
guix/scripts/import/crate.scm | 28 +++++++++--
tests/crate.scm | 92 +++++++++++++++++++++++++++++++++--
3 files changed, 129 insertions(+), 19 deletions(-)
@@ -36,6 +36,7 @@
#:use-module (srfi srfi-2)
#:use-module (srfi srfi-26)
#:export (crate->guix-package
+ crate-recursive-import
guix-package->crate-name
%crate-updater))
@@ -109,8 +110,8 @@ VERSION, CARGO-INPUTS, CARGO-DEVELOPMENT-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTIO
and LICENSE."
(let* ((port (http-fetch (crate-uri name version)))
(guix-name (crate-name->package-name name))
- (cargo-inputs (map crate-name->package-name cargo-inputs))
- (cargo-development-inputs (map crate-name->package-name
+ (inputs (map crate-name->package-name cargo-inputs))
+ (development-inputs (map crate-name->package-name
cargo-development-inputs))
(pkg `(package
(name ,guix-name)
@@ -123,9 +124,9 @@ and LICENSE."
(base32
,(bytevector->nix-base32-string (port-sha256 port))))))
(build-system cargo-build-system)
- ,@(maybe-arguments (append (maybe-cargo-inputs cargo-inputs)
+ ,@(maybe-arguments (append (maybe-cargo-inputs inputs)
(maybe-cargo-development-inputs
- cargo-development-inputs)))
+ development-inputs)))
(home-page ,(match home-page
(() "")
(_ home-page)))
@@ -136,12 +137,19 @@ and LICENSE."
((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))
+ (values pkg (append cargo-development-inputs cargo-inputs))))
+
+(define crate->guix-package
+ (memoize
+ (lambda* (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* (crate-recursive-import package-name)
+ (recursive-import package-name #f
+ #:repo->guix-package (lambda (name _) (crate->guix-package name))
+ #:guix-name crate-name->package-name))
(define (guix-package->crate-name package)
"Return the crate name of PACKAGE."
@@ -27,6 +27,7 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-37)
+ #:use-module (srfi srfi-41)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:export (guix-import-crate))
@@ -45,6 +46,8 @@ Import and convert the crate.io package for PACKAGE-NAME.\n"))
(display (G_ "
-h, --help display this help and exit"))
(display (G_ "
+ -r, --recursive import packages recursively"))
+ (display (G_ "
-V, --version display version information and exit"))
(newline)
(show-bug-report-information))
@@ -58,6 +61,9 @@ Import and convert the crate.io package for PACKAGE-NAME.\n"))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "guix import crate")))
+ (option '(#\r "recursive") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'recursive #t result)))
%standard-import-options))
@@ -83,11 +89,23 @@ Import and convert the crate.io package for PACKAGE-NAME.\n"))
(reverse opts))))
(match args
((package-name)
- (let ((sexp (crate->guix-package package-name)))
- (unless sexp
- (leave (G_ "failed to download meta-data for package '~a'~%")
- package-name))
- sexp))
+ (if (assoc-ref opts 'recursive)
+ ;; Recursive import
+ (map (match-lambda
+ ((and ('package ('name name) . rest) pkg)
+ `(define-public ,(string->symbol name)
+ ,pkg))
+ (_ #f))
+ (reverse
+ (stream->list
+ (crate-recursive-import package-name))))
+ ;; Single import
+ (let ((sexp (crate->guix-package package-name ;; #f
+ )))
+ (unless sexp
+ (leave (G_ "failed to download meta-data for package '~a'~%")
+ package-name))
+ sexp)))
(()
(leave (G_ "too few arguments~%")))
((many ...)
@@ -25,9 +25,10 @@
#:use-module (guix tests)
#:use-module (ice-9 iconv)
#:use-module (ice-9 match)
+ #:use-module (srfi srfi-41)
#:use-module (srfi srfi-64))
-(define test-crate
+(define test-foo-crate
"{
\"crate\": {
\"max_version\": \"1.0.0\",
@@ -39,7 +40,7 @@
}
}")
-(define test-dependencies
+(define test-foo-dependencies
"{
\"dependencies\": [
{
@@ -49,6 +50,23 @@
]
}")
+(define test-bar-crate
+ "{
+ \"crate\": {
+ \"max_version\": \"1.0.0\",
+ \"name\": \"bar\",
+ \"license\": \"MIT/Apache-2.0\",
+ \"description\": \"summary\",
+ \"homepage\": \"http://example.com\",
+ \"repository\": \"http://example.com\",
+ }
+}")
+
+(define test-bar-dependencies
+ "{
+ \"dependencies\": []
+}")
+
(define test-source-hash
"")
@@ -68,14 +86,14 @@
(lambda (url . rest)
(match url
("https://crates.io/api/v1/crates/foo"
- (open-input-string test-crate))
+ (open-input-string test-foo-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))
+ (open-input-string test-foo-dependencies))
(_ (error "Unexpected URL: " url)))))
(match (crate->guix-package "foo")
(('package
@@ -100,4 +118,70 @@
(x
(pk 'fail x #f)))))
+(test-assert "cargo-recursive-import"
+ ;; Replace network resources with sample data.
+ (mock ((guix http-client) http-fetch
+ (lambda (url . rest)
+ (match url
+ ("https://crates.io/api/v1/crates/foo"
+ (open-input-string test-foo-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-foo-dependencies))
+ ("https://crates.io/api/v1/crates/bar"
+ (open-input-string test-bar-crate))
+ ("https://crates.io/api/v1/crates/bar/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/bar/1.0.0/dependencies"
+ (open-input-string test-bar-dependencies))
+ (_ (error "Unexpected URL: " url)))))
+ (match (stream->list (crate-recursive-import "foo"))
+ ((('package
+ ('name "rust-foo")
+ ('version (? string? ver))
+ ('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)
+ ('arguments
+ ('quasiquote
+ ('#:cargo-inputs (("rust-bar" ('unquote rust-bar))))))
+ ('home-page "http://example.com")
+ ('synopsis "summary")
+ ('description "summary")
+ ('license ('list 'license:expat 'license:asl2.0)))
+ ('package
+ ('name "rust-bar")
+ ('version (? string? ver))
+ ('source
+ ('origin
+ ('method 'url-fetch)
+ ('uri ('crate-uri "bar" '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))))
+ #t)
+ (x
+ (pk 'fail x #f)))))
+
(test-end "crate")
--
2.22.0