From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:470:142:3::10]:52421) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ibL7E-0001d3-Ph for guix-patches@gnu.org; Sun, 01 Dec 2019 04:02:06 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ibL7C-0000Lw-I5 for guix-patches@gnu.org; Sun, 01 Dec 2019 04:02:04 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:57732) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1ibL7C-0000Kr-C4 for guix-patches@gnu.org; Sun, 01 Dec 2019 04:02:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ibL7C-00086T-9y for guix-patches@gnu.org; Sun, 01 Dec 2019 04:02:02 -0500 Subject: [bug#38408] [PATCH 3/3] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test. Resent-Message-ID: Date: Sun, 1 Dec 2019 11:00:58 +0200 From: Efraim Flashner Message-ID: <20191201090058.GC14869@E5400> References: <052524339786cd4c0db5fda81547239c8bee6003.1574897905.git.mjbecze@riseup.net> <42cb010759c8355943b9e2cb71a66b93@riseup.net> MIME-Version: 1.0 Content-Type: multipart/signed; micalg=pgp-sha512; protocol="application/pgp-signature"; boundary="ABTtc+pdwF7KHXCz" Content-Disposition: inline In-Reply-To: <42cb010759c8355943b9e2cb71a66b93@riseup.net> List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: Martin Becze Cc: 38408@debbugs.gnu.org --ABTtc+pdwF7KHXCz Content-Type: text/plain; charset=utf-8 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable On Sat, Nov 30, 2019 at 08:36:20AM -0800, Martin Becze wrote: > On 2019-11-28 00:16, Martin Becze wrote: > > * guix/import/crate.scm (make-crate-sexp): Use = 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(-) > >=20 > > 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 | 'b= uild > > string->symbol) > > (requirement crate-dependency-requirement "req")) ;string > > =20 > > @@ -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)))) > > (_ > > '())))) > > =20 > > @@ -141,62 +144,84 @@ record or #f if it was not found." > > ((args ...) > > `((arguments (,'quasiquote ,args)))))) > > =20 > > -(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 , > > + and a list of " > > + (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=3D> (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 carg= o-inputs) > > - (maybe-cargo-development= -inputs > > - cargo-development-inpu= ts))) > > - (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-i= nputs > > + 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)) > > =20 > > (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 (.*)$")) > > =20 > > +(define (crate->crate-version crate version-number) > > + "returns the for a given CRATE and VERSION-NUMBER" > > + (find (lambda (version) > > + (string=3D? (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 fe= tch 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)) > > =20 > > @@ -205,38 +230,27 @@ latest version of CRATE-NAME." > > (crate-latest-version crate))) > > =20 > > (define version* > > - (find (lambda (version) > > - (string=3D? (crate-version-number version) > > - version-number)) > > - (crate-versions crate))) > > + (crate->crate-version crate version-number)) > > =20 > > - (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-crate= s) > > - 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-developmen= t-inputs > > - #:home-page (or (crate-home-page crate) > > - (crate-repository crate)) > > - #:synopsis (crate-description crate) > > - #:description (crate-description crate) > > - #:license (and=3D> (crate-version-license v= ersion*) > > - 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)) > > =20 > > -(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)) > > =20 > > (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)) > > =20 > > (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 ".t= ar.gz")) > > + ('file-name ('string-append 'name "-" 'version ".c= rate")) > > ('sha256 > > ('base32 > > (? string? hash))))) >=20 > 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. I like this idea. Then we can also unhide all the rust crates. It helps when people search for them and when guix searches for them to see if they can be updated or need to be imported. > From 3f2ff3b4dc4cdf8b0282316b9c2426291da8a6c7 Mon Sep 17 00:00:00 2001 > From: Martin Becze > Date: Sat, 30 Nov 2019 11:27:05 -0500 > Subject: [PATCH] added "#:skip-build? #t" to the output of (make-crate-se= xp). > Most the the packages imported will be libaries and won't need to build.= The > top level package will build them though. >=20 > * guix/import/crate.scm (make-crate-sexp): added "#:skip-build? #t" to th= e output > --- > guix/import/crate.scm | 3 ++- > tests/crate.scm | 3 ++- > 2 files changed, 4 insertions(+), 2 deletions(-) >=20 > diff --git a/guix/import/crate.scm b/guix/import/crate.scm > index da92c43b8c..5683369b7a 100644 > --- a/guix/import/crate.scm > +++ b/guix/import/crate.scm > @@ -183,7 +183,8 @@ record or #f if it was not found." > (base32 > ,(bytevector->nix-base32-string (port-sha25= 6 port)))))) > (build-system cargo-build-system) > - ,@(maybe-arguments (append (maybe-cargo-inputs cargo-in= puts) > + ,@(maybe-arguments (append `(#:skip-build? #t) > + (maybe-cargo-inputs cargo-in= puts) > (maybe-cargo-development-inp= uts > cargo-development-inputs))) > (home-page ,(match home-page > diff --git a/tests/crate.scm b/tests/crate.scm > index b77cbb08c6..64e5b6932e 100644 > --- a/tests/crate.scm > +++ b/tests/crate.scm > @@ -102,7 +102,8 @@ > ('build-system 'cargo-build-system) > ('arguments > ('quasiquote > - ('#:cargo-inputs (("rust-bar" ('unquote rust-bar)))))) > + ('#:skip-build? #t > + #:cargo-inputs (("rust-bar" ('unquote rust-bar)))))) > ('home-page "http://example.com") > ('synopsis "summary") > ('description "summary") > --=20 > 2.24.0 >=20 --=20 Efraim Flashner =D7=90=D7=A4=D7=A8=D7=99=D7=9D = =D7=A4=D7=9C=D7=A9=D7=A0=D7=A8 GPG key =3D A28B F40C 3E55 1372 662D 14F7 41AA E7DC CA3D 8351 Confidentiality cannot be guaranteed on emails sent or received unencrypted --ABTtc+pdwF7KHXCz Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAABCgAdFiEEoov0DD5VE3JmLRT3Qarn3Mo9g1EFAl3jgUoACgkQQarn3Mo9 g1GGEg/+I9QUTNDqunu8gNW9k3dKZJewqCvfye0cy4OZRjFAO6U+ucaZ1XfsyLfP r0Mqr00GsWR60dua2VRIrvRQDJUDvH8glhUilcvbogdE4OhKkUFjg3uQISkuMybd KU81NYY7RljJ7iq3+soT40z6H3RYIYGtU9hVVU6nPdC5iJExPhclk8QAnrtHX8Wh 7lHpWYHyxQPRgsj5rTbbby+b2qDsk6t/6SWsaguhmkQvEf1ijom/0MVdP+pwqTSI PBtQUsvfJv+5l3tXsV5Di31ee217su8DMmGwNelG7Fpq5z45FLEenHmk18rtochp Gk0Iupjon1gKSxT59+zliv4S/saD7oYayeTdcDfBgmx+goCxpJfmmnQd9tySVf6T 3RkpZWYw9T8F6PAx4Tu2qBl2Bv/OznOd4w7itJkBqIRgX3Qe2rJ1RdqWYtFuqb8D HZ80l9A+6Q9GpHnbSXpBOQKD3sW0415jipERl0TF5mkTCLzikkGZFcgtm+gr8Ud0 fds2KVMd/iLiX95MbgAYJoE0DgIZdpYq3WSznEBpa9pUo8UcMw5yttTa/qSU/5Iy L3PR4AF9uPzlnI9mSHAKC1I0lTAxAdHfsql4vjqP/YYfz/Jh8v604BD/f8t0kjAg hKuu7zFudz04oltJL2qiDzLjw2XQixiSKS8i0VceGLaV6CFa/Us= =ss+7 -----END PGP SIGNATURE----- --ABTtc+pdwF7KHXCz--