From a3528e0b3333864528805150a16caad88c07fd7a Mon Sep 17 00:00:00 2001 From: Brian Leung 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(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 52c5cb1c30..355f0264bc 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,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." 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)) @@ -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