From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:470:142:3::10]:38192) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jGPwq-0006VG-M7 for guix-patches@gnu.org; Mon, 23 Mar 2020 12:29:14 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1jGPwk-0008Hi-J7 for guix-patches@gnu.org; Mon, 23 Mar 2020 12:29:08 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:47463) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1jGPwk-0008HS-7r for guix-patches@gnu.org; Mon, 23 Mar 2020 12:29:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jGPwk-0006Q1-3a for guix-patches@gnu.org; Mon, 23 Mar 2020 12:29:02 -0400 Subject: [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix Resent-Message-ID: From: Martin Becze References: <20200217100345.GI1968@E5400> <87wo8l702y.fsf@gnu.org> <874kvld2bl.fsf@gnu.org> <87sgj4nwjw.fsf@gnu.org> <8453e3ce-bc5a-3bb3-1bfb-deaca7ca11d3@riseup.net> <6386cf3e-1156-8d09-a264-cacbb4935f03@riseup.net> <47ed3e36-0d9f-cd6f-a64b-e3f9c9d71537@riseup.net> <20200322201018.GB16716@jasmine.lan> <45972138-5bf8-821a-178a-c04e6446e076@riseup.net> Message-ID: Date: Mon, 23 Mar 2020 12:28:04 -0400 MIME-Version: 1.0 In-Reply-To: <45972138-5bf8-821a-178a-c04e6446e076@riseup.net> Content-Type: multipart/mixed; boundary="------------0AC17FC6EDF18AC5FE1AEF52" Content-Language: en-US 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: Leo Famulari Cc: 38408@debbugs.gnu.org, Ludovic =?UTF-8?Q?Court=C3=A8s?= , Efraim Flashner , jsoo1@asu.edu This is a multi-part message in MIME format. --------------0AC17FC6EDF18AC5FE1AEF52 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 8bit Attached I the updated patch set with cleaned up commit log. Let me know if you see any more mistakes. Thanks! On 3/23/20 5:50 AM, Martin Becze wrote: > Thanks for the feedback Leo! I will work on this today. > > On 3/22/20 4:10 PM, Leo Famulari wrote: >> On Sat, Mar 21, 2020 at 02:35:47PM -0400, Martin Becze wrote: >>> A few things got stale and need to be merged so I have regenerated >>> the patch >>> set! Let me know if there is anymore things to do. >> >> Alright, I started taking a close look at the patches and they need some >> more work. At least, the commit messages need to be completed. The >> importer does work, which is amazing, so we are almost there :) >> >> In general, the commit messages need to be rewritten to match our style. >> This means they should use complete English sentences with standard >> capitalization and punctuation. I'm happy to help if necessary. English >> is my native language. >> >> We also should try to match previous commit messages that touch the same >> code, because they are good examples. Take this example, the first patch: >> >>> Subject: [PATCH v11 1/9] guix: import: (recursive-import) Allow for >>> version >>>   numbers >> >> This commit title should be written like this: >> >> import: utils: 'recursive-import' accepts an optional version parameter. >> >> I learned that by doing `git log guix/import/utils.scm` and reading the >> previous commits. >> >>> * guix/import/utils.scm (package->definition): added optional >>> `append-version?` >>> * guix/import/utils.scm (recursive-import): added key `version` and >>>    moved `repo` to be a key >> >> When changing multiple variables in the same file, the filename can be >> mentioned only once. I would write that like this: >> >> * guix/import/utils.scm (recursive-import): Add the VERSION key. Make >> REPO a key. >> (package->definition): Accept an optional 'append-version?' key. >> >> I began to rewrite the rest of the commit message like this: >> >> * guix/import/cran.scm (cran->guix-package): Change the REPO parameter >> to a key. >> (cran-recursive-import): Likewise. >> * guix/import/elpa.scm (elpa->guix-package): Likewise. >> (elpa-recursive-import): Likewise. >> * guix/import/gem.scm (gem-recursive-import): Likewise. >> * guix/scripts/import/cran.scm (guix-import-cran): Likewise. >> * guix/scripts/import/elpa.scm (guix-import-elpa): Likewise. >> * guix/import/opam.scm (opam-recursive-import): Likewise. >> * guix/import/pypi.scm (pypi-recursive-import): Likewise. >> * guix/import/stackage.scm (stackage-recursive-import): Likewise. >> >> >> However, I found some issues. >> >>> * guix/import/gem.scm (gem->guix-package): change `repo` to a key >> >> This change does not exist in this commit. >> >>>   tests/elpa.scm               |  3 +- >>>   tests/import-utils.scm       |  8 +++-- >> >> And these changes are not mentioned in the commit message. >> >> These issues make it hard to review the patches effectively. >> >> What do you think? Can you make these changes? >> > > > --------------0AC17FC6EDF18AC5FE1AEF52 Content-Type: text/x-patch; charset=UTF-8; name="v12-0008-guix-self-Adds-guile-semver-as-a-depenedency.patch" Content-Transfer-Encoding: 8bit Content-Disposition: attachment; filename*0="v12-0008-guix-self-Adds-guile-semver-as-a-depenedency.patch" >From 494f7c874781f64b702e31841c95c95c68fb28fc Mon Sep 17 00:00:00 2001 From: Martin Becze Date: Fri, 21 Feb 2020 10:41:44 -0500 Subject: [PATCH v12 8/8] guix: self: Adds guile-semver as a depenedency. * guix/self.scm (compiled-guix) Added guile-semver as a depenedency. --- guix/self.scm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/guix/self.scm b/guix/self.scm index 6b633f9bc0..7da7fdea81 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2020 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -54,6 +55,7 @@ ("guile-git" (ref '(gnu packages guile) 'guile3.0-git)) ("guile-sqlite3" (ref '(gnu packages guile) 'guile3.0-sqlite3)) ("guile-gcrypt" (ref '(gnu packages gnupg) 'guile3.0-gcrypt)) + ("guile-semver" (ref '(gnu packages guile-xyz) 'guile3.0-semver)) ("gnutls" (ref '(gnu packages tls) 'guile3.0-gnutls)) ("zlib" (ref '(gnu packages compression) 'zlib)) ("lzlib" (ref '(gnu packages compression) 'lzlib)) @@ -682,6 +684,9 @@ Info manual." (define guile-gcrypt (specification->package "guile-gcrypt")) + (define guile-semver + (specification->package "guile-semver")) + (define gnutls (specification->package "gnutls")) @@ -690,7 +695,7 @@ Info manual." (cons (list "x" package) (package-transitive-propagated-inputs package))) (list guile-gcrypt gnutls guile-git guile-json - guile-ssh guile-sqlite3)) + guile-ssh guile-sqlite3 guile-semver)) (((labels packages _ ...) ...) packages))) -- 2.25.1 --------------0AC17FC6EDF18AC5FE1AEF52 Content-Type: text/x-patch; charset=UTF-8; name="v12-0007-gnu-Add-guile3.0-semver.patch" Content-Transfer-Encoding: 8bit Content-Disposition: attachment; filename="v12-0007-gnu-Add-guile3.0-semver.patch" >From 492db2aed32bb68e50eb43660d5ec3811fdb9a80 Mon Sep 17 00:00:00 2001 From: Martin Becze Date: Sun, 23 Feb 2020 04:27:42 -0500 Subject: [PATCH v12 7/8] gnu: Add guile3.0-semver. * gnu/packages/guile-xyz.scm (guile3.0-semver): New variable. --- gnu/packages/guile-xyz.scm | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/gnu/packages/guile-xyz.scm b/gnu/packages/guile-xyz.scm index a2430b7ea3..09427da487 100644 --- a/gnu/packages/guile-xyz.scm +++ b/gnu/packages/guile-xyz.scm @@ -23,6 +23,7 @@ ;;; Copyright © 2019 swedebugia ;;; Copyright © 2019, 2020 Amar Singh ;;; Copyright © 2019 Timothy Sample +;;; Copyright © 2019 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -2996,6 +2997,13 @@ comparing, and writing Semantic Versions. It also includes ranges in the style of the Node Package Manager (NPM).") (license license:gpl3+))) +(define-public guile3.0-semver + (package + (inherit guile-semver) + (name "guile3.0-semver") + (inputs + `(("guile" ,guile-3.0))))) + (define-public guile-hashing (package (name "guile-hashing") -- 2.25.1 --------------0AC17FC6EDF18AC5FE1AEF52 Content-Type: text/x-patch; charset=UTF-8; name="v12-0006-import-crate-Parametrized-importing-of-dev-depen.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="v12-0006-import-crate-Parametrized-importing-of-dev-depen.pa"; filename*1="tch" >From 2561fbf64e7ea47a0436b3751cbeea0032f8a77b Mon Sep 17 00:00:00 2001 From: Martin Becze Date: Mon, 3 Feb 2020 16:19:49 -0500 Subject: [PATCH v12 6/8] import: crate: Parametrized importing of dev dependencies. This changes the behavoir of the recusive crate importer so that it will include importing of development dependencies for the top level package but will not inculded the development dependencies for any other imported package. * guix/import/crate.scm (make-crate-sexp): Add the key BUILD?. (crate->guix-package): Add the key INCLUDE-DEV-DEPS?. (crate-recursive-import): Likewise. * guix/scripts/import/crate.scm (guix-import-crate): Likewise. * tests/crate.scm (cargo-recursive-import): Likewise. --- guix/import/crate.scm | 28 ++++++++++++++++++++-------- guix/scripts/import/crate.scm | 4 ++-- tests/crate.scm | 3 +-- 3 files changed, 23 insertions(+), 12 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 00ac6ee318..91e38839bd 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -152,7 +152,7 @@ record or #f if it was not found." `((arguments (,'quasiquote ,args)))))) (define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inputs - home-page synopsis description license + home-page synopsis description license build? #: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, @@ -179,7 +179,9 @@ and LICENSE." (base32 ,(bytevector->nix-base32-string (port-sha256 port)))))) (build-system cargo-build-system) - ,@(maybe-arguments (append '(#:skip-build? #t) + ,@(maybe-arguments (append (if build? + '() + '(#:skip-build? #t)) (maybe-cargo-inputs cargo-inputs) (maybe-cargo-development-inputs cargo-development-inputs))) @@ -204,11 +206,13 @@ and LICENSE." 'unknown-license!))) (string-split string (string->char-set " /")))) -(define* (crate->guix-package crate-name #:key version #:allow-other-keys) +(define* (crate->guix-package crate-name #:key version include-dev-deps? + #:allow-other-keys) "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." +latest version of CRATE-NAME. If INCLUDE-DEV-DEPS is true then this +will also lookup the development dependencs for the given crate." (define (semver-range-contains-string? range version) (semver-range-contains? (string->semver-range range) @@ -254,9 +258,12 @@ latest version of CRATE-NAME." (let* ((dependencies (crate-version-dependencies version*)) (dep-crates dev-dep-crates (partition normal-dependency? dependencies)) (cargo-inputs (sort-map-deps dep-crates)) - (cargo-development-inputs '())) + (cargo-development-inputs (if include-dev-deps? + (sort-map-deps dev-dep-crates) + '()))) (values - (make-crate-sexp #:name crate-name + (make-crate-sexp #:build? include-dev-deps? + #:name crate-name #:version (crate-version-number version*) #:cargo-inputs cargo-inputs #:cargo-development-inputs cargo-development-inputs @@ -266,13 +273,18 @@ latest version of CRATE-NAME." #:description (crate-description crate) #:license (and=> (crate-version-license version*) string->license)) - cargo-inputs)))) + (append cargo-inputs cargo-development-inputs))))) (define mem-crate->guix-package (memoize crate->guix-package)) (define* (crate-recursive-import crate-name #:key version) (recursive-import crate-name - #:repo->guix-package mem-crate->guix-package + #:repo->guix-package + (lambda* params + ;; only download the development dependencies for the top level package + (let ((include-dev-deps? (equal? (car params) crate-name))) + (apply mem-crate->guix-package + (append params `(#:include-dev-deps? ,include-dev-deps?))))) #:version version #:guix-name crate-name->package-name)) diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm index 552628cfc7..9252c52dfa 100644 --- a/guix/scripts/import/crate.scm +++ b/guix/scripts/import/crate.scm @@ -96,13 +96,13 @@ Import and convert the crate.io package for PACKAGE-NAME.\n")) (if (assoc-ref opts 'recursive) (crate-recursive-import name #:version version) - (let ((sexp (crate->guix-package name #:version version))) + (let ((sexp (crate->guix-package name #:version version #:include-dev-deps? #t))) (unless sexp (leave (G_ "failed to download meta-data for package '~a'~%") (if version (string-append name "@" version) name))) - sexp))) + (list sexp)))) (() (leave (G_ "too few arguments~%"))) ((many ...) diff --git a/tests/crate.scm b/tests/crate.scm index 893dd70fc9..6fb9b772d8 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -461,8 +461,7 @@ (? string? hash))))) (build-system cargo-build-system) (arguments - ('quasiquote (#:skip-build? - #t #:cargo-inputs + ('quasiquote (#:cargo-inputs (("rust-intermediate-1" ('unquote rust-intermediate-1-1.0)) ("rust-intermediate-2" -- 2.25.1 --------------0AC17FC6EDF18AC5FE1AEF52 Content-Type: text/x-patch; charset=UTF-8; name="v12-0005-import-utils-Trim-patch-version-from-names.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="v12-0005-import-utils-Trim-patch-version-from-names.patch" >From cb69a7c4844c68f89b783a1026751ab945fcab5d Mon Sep 17 00:00:00 2001 From: Martin Becze Date: Thu, 30 Jan 2020 11:19:13 -0500 Subject: [PATCH v12 5/8] import: utils: Trim patch version from names. This remove the the patch version from input names. For example 'rust-my-crate-1.1.2' now becomes 'rust-my-crate-1.1' * guix/import/utils.scm (package->definition): Trim patch version from generated package names. * tests/crate.scm: (cargo>guix-package): Likewise. (cargo-recursive-import): Likewise. --- guix/import/utils.scm | 7 ++++--- tests/crate.scm | 44 +++++++++++++++++++++---------------------- 2 files changed, 26 insertions(+), 25 deletions(-) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 709cd718f6..a0aacdc6de 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -265,9 +265,10 @@ package definition." ('package ('name name) ('version version) . rest) ('let _ ('package ('name name) ('version version) . rest))) - `(define-public ,(string->symbol (if append-version? - (string-append name "-" version) - version)) + `(define-public ,(string->symbol + (if append-version? + (string-append name "-" (version-major+minor version)) + version)) ,guix-package)))) (define (build-system-modules) diff --git a/tests/crate.scm b/tests/crate.scm index 39561d5745..893dd70fc9 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -279,7 +279,7 @@ (_ (error "Unexpected URL: " url))))) (match (crate->guix-package "foo") - ((define-public rust-foo-1.0.0 + ((define-public rust-foo-1.0 (package (name "rust-foo") (version "1.0.0") (source @@ -295,7 +295,7 @@ ('quasiquote (#:skip-build? #t #:cargo-inputs - (("rust-leaf-alice-1.0.0" ('unquote rust-leaf-alice-1.0.0)))))) + (("rust-leaf-alice" ('unquote rust-leaf-alice-1.0)))))) (home-page "http://example.com") (synopsis "summary") (description "summary") @@ -358,7 +358,7 @@ (_ (error "Unexpected URL: " url))))) (match (crate-recursive-import "root") ;; rust-intermediate-2 has no dependency on the rust-leaf-alice package, so this is a valid ordering - (((define-public rust-leaf-alice-1.0.0 + (((define-public rust-leaf-alice-1.0 (package (name "rust-leaf-alice") (version (? string? ver)) @@ -377,7 +377,7 @@ (synopsis "summary") (description "summary") (license (list license:expat license:asl2.0)))) - (define-public rust-leaf-bob-1.0.0 + (define-public rust-leaf-bob-1.0 (package (name "rust-leaf-bob") (version (? string? ver)) @@ -396,7 +396,7 @@ (synopsis "summary") (description "summary") (license (list license:expat license:asl2.0)))) - (define-public rust-intermediate-2-1.0.0 + (define-public rust-intermediate-2-1.0 (package (name "rust-intermediate-2") (version (? string? ver)) @@ -413,13 +413,13 @@ (arguments ('quasiquote (#:skip-build? #t #:cargo-inputs - (("rust-leaf-bob-1.0.0" + (("rust-leaf-bob" ('unquote rust-leaf-bob-1.0.0)))))) (home-page "http://example.com") (synopsis "summary") (description "summary") (license (list license:expat license:asl2.0)))) - (define-public rust-intermediate-1-1.0.0 + (define-public rust-intermediate-1-1.0 (package (name "rust-intermediate-1") (version (? string? ver)) @@ -436,17 +436,17 @@ (arguments ('quasiquote (#:skip-build? #t #:cargo-inputs - (("rust-intermediate-2-1.0.0" - ,rust-intermediate-2-1.0.0) - ("rust-leaf-alice-1.0.0" - ('unquote rust-leaf-alice-1.0.0)) - ("rust-leaf-bob-1.0.0" - ('unquote rust-leaf-bob-1.0.0)))))) + (("rust-intermediate-2" + ,rust-intermediate-2-1.0) + ("rust-leaf-alice" + ('unquote rust-leaf-alice-1.0)) + ("rust-leaf-bob" + ('unquote rust-leaf-bob-1.0)))))) (home-page "http://example.com") (synopsis "summary") (description "summary") (license (list license:expat license:asl2.0)))) - (define-public rust-root-1.0.0 + (define-public rust-root-1.0 (package (name "rust-root") (version (? string? ver)) @@ -463,14 +463,14 @@ (arguments ('quasiquote (#:skip-build? #t #:cargo-inputs - (("rust-intermediate-1-1.0.0" - ('unquote rust-intermediate-1-1.0.0)) - ("rust-intermediate-2-1.0.0" - ('unquote rust-intermediate-2-1.0.0)) - ("rust-leaf-alice-1.0.0" - ('unquote rust-leaf-alice-1.0.0)) - ("rust-leaf-bob-1.0.0" - ('unquote rust-leaf-bob-1.0.0)))))) + (("rust-intermediate-1" + ('unquote rust-intermediate-1-1.0)) + ("rust-intermediate-2" + ('unquote rust-intermediate-2-1.0)) + ("rust-leaf-alice" + ('unquote rust-leaf-alice-1.0)) + ("rust-leaf-bob" + ('unquote rust-leaf-bob-1.0)))))) (home-page "http://example.com") (synopsis "summary") (description "summary") -- 2.25.1 --------------0AC17FC6EDF18AC5FE1AEF52 Content-Type: text/x-patch; charset=UTF-8; name="v12-0004-import-crate-Memorize-crate-guix-package.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="v12-0004-import-crate-Memorize-crate-guix-package.patch" >From 3f2dbc2a47a2e5e46871fbdeabe951f55d26b557 Mon Sep 17 00:00:00 2001 From: Martin Becze Date: Thu, 30 Jan 2020 11:17:00 -0500 Subject: [PATCH v12 4/8] import: crate: Memorize crate->guix-package. This adds memorization to procedures that involve network lookups. 'mem-lookup-crate; is used on every dependency of a package to find it's versions. 'mem-crate->guix-package; is needed becuase 'topological-sort' depduplicates after dependencies have been turned into packages. * guix/import/crate.scm (mem-crate->guix-package): New procedure. (mem-lookup-crate): New procedure. --- guix/import/crate.scm | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index b2a3dd7e70..00ac6ee318 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -28,6 +28,7 @@ #:use-module (guix import json) #:use-module (guix import utils) #:use-module ((guix licenses) #:prefix license:) + #:use-module (guix memoization) #:use-module (guix monads) #:use-module (guix packages) #:use-module (guix upstream) @@ -111,6 +112,8 @@ record or #f if it was not found." (json->crate `(,@alist ("actual_versions" . ,versions)))))))) +(define mem-lookup-crate (memoize lookup-crate)) + (define (crate-version-dependencies version) "Return the list of records of VERSION, a ." @@ -216,7 +219,7 @@ latest version of CRATE-NAME." (eq? (crate-dependency-kind dependency) 'normal))) (define crate - (lookup-crate crate-name)) + (mem-lookup-crate crate-name)) (define version-number (or version @@ -238,7 +241,7 @@ latest version of CRATE-NAME." containing pairs of (name version)" (sort (map (lambda (dep) (let* ((name (crate-dependency-id dep)) - (crate (lookup-crate name)) + (crate (mem-lookup-crate name)) (req (crate-dependency-requirement dep)) (ver (find-version crate req))) (list name @@ -265,9 +268,11 @@ latest version of CRATE-NAME." string->license)) cargo-inputs)))) +(define mem-crate->guix-package (memoize crate->guix-package)) + (define* (crate-recursive-import crate-name #:key version) (recursive-import crate-name - #:repo->guix-package crate->guix-package + #:repo->guix-package mem-crate->guix-package #:version version #:guix-name crate-name->package-name)) -- 2.25.1 --------------0AC17FC6EDF18AC5FE1AEF52 Content-Type: text/x-patch; charset=UTF-8; name="v12-0003-import-crate-Deduplicate-dependencies.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="v12-0003-import-crate-Deduplicate-dependencies.patch" >From 81056961d065e197fe8f1f2096c858776debf485 Mon Sep 17 00:00:00 2001 From: Martin Becze Date: Thu, 30 Jan 2020 10:52:28 -0500 Subject: [PATCH v12 3/8] import: crate: Deduplicate dependencies. * guix/import/crate.scm (crate-version-dependencies): Deduplicate crate dependencies. --- guix/import/crate.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 7e61bc21b6..b2a3dd7e70 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -118,7 +118,7 @@ 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))) + (delete-duplicates (map json->crate-dependency (vector->list vector)))) (_ '())))) -- 2.25.1 --------------0AC17FC6EDF18AC5FE1AEF52 Content-Type: text/x-patch; charset=UTF-8; name="v12-0002-import-crate-Use-guile-semver-to-resovle-module-.patch" Content-Transfer-Encoding: 8bit Content-Disposition: attachment; filename*0="v12-0002-import-crate-Use-guile-semver-to-resovle-module-.pa"; filename*1="tch" >From 98129432b4d746fd2a12a005ebe2d36e8ee0f600 Mon Sep 17 00:00:00 2001 From: Martin Becze Date: Tue, 4 Feb 2020 03:50:48 -0500 Subject: [PATCH v12 2/8] import: crate: Use guile-semver to resovle module versions. * guix/import/crate.scm (make-crate-sexp): Added '#:skip-build?' to build system args. Pass a VERSION argument to 'cargo-inputs'. Move 'package-definition' from scripts/import/crate.scm to here. (crate->guix-package): Use guile-semver to resolve the correct module versions. (crate-name->package-name): Reuse the procedure 'guix-name' instead of duplicating its logic. (module) Added guile-semver as a soft dependency. * guix/import/utils.scm (package-names->package-inputs): Implemented handling of (name version) pairs. * guix/scripts/import/crate.scm (guix-import-crate): Move 'package-definition' from here to guix/import/crate.scm. * tests/crate.scm: (recursuve-import) Added version data to the test. --- guix/import/crate.scm | 91 +++++++---- guix/import/utils.scm | 21 ++- guix/scripts/import/crate.scm | 11 +- tests/crate.scm | 290 +++++++++++++++++++--------------- 4 files changed, 243 insertions(+), 170 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 57823c3639..7e61bc21b6 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 David Craven ;;; Copyright © 2019, 2020 Ludovic Courtès -;;; Copyright © 2019 Martin Becze +;;; Copyright © 2019, 2020 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -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 string->license @@ -86,10 +87,15 @@ 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 +(module-autoload! (current-module) + '(semver) '(string->semver)) +(module-autoload! (current-module) + '(semver ranges) '(string->semver-range semver-range-contains?)) + (define (lookup-crate name) "Look up NAME on https://crates.io and return the corresopnding record or #f if it was not found." @@ -148,11 +154,17 @@ record or #f if it was not found." "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." + (define (format-inputs inputs) + (map + (match-lambda + ((name version) (list (crate-name->package-name name) + (version-major+minor version)))) + inputs)) + (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 - cargo-development-inputs)) + (cargo-inputs (format-inputs cargo-inputs)) + (cargo-development-inputs (format-inputs cargo-development-inputs)) (pkg `(package (name ,guix-name) (version ,version) @@ -164,9 +176,10 @@ 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 '(#:skip-build? #t) + (maybe-cargo-inputs cargo-inputs) (maybe-cargo-development-inputs - cargo-development-inputs))) + cargo-development-inputs))) (home-page ,(match home-page (() "") (_ home-page))) @@ -177,7 +190,7 @@ and LICENSE." ((license) license) (_ `(list ,@license))))))) (close-port port) - pkg)) + (package->definition pkg #t))) (define (string->license string) (filter-map (lambda (license) @@ -188,14 +201,19 @@ and LICENSE." 'unknown-license!))) (string-split string (string->char-set " /")))) -(define* (crate->guix-package crate-name #:optional version) +(define* (crate->guix-package crate-name #:key version #:allow-other-keys) "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 (semver-range-contains-string? range version) + (semver-range-contains? (string->semver-range range) + (string->semver version))) + (define (normal-dependency? dependency) - (eq? (crate-dependency-kind dependency) 'normal)) + (or (eq? (crate-dependency-kind dependency) 'build) + (eq? (crate-dependency-kind dependency) 'normal))) (define crate (lookup-crate crate-name)) @@ -204,21 +222,36 @@ latest version of CRATE-NAME." (or version (crate-latest-version crate))) - (define version* + (define (find-version crate range) + "finds the a vesion of a crate that fulfils the semver " (find (lambda (version) - (string=? (crate-version-number version) - version-number)) + (semver-range-contains-string? + range + (crate-version-number version))) (crate-versions crate))) + (define version* + (find-version crate version-number)) + + (define (sort-map-deps deps) + "sorts the dependencies and maps the dependencies to a list + containing pairs of (name version)" + (sort (map (lambda (dep) + (let* ((name (crate-dependency-id dep)) + (crate (lookup-crate name)) + (req (crate-dependency-requirement dep)) + (ver (find-version crate req))) + (list name + (crate-version-number ver)))) + deps) + (match-lambda* (((_ name) ...) + (apply string-ci (crate-version-license version*) string->license)) - (append cargo-inputs cargo-development-inputs))))) + cargo-inputs)))) -(define* (crate-recursive-import crate-name #:optional version) - (recursive-import crate-name #f - #:repo->guix-package - (lambda (name repo) - (let ((version (and (string=? name crate-name) - version))) - (crate->guix-package name version))) +(define* (crate-recursive-import crate-name #:key version) + (recursive-import crate-name + #:repo->guix-package crate->guix-package + #:version version #:guix-name crate-name->package-name)) (define (guix-package->crate-name package) @@ -253,7 +283,7 @@ latest version of CRATE-NAME." ((name _ ...) name)))) (define (crate-name->package-name name) - (string-append "rust-" (string-join (string-split name #\_) "-"))) + (guix-name "rust-" name)) ;;; @@ -288,4 +318,3 @@ latest version of CRATE-NAME." (description "Updater for crates.io packages") (pred crate-package?) (latest latest-release))) - diff --git a/guix/import/utils.scm b/guix/import/utils.scm index cd92cf7dd8..709cd718f6 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -225,13 +225,20 @@ into a proper sentence and by using two spaces between sentences." cleaned 'pre ". " 'post))) (define* (package-names->package-inputs names #:optional (output #f)) - "Given a list of PACKAGE-NAMES, and an optional OUTPUT, tries to generate a -quoted list of inputs, as suitable to use in an 'inputs' field of a package -definition." - (map (lambda (input) - (cons* input (list 'unquote (string->symbol input)) - (or (and output (list output)) - '()))) + "Given a list of PACKAGE-NAMES or (PACKAGE-NAME VERSION) pairs, and an +optional OUTPUT, tries to generate a quoted list of inputs, as suitable to +use in an 'inputs' field of a package definition." + (define (make-input input version) + (cons* input (list 'unquote (string->symbol + (if version + (string-append input "-" version) + input))) + (or (and output (list output)) + '()))) + + (map (match-lambda + ((input version) (make-input input version)) + (input (make-input input #f))) names)) (define* (maybe-inputs package-names #:optional (output #f)) diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm index d834518c18..552628cfc7 100644 --- a/guix/scripts/import/crate.scm +++ b/guix/scripts/import/crate.scm @@ -2,7 +2,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 David Thompson ;;; Copyright © 2016 David Craven -;;; Copyright © 2019 Martin Becze +;;; Copyright © 2019, 2020 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -95,13 +95,8 @@ 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)) - (crate-recursive-import name version)) - (let ((sexp (crate->guix-package name version))) + (crate-recursive-import name #:version version) + (let ((sexp (crate->guix-package name #:version version))) (unless sexp (leave (G_ "failed to download meta-data for package '~a'~%") (if version diff --git a/tests/crate.scm b/tests/crate.scm index aa51faebf9..39561d5745 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014 David Thompson ;;; Copyright © 2016 David Craven ;;; Copyright © 2019, 2020 Ludovic Courtès +;;; Copyright © 2020 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -54,8 +55,9 @@ "{ \"dependencies\": [ { - \"crate_id\": \"bar\", + \"crate_id\": \"leaf-alice\", \"kind\": \"normal\", + \"req\": \"1.0.0\", } ] }") @@ -88,18 +90,22 @@ { \"crate_id\": \"intermediate-1\", \"kind\": \"normal\", + \"req\": \"1.0.0\", }, { \"crate_id\": \"intermediate-2\", \"kind\": \"normal\", + \"req\": \"1.0.0\", } { \"crate_id\": \"leaf-alice\", \"kind\": \"normal\", + \"req\": \"1.0.0\", }, { \"crate_id\": \"leaf-bob\", \"kind\": \"normal\", + \"req\": \"1.0.0\", }, ] }") @@ -132,14 +138,17 @@ { \"crate_id\": \"intermediate-2\", \"kind\": \"normal\", + \"req\": \"1.0.0\", }, { \"crate_id\": \"leaf-alice\", \"kind\": \"normal\", + \"req\": \"1.0.0\", }, { \"crate_id\": \"leaf-bob\", \"kind\": \"normal\", + \"req\": \"1.0.0\", } ] }") @@ -172,6 +181,7 @@ { \"crate_id\": \"leaf-bob\", \"kind\": \"normal\", + \"req\": \"1.0.0\", }, ] }") @@ -252,34 +262,48 @@ (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")))) + (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/leaf-alice" + (open-input-string test-leaf-alice-crate)) + ("https://crates.io/api/v1/crates/leaf-alice/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/leaf-alice/1.0.0/dependencies" + (open-input-string test-leaf-alice-dependencies)) (_ (error "Unexpected URL: " url))))) - (match (crate->guix-package "foo") - (('package - ('name "rust-foo") - ('version "1.0.0") - ('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))) - (string=? test-source-hash hash)) - (x - (pk 'fail x #f))))) + + (match (crate->guix-package "foo") + ((define-public rust-foo-1.0.0 + (package (name "rust-foo") + (version "1.0.0") + (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 + (#:skip-build? #t + #:cargo-inputs + (("rust-leaf-alice-1.0.0" ('unquote rust-leaf-alice-1.0.0)))))) + (home-page "http://example.com") + (synopsis "summary") + (description "summary") + (license (list license:expat license:asl2.0)))) + + (string=? test-source-hash hash)) + (x + (pk 'fail x #f))))) (test-assert "cargo-recursive-import" ;; Replace network resources with sample data. @@ -334,105 +358,123 @@ (_ (error "Unexpected URL: " url))))) (match (crate-recursive-import "root") ;; rust-intermediate-2 has no dependency on the rust-leaf-alice package, so this is a valid ordering - ((('package - ('name "rust-leaf-alice") - ('version (? string? ver)) - ('source - ('origin - ('method 'url-fetch) - ('uri ('crate-uri "leaf-alice" '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))) - ('package - ('name "rust-leaf-bob") - ('version (? string? ver)) - ('source - ('origin - ('method 'url-fetch) - ('uri ('crate-uri "leaf-bob" '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))) - ('package - ('name "rust-intermediate-2") - ('version (? string? ver)) - ('source - ('origin - ('method 'url-fetch) - ('uri ('crate-uri "intermediate-2" 'version)) - ('file-name - ('string-append 'name "-" 'version ".tar.gz")) - ('sha256 - ('base32 - (? string? hash))))) - ('build-system 'cargo-build-system) - ('arguments - ('quasiquote - ('#:cargo-inputs (("rust-leaf-bob" ('unquote rust-leaf-bob)))))) - ('home-page "http://example.com") - ('synopsis "summary") - ('description "summary") - ('license ('list 'license:expat 'license:asl2.0))) - ('package - ('name "rust-intermediate-1") - ('version (? string? ver)) - ('source - ('origin - ('method 'url-fetch) - ('uri ('crate-uri "intermediate-1" 'version)) - ('file-name - ('string-append 'name "-" 'version ".tar.gz")) - ('sha256 - ('base32 - (? string? hash))))) - ('build-system 'cargo-build-system) - ('arguments - ('quasiquote - ('#:cargo-inputs (("rust-intermediate-2" ('unquote rust-intermediate-2)) - ("rust-leaf-alice" ('unquote rust-leaf-alice)) - ("rust-leaf-bob" ('unquote rust-leaf-bob)))))) - ('home-page "http://example.com") - ('synopsis "summary") - ('description "summary") - ('license ('list 'license:expat 'license:asl2.0))) - ('package - ('name "rust-root") - ('version (? string? ver)) - ('source - ('origin - ('method 'url-fetch) - ('uri ('crate-uri "root" 'version)) - ('file-name - ('string-append 'name "-" 'version ".tar.gz")) - ('sha256 - ('base32 - (? string? hash))))) - ('build-system 'cargo-build-system) - ('arguments - ('quasiquote - ('#:cargo-inputs (("rust-intermediate-1" ('unquote rust-intermediate-1)) - ("rust-intermediate-2" ('unquote rust-intermediate-2)) - ("rust-leaf-alice" ('unquote rust-leaf-alice)) - ("rust-leaf-bob" ('unquote rust-leaf-bob)))))) - ('home-page "http://example.com") - ('synopsis "summary") - ('description "summary") - ('license ('list 'license:expat 'license:asl2.0)))) + (((define-public rust-leaf-alice-1.0.0 + (package + (name "rust-leaf-alice") + (version (? string? ver)) + (source + (origin + (method url-fetch) + (uri (crate-uri "leaf-alice" version)) + (file-name + (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + (? string? hash))))) + (build-system cargo-build-system) + (arguments ('quasiquote (#:skip-build? #t))) + (home-page "http://example.com") + (synopsis "summary") + (description "summary") + (license (list license:expat license:asl2.0)))) + (define-public rust-leaf-bob-1.0.0 + (package + (name "rust-leaf-bob") + (version (? string? ver)) + (source + (origin + (method url-fetch) + (uri (crate-uri "leaf-bob" version)) + (file-name + (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + (? string? hash))))) + (build-system cargo-build-system) + (arguments ('quasiquote (#:skip-build? #t))) + (home-page "http://example.com") + (synopsis "summary") + (description "summary") + (license (list license:expat license:asl2.0)))) + (define-public rust-intermediate-2-1.0.0 + (package + (name "rust-intermediate-2") + (version (? string? ver)) + (source + (origin + (method url-fetch) + (uri (crate-uri "intermediate-2" version)) + (file-name + (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + (? string? hash))))) + (build-system cargo-build-system) + (arguments + ('quasiquote (#:skip-build? #t + #:cargo-inputs + (("rust-leaf-bob-1.0.0" + ('unquote rust-leaf-bob-1.0.0)))))) + (home-page "http://example.com") + (synopsis "summary") + (description "summary") + (license (list license:expat license:asl2.0)))) + (define-public rust-intermediate-1-1.0.0 + (package + (name "rust-intermediate-1") + (version (? string? ver)) + (source + (origin + (method url-fetch) + (uri (crate-uri "intermediate-1" version)) + (file-name + (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + (? string? hash))))) + (build-system cargo-build-system) + (arguments + ('quasiquote (#:skip-build? #t + #:cargo-inputs + (("rust-intermediate-2-1.0.0" + ,rust-intermediate-2-1.0.0) + ("rust-leaf-alice-1.0.0" + ('unquote rust-leaf-alice-1.0.0)) + ("rust-leaf-bob-1.0.0" + ('unquote rust-leaf-bob-1.0.0)))))) + (home-page "http://example.com") + (synopsis "summary") + (description "summary") + (license (list license:expat license:asl2.0)))) + (define-public rust-root-1.0.0 + (package + (name "rust-root") + (version (? string? ver)) + (source + (origin + (method url-fetch) + (uri (crate-uri "root" version)) + (file-name + (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + (? string? hash))))) + (build-system cargo-build-system) + (arguments + ('quasiquote (#:skip-build? + #t #:cargo-inputs + (("rust-intermediate-1-1.0.0" + ('unquote rust-intermediate-1-1.0.0)) + ("rust-intermediate-2-1.0.0" + ('unquote rust-intermediate-2-1.0.0)) + ("rust-leaf-alice-1.0.0" + ('unquote rust-leaf-alice-1.0.0)) + ("rust-leaf-bob-1.0.0" + ('unquote rust-leaf-bob-1.0.0)))))) + (home-page "http://example.com") + (synopsis "summary") + (description "summary") + (license (list license:expat license:asl2.0))))) #t) (x (pk 'fail x #f))))) -- 2.25.1 --------------0AC17FC6EDF18AC5FE1AEF52 Content-Type: text/x-patch; charset=UTF-8; name="v12-0001-import-utils-recursive-import-accepts-an-optiona.patch" Content-Transfer-Encoding: 8bit Content-Disposition: attachment; filename*0="v12-0001-import-utils-recursive-import-accepts-an-optiona.pa"; filename*1="tch" >From 356bf29011097367a6e95dd45e71050db8bfa8e4 Mon Sep 17 00:00:00 2001 From: Martin Becze Date: Tue, 4 Feb 2020 07:18:18 -0500 Subject: [PATCH v12 1/8] import: utils: 'recursive-import' accepts an optional version parameter. This adds a key VERSION to 'recursive-import' and move the paramter REPO to a key. This also changes all the things that rely on 'recursive-import' * guix/import/utils.scm (recursive-import): Add the VERSION key. Make REPO a key. (package->definition): Added optional 'append-version?'. * guix/import/cran.scm (cran->guix-package): Change the REPO parameter to a key. (cran-recursive-import): Likewise. * guix/import/elpa.scm (elpa->guix-pakcage): Likewise. (elpa-recursive-import): Likewise. * guix/import/gem.scm (gem->guix-package): Likewise. (recursive-import): Likewise. * guix/import/opam.scm (opam-recurive-import): Likewise. * guix/import/pypi.scm (pypi-recursive-import): Likewise. * guix/import/stackage.scm (stackage-recursive-import): Likewise. * guix/scripts/import/cran.scm: (guix-import-cran) Likewise. * guix/scripts/import/elpa.scm: (guix-import-elpa) Likewise. * tests/elpa.scm: (eval-test-with-elpa) Likewise. * tests/import-utils.scm Likewise. --- guix/import/cran.scm | 8 +++-- guix/import/elpa.scm | 6 ++-- guix/import/gem.scm | 6 ++-- guix/import/opam.scm | 5 +-- guix/import/pypi.scm | 5 +-- guix/import/stackage.scm | 5 +-- guix/import/utils.scm | 59 ++++++++++++++++++++++-------------- guix/scripts/import/cran.scm | 5 +-- guix/scripts/import/elpa.scm | 4 ++- tests/elpa.scm | 3 +- tests/import-utils.scm | 8 +++-- 11 files changed, 72 insertions(+), 42 deletions(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index bb8226f714..2cef1f4d4a 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus ;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès ;;; Copyright © 2017 Mathieu Othacehe +;;; Copyright © 2020 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -511,7 +512,7 @@ from the alist META, which was derived from the R package's DESCRIPTION file." (define cran->guix-package (memoize - (lambda* (package-name #:optional (repo 'cran)) + (lambda* (package-name #:key (repo 'cran) #:allow-other-keys) "Fetch the metadata for PACKAGE-NAME from REPO and return the `package' s-expression corresponding to that package, or #f on failure." (let ((description (fetch-description repo package-name))) @@ -526,8 +527,9 @@ s-expression corresponding to that package, or #f on failure." (cran->guix-package package-name 'cran)) (else (values #f '())))))))) -(define* (cran-recursive-import package-name #:optional (repo 'cran)) - (recursive-import package-name repo +(define* (cran-recursive-import package-name #:key (repo 'cran)) + (recursive-import package-name + #:repo repo #:repo->guix-package cran->guix-package #:guix-name cran-guix-name)) diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm index 2d4487dba0..9140bcdc34 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015 Federico Beffa ;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès ;;; Copyright © 2018 Oleg Pykhalov +;;; Copyright © 2020 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -245,7 +246,7 @@ type ''." (license ,license)) dependencies-names))) -(define* (elpa->guix-package name #:optional (repo 'gnu)) +(define* (elpa->guix-package name #:key (repo 'gnu) #:allow-other-keys) "Fetch the package NAME from REPO and produce a Guix package S-expression." (match (fetch-elpa-package name repo) (#f #f) @@ -301,7 +302,8 @@ type ''." (define elpa-guix-name (cut guix-name "emacs-" <>)) (define* (elpa-recursive-import package-name #:optional (repo 'gnu)) - (recursive-import package-name repo + (recursive-import package-name + #:repo repo #:repo->guix-package elpa->guix-package #:guix-name elpa-guix-name)) diff --git a/guix/import/gem.scm b/guix/import/gem.scm index bd5d5b3569..345d6f003c 100644 --- a/guix/import/gem.scm +++ b/guix/import/gem.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2016 Ben Woodcroft ;;; Copyright © 2018 Oleg Pykhalov ;;; Copyright © 2020 Ludovic Courtès +;;; Copyright © 2020 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -122,7 +123,7 @@ VERSION, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES, and LICENSES." ((license) (license->symbol license)) (_ `(list ,@(map license->symbol licenses))))))) -(define* (gem->guix-package package-name #:optional (repo 'rubygems) version) +(define* (gem->guix-package package-name #:key (repo 'rubygems) version) "Fetch the metadata for PACKAGE-NAME from rubygems.org, and return the `package' s-expression corresponding to that package, or #f on failure." (let ((gem (rubygems-fetch package-name))) @@ -200,6 +201,7 @@ package on RubyGems." (latest latest-release))) (define* (gem-recursive-import package-name #:optional version) - (recursive-import package-name '() + (recursive-import package-name + #:repo '() #:repo->guix-package gem->guix-package #:guix-name ruby-package-name)) diff --git a/guix/import/opam.scm b/guix/import/opam.scm index ae7df8a8b5..5e09220386 100644 --- a/guix/import/opam.scm +++ b/guix/import/opam.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Julien Lepiller +;;; Copyright © 2020 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -311,8 +312,8 @@ or #f on failure." dependencies)))))))) (define (opam-recursive-import package-name) - (recursive-import package-name #f - #:repo->guix-package (lambda (name repo) + (recursive-import package-name + #:repo->guix-package (lambda (name . _) (opam->guix-package name)) #:guix-name ocaml-name->guix-name)) diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index f93fa8831f..46012cb135 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -7,6 +7,7 @@ ;;; Copyright © 2019 Maxim Cournoyer ;;; Copyright © 2020 Jakub Kądziołka ;;; Copyright © 2020 Lars-Dominik Braun +;;; Copyright © 2020 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -492,8 +493,8 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." (project-info-license info))))))))) (define (pypi-recursive-import package-name) - (recursive-import package-name #f - #:repo->guix-package (lambda (name repo) + (recursive-import package-name + #:repo->guix-package (lambda (name . _) (pypi->guix-package name)) #:guix-name python->package-name)) diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm index 14150201b5..6091cf2c64 100644 --- a/guix/import/stackage.scm +++ b/guix/import/stackage.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Federico Beffa ;;; Copyright © 2018 Ricardo Wurmus +;;; Copyright © 2020 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -108,8 +109,8 @@ included in the Stackage LTS release." (leave-with-message "~a: Stackage package not found" package-name)))))) (define (stackage-recursive-import package-name . args) - (recursive-import package-name #f - #:repo->guix-package (lambda (name repo) + (recursive-import package-name + #:repo->guix-package (lambda (name . _) (apply stackage->guix-package (cons name args))) #:guix-name hackage-name->package-name)) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 94c8cb040b..cd92cf7dd8 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017, 2019 Ricardo Wurmus ;;; Copyright © 2018 Oleg Pykhalov ;;; Copyright © 2019 Robert Vollmert +;;; Copyright © 2020 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -44,6 +45,7 @@ #:use-module (srfi srfi-9) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-71) #:export (factorize-uri flatten @@ -250,13 +252,15 @@ package definition." ((package-inputs ...) `((native-inputs (,'quasiquote ,package-inputs)))))) -(define (package->definition guix-package) +(define* (package->definition guix-package #:optional append-version?) (match guix-package - (('package ('name (? string? name)) _ ...) - `(define-public ,(string->symbol name) - ,guix-package)) - (('let anything ('package ('name (? string? name)) _ ...)) - `(define-public ,(string->symbol name) + ((or + ('package ('name name) ('version version) . rest) + ('let _ ('package ('name name) ('version version) . rest))) + + `(define-public ,(string->symbol (if append-version? + (string-append name "-" version) + version)) ,guix-package)))) (define (build-system-modules) @@ -391,32 +395,43 @@ obtain a node's uniquely identifying \"key\"." (cons head result) (set-insert (node-name head) visited)))))))) -(define* (recursive-import package-name repo - #:key repo->guix-package guix-name +(define* (recursive-import package-name + #:key repo->guix-package guix-name version repo #:allow-other-keys) "Return a list of package expressions for PACKAGE-NAME and all its dependencies, sorted in topological order. For each package, -call (REPO->GUIX-PACKAGE NAME REPO), which should return a package expression -and a list of dependencies; call (GUIX-NAME NAME) to obtain the Guix package -name corresponding to the upstream name." +call (REPO->GUIX-PACKAGE NAME :KEYS version repo), which should return a +package expression and a list of dependencies; call (GUIX-NAME NAME) to +obtain the Guix package name corresponding to the upstream name." (define-record-type - (make-node name package dependencies) + (make-node name version package dependencies) node? (name node-name) + (version node-version) (package node-package) (dependencies node-dependencies)) - (define (exists? name) - (not (null? (find-packages-by-name (guix-name name))))) + (define (exists? name version) + (not (null? (find-packages-by-name (guix-name name) version)))) - (define (lookup-node name) - (receive (package dependencies) (repo->guix-package name repo) - (make-node name package dependencies))) + (define (lookup-node name version) + (let* ((package dependencies (repo->guix-package name + #:version version + #:repo repo)) + (normilizied-deps (map (match-lambda + ((name version) (list name version)) + (name (list name #f))) dependencies))) + (make-node name version package normilizied-deps))) (map node-package - (topological-sort (list (lookup-node package-name)) + (topological-sort (list (lookup-node package-name version)) + (lambda (node) + (map (lambda (name-version) + (apply lookup-node name-version)) + (remove (lambda (name-version) + (apply exists? name-version)) + (node-dependencies node)))) (lambda (node) - (map lookup-node - (remove exists? - (node-dependencies node)))) - node-name))) + (string-append + (node-name node) + (or (node-version node) "")))))) diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm index d6f371ef3a..bc266ad9da 100644 --- a/guix/scripts/import/cran.scm +++ b/guix/scripts/import/cran.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2015, 2017, 2019 Ricardo Wurmus +;;; Copyright © 2020 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -98,10 +99,10 @@ Import and convert the CRAN package for PACKAGE-NAME.\n")) ;; Recursive import (map package->definition (cran-recursive-import package-name - (or (assoc-ref opts 'repo) 'cran))) + #:repo (or (assoc-ref opts 'repo) 'cran))) ;; Single import (let ((sexp (cran->guix-package package-name - (or (assoc-ref opts 'repo) 'cran)))) + #:repo (or (assoc-ref opts 'repo) 'cran)))) (unless sexp (leave (G_ "failed to download description for package '~a'~%") package-name)) diff --git a/guix/scripts/import/elpa.scm b/guix/scripts/import/elpa.scm index d270d2b4bc..07ac07a3d5 100644 --- a/guix/scripts/import/elpa.scm +++ b/guix/scripts/import/elpa.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Federico Beffa ;;; Copyright © 2018 Oleg Pykhalov +;;; Copyright © 2020 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -102,7 +103,8 @@ Import the latest package named PACKAGE-NAME from an ELPA repository.\n")) (_ #f)) (elpa-recursive-import package-name (or (assoc-ref opts 'repo) 'gnu))) - (let ((sexp (elpa->guix-package package-name (assoc-ref opts 'repo)))) + (let ((sexp (elpa->guix-package package-name + #:repo (assoc-ref opts 'repo)))) (unless sexp (leave (G_ "failed to download package '~a'~%") package-name)) sexp))) diff --git a/tests/elpa.scm b/tests/elpa.scm index b70539bda6..a008cf993c 100644 --- a/tests/elpa.scm +++ b/tests/elpa.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Federico Beffa ;;; Copyright © 2020 Ludovic Courtès +;;; Copyright © 2020 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -51,7 +52,7 @@ (200 "This is the description.") (200 "fake tarball contents")) (parameterize ((current-http-proxy (%local-url))) - (match (elpa->guix-package pkg 'gnu/http) + (match (elpa->guix-package pkg #:repo 'gnu/http) (('package ('name "emacs-auctex") ('version "11.88.6") diff --git a/tests/import-utils.scm b/tests/import-utils.scm index 87dda3238f..2357ea5c40 100644 --- a/tests/import-utils.scm +++ b/tests/import-utils.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2017 Ricardo Wurmus ;;; Copyright © 2016 Ben Woodcroft +;;; Copyright © 2020 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -48,15 +49,16 @@ (package (name "foo") (inputs `(("bar" ,bar))))) - (recursive-import "foo" 'repo + (recursive-import "foo" + #:repo 'repo #:repo->guix-package (match-lambda* - (("foo" 'repo) + (("foo" #:version #f #:repo 'repo) (values '(package (name "foo") (inputs `(("bar" ,bar)))) '("bar"))) - (("bar" 'repo) + (("bar" #:version #f #:repo 'repo) (values '(package (name "bar")) '()))) -- 2.25.1 --------------0AC17FC6EDF18AC5FE1AEF52--