[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#38408] [PATCH 3/3] Rewrote some of guix/import/crate.scm to use rec
|
From: |
Martin Becze |
|
Subject: |
[bug#38408] [PATCH 3/3] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test. |
|
Date: |
Sat, 30 Nov 2019 08:36:20 -0800 |
On 2019-11-28 00:16, Martin Becze wrote:
> * 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)))))
I'm added a patch that will skips the building of libraries which I
would assume most of the packages being imported are. This could be
parametrized in the future.
0001-added-skip-build-t-to-the-output-of-make-crate-sexp-.patch
Description: Text Data