Package: guix-patches;
Reported by: Martin Becze <mjbecze <at> riseup.net>
Date: Thu, 28 Nov 2019 00:14:01 UTC
Severity: normal
Tags: patch
Fixed in version 44560
Done: Hartmut Goebel <h.goebel <at> crazy-compilers.com>
Bug is archived. No further changes may be made.
Message #92 received at 38408 <at> debbugs.gnu.org (full text, mbox):
From: Martin Becze <mjbecze <at> riseup.net> To: 38408 <at> debbugs.gnu.org Cc: Martin Becze <mjbecze <at> riseup.net> Subject: [PATCH v4 3/6] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test. Date: Tue, 10 Dec 2019 14:23:40 -0500
* guix/import/crate.scm (make-crate-sexp): Use <crate> <crate-version> as args
* guix/import/crate.scm (crate->crate-version): New Procedure
* guix/import/crate.scm (crate->versions): New Procedure
* guix/import/crate.scm (crate-recursive-import): Updated to user recursive-import-semver
* guix/scripts/import/crate.scm (guix-import-crate): Remove `define-public` generation from UI
* guix/tests/crate.scm: Updated tests
---
guix/import/crate.scm | 165 ++++++++++++++++++----------------
guix/scripts/import/crate.scm | 9 +-
tests/crate.scm | 2 +-
3 files changed, 91 insertions(+), 85 deletions(-)
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 8dc014d232..da92c43b8c 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -38,6 +38,7 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-71)
#:export (crate->guix-package
guix-package->crate-name
crate-recursive-import
@@ -85,7 +86,7 @@
crate-dependency?
json->crate-dependency
(id crate-dependency-id "crate_id") ;string
- (kind crate-dependency-kind "kind" ;'normal | 'dev
+ (kind crate-dependency-kind "kind" ;'normal | 'dev | 'build
string->symbol)
(requirement crate-dependency-requirement "req")) ;string
@@ -111,7 +112,9 @@ record or #f if it was not found."
(url (string-append (%crate-base-url) path)))
(match (assoc-ref (or (json-fetch url) '()) "dependencies")
((? vector? vector)
- (map json->crate-dependency (vector->list vector)))
+ (filter (lambda (dep)
+ (not (eq? (crate-dependency-kind dep) 'dev)))
+ (map json->crate-dependency (vector->list vector))))
(_
'()))))
@@ -141,62 +144,84 @@ record or #f if it was not found."
((args ...)
`((arguments (,'quasiquote ,args))))))
-(define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inputs
- home-page synopsis description license
- #:allow-other-keys)
- "Return the `package' s-expression for a rust package with the given NAME,
-VERSION, CARGO-INPUTS, CARGO-DEVELOPMENT-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION,
-and LICENSE."
- (let* ((port (http-fetch (crate-uri name version)))
+(define (make-crate-sexp crate version* dependencies)
+ "Return the `package' s-expression for a rust package given <crate>,
+ <crate-version> and a list of <crate-dependency>"
+ (define normal-dependency?
+ (match-lambda ((_ dep) (not (eq? (crate-dependency-kind dep) 'dev)))))
+
+ (define (string->license string)
+ (match (regexp-exec %dual-license-rx string)
+ (#f (list (spdx-string->license string)))
+ (m (list (spdx-string->license (match:substring m 1))
+ (spdx-string->license (match:substring m 2))))))
+
+ (let* ((dep-crates dev-dep-crates (partition normal-dependency? dependencies))
+ (cargo-inputs (sort (unzip1 dep-crates)
+ string-ci<?))
+ (cargo-development-inputs
+ (sort (unzip1 dev-dep-crates)
+ string-ci<?))
+ (name (crate-name crate))
+ (version (crate-version-number version*))
+ (home-page (or (crate-home-page crate)
+ (crate-repository crate)))
+ (synopsis (crate-description crate))
+ (description (crate-description crate))
+ (license (and=> (crate-version-license version*)
+ string->license))
+ (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
- cargo-development-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-arguments (append (maybe-cargo-inputs cargo-inputs)
- (maybe-cargo-development-inputs
- cargo-development-inputs)))
- (home-page ,(match home-page
- (() "")
- (_ home-page)))
- (synopsis ,synopsis)
- (description ,(beautify-description description))
- (license ,(match license
- (() #f)
- ((license) license)
- (_ `(list ,@license)))))))
- (close-port port)
- pkg))
+ (name ,guix-name)
+ (version ,version)
+ (source (origin
+ (method url-fetch)
+ (uri (crate-uri ,name version))
+ (file-name (string-append name "-" version ".crate"))
+ (sha256
+ (base32
+ ,(bytevector->nix-base32-string (port-sha256 port))))))
+ (build-system cargo-build-system)
+ ,@(maybe-arguments (append (maybe-cargo-inputs cargo-inputs)
+ (maybe-cargo-development-inputs
+ cargo-development-inputs)))
+ (home-page ,(match home-page
+ (() "")
+ (_ home-page)))
+ (synopsis ,synopsis)
+ (description ,(beautify-description description))
+ (license ,(match license
+ (() #f)
+ ((license) license)
+ (_ `(list ,@license)))))))
+
+ (close-port port)
+ pkg))
(define %dual-license-rx
;; Dual licensing is represented by a string such as "MIT OR Apache-2.0".
;; This regexp matches that.
(make-regexp "^(.*) OR (.*)$"))
+(define (crate->crate-version crate version-number)
+ "returns the <crate-version> for a given CRATE and VERSION-NUMBER"
+ (find (lambda (version)
+ (string=? (crate-version-number version)
+ version-number))
+ (crate-versions crate)))
+
+(define (crate->versions crate)
+ "Returns a list of versions for a given CRATE"
+ (map (lambda (version)
+ (crate-version-number version))
+ (crate-versions crate)))
+
(define* (crate->guix-package crate-name #:optional version)
"Fetch the metadata for CRATE-NAME from crates.io, and return the
`package' s-expression corresponding to that package, or #f on failure.
When VERSION is specified, attempt to fetch that version; otherwise fetch the
latest version of CRATE-NAME."
- (define (string->license string)
- (match (regexp-exec %dual-license-rx string)
- (#f (list (spdx-string->license string)))
- (m (list (spdx-string->license (match:substring m 1))
- (spdx-string->license (match:substring m 2))))))
-
- (define (normal-dependency? dependency)
- (eq? (crate-dependency-kind dependency) 'normal))
-
(define crate
(lookup-crate crate-name))
@@ -205,38 +230,27 @@ latest version of CRATE-NAME."
(crate-latest-version crate)))
(define version*
- (find (lambda (version)
- (string=? (crate-version-number version)
- version-number))
- (crate-versions crate)))
+ (crate->crate-version crate version-number))
- (and crate version*
- (let* ((dependencies (crate-version-dependencies version*))
- (dep-crates (filter normal-dependency? dependencies))
- (dev-dep-crates (remove normal-dependency? dependencies))
- (cargo-inputs (sort (map crate-dependency-id dep-crates)
- string-ci<?))
- (cargo-development-inputs
- (sort (map crate-dependency-id dev-dep-crates)
- string-ci<?)))
- (values
- (make-crate-sexp #:name crate-name
- #:version (crate-version-number version*)
- #:cargo-inputs cargo-inputs
- #:cargo-development-inputs cargo-development-inputs
- #:home-page (or (crate-home-page crate)
- (crate-repository crate))
- #:synopsis (crate-description crate)
- #:description (crate-description crate)
- #:license (and=> (crate-version-license version*)
- string->license))
- (append cargo-inputs cargo-development-inputs)))))
+ (define dependencies (map
+ (lambda (dep)
+ (list (crate-name->package-name
+ (crate-dependency-id dep)) dep))
+ (crate-version-dependencies version*)))
+ (make-crate-sexp crate version* dependencies))
-(define (crate-recursive-import crate-name)
- (recursive-import crate-name #f
- #:repo->guix-package (lambda (name repo)
- (crate->guix-package name))
- #:guix-name crate-name->package-name))
+(define* (crate-recursive-import name #:optional version)
+ (recursive-import-semver
+ #:name name
+ #:version version
+ #:name->metadata lookup-crate
+ #:metadata->package crate->crate-version
+ #:metadata-versions crate->versions
+ #:package-dependencies crate-version-dependencies
+ #:dependency-name crate-dependency-id
+ #:dependency-range crate-dependency-requirement
+ #:guix-name crate-name->package-name
+ #:make-sexp make-crate-sexp))
(define (guix-package->crate-name package)
"Return the crate name of PACKAGE."
@@ -285,4 +299,3 @@ latest version of CRATE-NAME."
(description "Updater for crates.io packages")
(pred crate-package?)
(latest latest-release)))
-
diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm
index 4690cceb4d..85ae6fbe59 100644
--- a/guix/scripts/import/crate.scm
+++ b/guix/scripts/import/crate.scm
@@ -96,14 +96,7 @@ Import and convert the crate.io package for PACKAGE-NAME.\n"))
(package-name->name+version spec))
(if (assoc-ref opts 'recursive)
- (map (match-lambda
- ((and ('package ('name name) . rest) pkg)
- `(define-public ,(string->symbol name)
- ,pkg))
- (_ #f))
- (reverse
- (stream->list
- (crate-recursive-import name))))
+ (stream->list (crate-recursive-import name version))
(let ((sexp (crate->guix-package name version)))
(unless sexp
(leave (G_ "failed to download meta-data for package '~a'~%")
diff --git a/tests/crate.scm b/tests/crate.scm
index c14862ad9f..b77cbb08c6 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -95,7 +95,7 @@
('source ('origin
('method 'url-fetch)
('uri ('crate-uri "foo" 'version))
- ('file-name ('string-append 'name "-" 'version ".tar.gz"))
+ ('file-name ('string-append 'name "-" 'version ".crate"))
('sha256
('base32
(? string? hash)))))
--
2.24.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.