From: Brian Leung <bkleung89@gmail.com>
To: 35813@debbugs.gnu.org
Subject: [bug#35813] [PATCH] Add crate-recursive-import.
Date: Mon, 5 Aug 2019 19:50:31 +0200 [thread overview]
Message-ID: <CAAc=MEyL1Fp_qHrEUVFn207D_3NABCAOxPtq8ezc9mDaS3wo9A@mail.gmail.com> (raw)
In-Reply-To: <20190520182306.11899-1-Karlwfmeakin@gmail.com>
[-- Attachment #1.1: Type: text/plain, Size: 239 bytes --]
I took Karl's changes and updated them accordingly. I've also added a small
test. The patch containing his importer, my changes, and my test is
attached (the commit was made using my name--not sure if I should instead
apply Karl's patch).
[-- Attachment #1.2: Type: text/html, Size: 273 bytes --]
[-- Attachment #2: 0001-gnu-Add-crate-recursive-import.patch --]
[-- Type: text/x-patch, Size: 10521 bytes --]
From 407959e97656803981ebf69f83b96a0be2ff6cb7 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 | 31 ++++++++----
guix/scripts/import/crate.scm | 28 +++++++++--
tests/crate.scm | 92 +++++++++++++++++++++++++++++++++--
3 files changed, 132 insertions(+), 19 deletions(-)
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 52c5cb1c30..51f55ea708 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -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,22 @@ 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))
+ ;; (pretty-print guix-name)
+ (values pkg (append cargo-development-inputs cargo-inputs))
+ ;; pkg
+ ))
+
+(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."
diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm
index cab9a4397b..b18cab8286 100644
--- a/guix/scripts/import/crate.scm
+++ b/guix/scripts/import/crate.scm
@@ -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))
\f
@@ -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 ...)
diff --git a/tests/crate.scm b/tests/crate.scm
index 72c3a13350..1787d4f2f6 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -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
next prev parent reply other threads:[~2019-08-05 17:52 UTC|newest]
Thread overview: 12+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-05-20 18:23 [bug#35813] [PATCH] import: crate: add recursive option Karl Meakin
2019-05-24 15:42 ` Ludovic Courtès
2019-05-25 19:38 ` Ivan Petkov
2019-07-20 18:30 ` [bug#35813] Brian Leung
2019-07-20 21:43 ` [bug#35813] Ivan Petkov
2019-08-05 17:50 ` Brian Leung [this message]
2019-08-06 3:42 ` [bug#35813] [PATCH] Add crate-recursive-import Brian Leung
2019-08-06 16:03 ` Brian Leung
2019-08-08 10:39 ` Efraim Flashner
2019-09-07 21:49 ` Brian Leung
2019-09-08 7:57 ` Efraim Flashner
2019-10-13 7:42 ` bug#35813: " Brian Leung
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='CAAc=MEyL1Fp_qHrEUVFn207D_3NABCAOxPtq8ezc9mDaS3wo9A@mail.gmail.com' \
--to=bkleung89@gmail.com \
--cc=35813@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).