* [bug#44560] [PATCH v16 0/6] New take on: Semantic version aware recursive importer for crates
@ 2020-11-10 21:39 Hartmut Goebel
2020-11-10 21:39 ` [bug#38408] [PATCH v16 1/6] import: utils: 'recursive-import' accepts an optional version parameter Hartmut Goebel
` (6 more replies)
0 siblings, 7 replies; 107+ messages in thread
From: Hartmut Goebel @ 2020-11-10 21:39 UTC (permalink / raw)
To: 44560, 38408
This is a new attempt to get this stale patch done.
Summary:
* All remarks by Ludo have been handled so far. IMHO we are almost done with
this series.
* Major design decision open: Shall package variable names have sem semver
version appended instead of major+minor?
* Still some minor issues, which I'll comment on in the next messages.
This series basically is the series Martin posted in
https://lists.gnu.org/archive/html/guix-patches/2020-04/msg01442.html with two
patches (the first and sixth) replaced by
https://lists.gnu.org/archive/html/guix-patches/2020-05/msg00408.html and
https://lists.gnu.org/archive/html/guix-patches/2020-08/msg00432.html
I applied these on fdb77b362 (2020-08-09) and rebased it to master.
I reviewed the commit messages, and in the code adjusted some formatting and
fixed some typos. I also moved patch 6 to become the 2nd one, since
guile-semver is required in the (now) 3rd patch.
Martin Becze (6):
import: utils: 'recursive-import' accepts an optional version
parameter.
guix: self: Add guile-semver as a depenedency.
import: crate: Use guile-semver to resolve module versions.
import: crate: Memorize crate->guix-package.
import: utils: Trim patch version from names.
import: crate: Parameterized importing of dev dependencies.
guix/import/cran.scm | 8 +-
guix/import/crate.scm | 112 ++++++++----
guix/import/elpa.scm | 6 +-
guix/import/gem.scm | 6 +-
guix/import/opam.scm | 8 +-
guix/import/pypi.scm | 8 +-
guix/import/stackage.scm | 5 +-
guix/import/utils.scm | 79 +++++---
guix/scripts/import/cran.scm | 5 +-
guix/scripts/import/crate.scm | 13 +-
guix/scripts/import/elpa.scm | 4 +-
guix/self.scm | 8 +-
tests/crate.scm | 329 +++++++++++++++++++---------------
tests/elpa.scm | 3 +-
tests/import-utils.scm | 8 +-
15 files changed, 362 insertions(+), 240 deletions(-)
--
2.21.3
^ permalink raw reply [flat|nested] 107+ messages in thread* [bug#38408] [PATCH v16 1/6] import: utils: 'recursive-import' accepts an optional version parameter. 2020-11-10 21:39 [bug#44560] [PATCH v16 0/6] New take on: Semantic version aware recursive importer for crates Hartmut Goebel @ 2020-11-10 21:39 ` Hartmut Goebel 2020-11-10 21:39 ` [bug#38408] [PATCH v16 2/6] guix: self: Add guile-semver as a depenedency Hartmut Goebel ` (5 subsequent siblings) 6 siblings, 0 replies; 107+ messages in thread From: Hartmut Goebel @ 2020-11-10 21:39 UTC (permalink / raw) To: 38408; +Cc: Martin Becze From: Martin Becze <mjbecze@riseup.net> This adds a key VERSION to 'recursive-import' and moves the parameter REPO to a key. This also changes all the places that rely on 'recursive-import'. * guix/import/utils.scm (recursive-import): Add the VERSION key. Make REPO a key. (package->definition): Add optional 'append-version?'. * guix/import/cran.scm (cran->guix-package, cran-recursive-import): Change the REPO parameter to a key. * guix/import/elpa.scm (elpa->guix-package, elpa-recursive-import): Likewise. * guix/import/gem.scm (gem->guix-package, 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 (recursive-import): Likewise. --- guix/import/cran.scm | 8 +++-- guix/import/elpa.scm | 6 ++-- guix/import/gem.scm | 6 ++-- guix/import/opam.scm | 8 ++--- guix/import/pypi.scm | 8 ++--- guix/import/stackage.scm | 5 ++-- guix/import/utils.scm | 57 +++++++++++++++++++++++------------- guix/scripts/import/cran.scm | 5 ++-- guix/scripts/import/elpa.scm | 4 ++- tests/elpa.scm | 3 +- tests/import-utils.scm | 8 +++-- 11 files changed, 73 insertions(+), 45 deletions(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index a1275b4822..d8240a6b2f 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -568,7 +569,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) version) "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))) @@ -586,8 +587,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 871b918f88..c4e8e84aba 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -245,7 +246,7 @@ type '<elpa-package>'." (license ,license)) dependencies-names))) -(define* (elpa->guix-package name #:optional (repo 'gnu)) +(define* (elpa->guix-package name #:key (repo 'gnu) version) "Fetch the package NAME from REPO and produce a Guix package S-expression." (match (fetch-elpa-package name repo) (#f #f) @@ -299,7 +300,8 @@ type '<elpa-package>'." (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 3fe240f36a..1f6f94532e 100644 --- a/guix/import/gem.scm +++ b/guix/import/gem.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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))) @@ -188,6 +189,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 6d9eb0a092..867812124d 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 <julien@lepiller.eu> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -260,7 +261,7 @@ path to the repository." (substring version 1) version))))) -(define* (opam->guix-package name #:key (repository (get-opam-repository))) +(define* (opam->guix-package name #:key (repository (get-opam-repository)) version) "Import OPAM package NAME from REPOSITORY (a directory name) or, if REPOSITORY is #f, from the official OPAM repository. Return a 'package' sexp or #f on failure." @@ -322,9 +323,8 @@ or #f on failure." dependencies)))))))) (define (opam-recursive-import package-name) - (recursive-import package-name #f - #:repo->guix-package (lambda (name repo) - (opam->guix-package name)) + (recursive-import package-name + #:repo->guix-package opam->guix-package #:guix-name ocaml-name->guix-name)) (define (guix-name->opam-name name) diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index 15116e349d..bf4dc50138 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -8,6 +8,7 @@ ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> ;;; Copyright © 2020 Lars-Dominik Braun <ldb@leibniz-psychology.org> ;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -471,7 +472,7 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." (define pypi->guix-package (memoize - (lambda* (package-name) + (lambda* (package-name #:key repo version) "Fetch the metadata for PACKAGE-NAME from pypi.org, and return the `package' s-expression corresponding to that package, or #f on failure." (let* ((project (pypi-fetch package-name)) @@ -495,9 +496,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) - (pypi->guix-package name)) + (recursive-import package-name + #:repo->guix-package pypi->guix-package #:guix-name python->package-name)) (define (string->license str) diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm index 93cf214127..0a60adffc8 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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -107,8 +108,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 #:key repo version) (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 145515c489..895fbb11a8 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -6,6 +6,7 @@ ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> ;;; Copyright © 2020 Helio Machado <0x2b3bfa0+guix@googlemail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -45,6 +46,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 @@ -254,13 +256,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) @@ -409,32 +413,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 <node> - (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)) + (normalizied-deps (map (match-lambda + ((name version) (list name version)) + (name (list name #f))) dependencies))) + (make-node name version package normalizied-deps))) (map node-package - (topological-sort (list (lookup-node package-name)) + (topological-sort (list (lookup-node package-name version)) (lambda (node) - (map lookup-node - (remove exists? + (map (lambda (name-version) + (apply lookup-node name-version)) + (remove (lambda (name-version) + (apply exists? name-version)) (node-dependencies node)))) - node-name))) + (lambda (node) + (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 <bavier@member.fsf.org> ;;; Copyright © 2015, 2017, 2019 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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.21.3 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v16 2/6] guix: self: Add guile-semver as a depenedency. 2020-11-10 21:39 [bug#44560] [PATCH v16 0/6] New take on: Semantic version aware recursive importer for crates Hartmut Goebel 2020-11-10 21:39 ` [bug#38408] [PATCH v16 1/6] import: utils: 'recursive-import' accepts an optional version parameter Hartmut Goebel @ 2020-11-10 21:39 ` Hartmut Goebel 2020-11-10 21:39 ` [bug#38408] [PATCH v16 3/6] import: crate: Use guile-semver to resolve module versions Hartmut Goebel ` (4 subsequent siblings) 6 siblings, 0 replies; 107+ messages in thread From: Hartmut Goebel @ 2020-11-10 21:39 UTC (permalink / raw) To: 38408; +Cc: Martin Becze From: Martin Becze <mjbecze@riseup.net> * guix/self.scm (compiled-guix): Add guile-semver as a depenedency. --- guix/self.scm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/guix/self.scm b/guix/self.scm index bbfd2f1b95..1a3f748bea 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 <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -53,6 +54,7 @@ ("guile-json" (ref '(gnu packages guile) 'guile-json-4)) ("guile-ssh" (ref '(gnu packages ssh) 'guile-ssh)) ("guile-git" (ref '(gnu packages guile) 'guile-git)) + ("guile-semver" (ref '(gnu packages guile-xyz) 'guile3.0-semver)) ("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3)) ("guile-zlib" (ref '(gnu packages guile) 'guile-zlib)) ("guile-lzlib" (ref '(gnu packages guile) 'guile-lzlib)) @@ -799,6 +801,9 @@ Info manual." (define guile-gcrypt (specification->package "guile-gcrypt")) + (define guile-semver + (specification->package "guile-semver")) + (define gnutls (specification->package "gnutls")) @@ -807,7 +812,8 @@ Info manual." (cons (list "x" package) (package-transitive-propagated-inputs package))) (list guile-gcrypt gnutls guile-git guile-json - guile-ssh guile-sqlite3 guile-zlib guile-lzlib)) + guile-ssh guile-sqlite3 guile-zlib guile-lzlib + guile-semver)) (((labels packages _ ...) ...) packages))) -- 2.21.3 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v16 3/6] import: crate: Use guile-semver to resolve module versions. 2020-11-10 21:39 [bug#44560] [PATCH v16 0/6] New take on: Semantic version aware recursive importer for crates Hartmut Goebel 2020-11-10 21:39 ` [bug#38408] [PATCH v16 1/6] import: utils: 'recursive-import' accepts an optional version parameter Hartmut Goebel 2020-11-10 21:39 ` [bug#38408] [PATCH v16 2/6] guix: self: Add guile-semver as a depenedency Hartmut Goebel @ 2020-11-10 21:39 ` Hartmut Goebel 2020-11-10 22:13 ` Hartmut Goebel 2020-11-10 21:39 ` [bug#38408] [PATCH v16 4/6] import: crate: Memorize crate->guix-package Hartmut Goebel ` (3 subsequent siblings) 6 siblings, 1 reply; 107+ messages in thread From: Hartmut Goebel @ 2020-11-10 21:39 UTC (permalink / raw) To: 38408; +Cc: Martin Becze From: Martin Becze <mjbecze@riseup.net> * guix/import/crate.scm: Add guile-semver as a soft dependency. (make-crate-sexp): Don't allow other keys. Add '#: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. Treat "build" dependencies as normal dependencies. (crate-name->package-name): Reuse the procedure 'guix-name' instead of duplicating its logic. * guix/import/utils.scm (package-names->package-inputs): Implement 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: (recursive-import) Add version data to the test. --- guix/import/crate.scm | 96 ++++++---- guix/import/utils.scm | 21 ++- guix/scripts/import/crate.scm | 11 +- tests/crate.scm | 330 +++++++++++++++++++--------------- 4 files changed, 266 insertions(+), 192 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 8c2b76cab4..0802ecd315 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 <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -37,6 +37,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 @@ -85,10 +86,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 <crate> record or #f if it was not found." @@ -142,16 +148,22 @@ 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 - #:allow-other-keys) + home-page synopsis description license) "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) @@ -163,7 +175,8 @@ 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))) (home-page ,(match home-page @@ -176,7 +189,7 @@ and LICENSE." ((license) license) (_ `(list ,@license))))))) (close-port port) - pkg)) + (package->definition pkg #t))) (define (string->license string) (filter-map (lambda (license) @@ -187,14 +200,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 repo) "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,22 +222,37 @@ latest version of CRATE-NAME." (or version (crate-latest-version crate)))) + ;; finds the a version of a crate that fulfills the semver <range> + (define (find-version crate range) + (find (lambda (version) + (semver-range-contains-string? + range + (crate-version-number version))) + (crate-versions crate))) + (define version* (and crate - (find (lambda (version) - (string=? (crate-version-number version) - version-number)) - (crate-versions crate)))) + (find-version crate version-number))) + + ;; sorts the dependencies and maps the dependencies to a list containing + ;; pairs of (name version) + (define (sort-map-dependencies deps) + (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<? name))))) (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<?))) + (let* ((dependencies (crate-version-dependencies version*)) + (dep-crates dev-dep-crates (partition normal-dependency? dependencies)) + (cargo-inputs (sort-map-dependencies dep-crates)) + (cargo-development-inputs '())) (values (make-crate-sexp #:name crate-name #:version (crate-version-number version*) @@ -231,15 +264,12 @@ latest version of CRATE-NAME." #:description (crate-description crate) #:license (and=> (crate-version-license version*) string->license)) - (append cargo-inputs cargo-development-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))) + cargo-inputs)))) + +(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) @@ -254,7 +284,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)) \f ;;; diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 895fbb11a8..10eb030188 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -229,13 +229,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 <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 61a04f986b..beaa696be0 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,8 +37,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"foo\", \"num\": \"1.0.0\", @@ -54,8 +55,9 @@ "{ \"dependencies\": [ { - \"crate_id\": \"bar\", - \"kind\": \"normal\" + \"crate_id\": \"leaf-alice\", + \"kind\": \"normal\", + \"req\": \"1.0.0\" } ] }") @@ -68,8 +70,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"foo\", \"num\": \"1.0.0\", @@ -87,19 +89,23 @@ \"dependencies\": [ { \"crate_id\": \"intermediate-1\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" }, { \"crate_id\": \"intermediate-2\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" } { \"crate_id\": \"leaf-alice\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" }, { \"crate_id\": \"leaf-bob\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" } ] }") @@ -112,8 +118,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"intermediate-1\", \"num\": \"1.0.0\", @@ -131,15 +137,18 @@ \"dependencies\": [ { \"crate_id\": \"intermediate-2\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" }, { \"crate_id\": \"leaf-alice\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" }, { \"crate_id\": \"leaf-bob\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" } ] }") @@ -152,8 +161,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"intermediate-2\", \"num\": \"1.0.0\", @@ -171,7 +180,8 @@ \"dependencies\": [ { \"crate_id\": \"leaf-bob\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" } ] }") @@ -184,8 +194,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"leaf-alice\", \"num\": \"1.0.0\", @@ -211,7 +221,7 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], + \"keywords\": [\"dummy\", \"test\"], \"categories\": [\"test\"] \"actual_versions\": [ { \"id\": \"leaf-bob\", @@ -253,34 +263,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. @@ -335,105 +359,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.21.3 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v16 3/6] import: crate: Use guile-semver to resolve module versions. 2020-11-10 21:39 ` [bug#38408] [PATCH v16 3/6] import: crate: Use guile-semver to resolve module versions Hartmut Goebel @ 2020-11-10 22:13 ` Hartmut Goebel 2019-11-28 0:13 ` [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates Martin Becze 2020-11-17 21:43 ` [bug#38408] [PATCH v16 3/6] import: crate: Use guile-semver to resolve module versions Martin Becze 0 siblings, 2 replies; 107+ messages in thread From: Hartmut Goebel @ 2020-11-10 22:13 UTC (permalink / raw) To: 38408; +Cc: Martin Becze Am 10.11.20 um 22:39 schrieb Hartmut Goebel: > From: Martin Becze <mjbecze@riseup.net> > > * guix/import/crate.scm: Add guile-semver as a soft dependency. > […] Please add a brief change description for crate-recursive-import. > * guix/import/utils.scm (package-names->package-inputs): Implement > handling of (name version) pairs. > * guix/scripts/import/crate.scm (guix-import-crate): Move > 'package-definition' from here to guix/import/crate.scm. I could not spot this change. has this been reverted in one of the many version of this series? Also this file contains a change not described here. > -(define* (crate->guix-package crate-name #:optional version) > +(define* (crate->guix-package crate-name #:key version repo) > "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." Does this still fetch the latest version? Or is it the latest version matching a semver range, or the latest non-beta version? > @@ -231,15 +264,12 @@ latest version of CRATE-NAME." > #:description (crate-description crate) > #:license (and=> (crate-version-license version*) > string->license)) > - (append cargo-inputs cargo-development-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))) > + cargo-inputs)))) Is this change in the last line intended? Another patch of this series reverts this change. > @@ -131,15 +137,18 @@ > \"dependencies\": [ > { > \"crate_id\": \"intermediate-2\", > - \"kind\": \"normal\" > + \"kind\": \"normal\", > + \"req\": \"1.0.0\" > }, > { > \"crate_id\": \"leaf-alice\", > - \"kind\": \"normal\" > + \"kind\": \"normal\", > + \"req\": \"1.0.0\" > }, > { > \"crate_id\": \"leaf-bob\", > - \"kind\": \"normal\" > + \"kind\": \"normal\", > + \"req\": \"1.0.0\" > } > ] > }") All packages in this test have version 1.0.0 and the requirement is 1.0.0, too. So semver resolution is not actually tested by these packages. I suggest to add more available versions to some of the packages and actually use a different semver operators. To avoid confusion, maybe it makes sense to rename packages to get rid of the trailing number. E.g. "intermediate-1" could become "intermediate-A" Please also make sure, there is a test-case with some 0.x version, since crates.io documentations says [1]: "This compatibility convention is different from SemVer in the way it treats versions before 1.0.0. …" [1] https://doc.rust-lang.org/cargo/reference/specifying-dependencies.html#caret-requirements -- Regards Hartmut Goebel | Hartmut Goebel | h.goebel@crazy-compilers.com | | www.crazy-compilers.com | compilers which you thought are impossible | ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates @ 2019-11-28 0:13 ` Martin Becze 2019-11-28 0:16 ` [bug#38408] [PATCH 1/3] gnu: added new function, find-packages-by-name*/direct Martin Becze ` (10 more replies) 0 siblings, 11 replies; 107+ messages in thread From: Martin Becze @ 2019-11-28 0:13 UTC (permalink / raw) To: 38408; +Cc: efraim, Martin Becze This patch add a new recusive importer (recusive-import-semver) which uses semantic versioning to find the correct version of dependencies. This procedure is then used by the crate importer. Since quite a few langague pms use semantic versioning I hope that other importers can also use it. This patch has one problem that I'm aware of. recusive-import-semver relies on guile-semver. But how do I make it so that it is installed by default? Or altenativly how can I check a guile module exists or not, so that I can promt the user to install it? Thanks, Martin Becze Martin Becze (3): gnu: added new function, find-packages-by-name*/direct gnu: added new procedure, recusive-import-semver Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test. gnu/packages.scm | 41 ++++++++ guix/import/crate.scm | 165 +++++++++++++++++-------------- guix/import/utils.scm | 181 ++++++++++++++++++++++++++++++++-- guix/scripts/import/crate.scm | 9 +- tests/crate.scm | 2 +- tests/import-utils.scm | 162 ++++++++++++++++++++++++++++++ tests/packages.scm | 13 +++ 7 files changed, 481 insertions(+), 92 deletions(-) -- 2.24.0 ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH 1/3] gnu: added new function, find-packages-by-name*/direct 2019-11-28 0:13 ` [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates Martin Becze @ 2019-11-28 0:16 ` Martin Becze 2019-11-28 0:16 ` [bug#38408] [PATCH 2/3] gnu: added new procedure, recusive-import-semver Martin Becze ` (9 subsequent siblings) 10 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2019-11-28 0:16 UTC (permalink / raw) To: 38408; +Cc: efraim, Martin Becze * gnu/packages.scm (find-packages-by-naem*/direct) --- gnu/packages.scm | 41 +++++++++++++++++++++++++++++++++++++++++ tests/packages.scm | 13 +++++++++++++ 2 files changed, 54 insertions(+) diff --git a/gnu/packages.scm b/gnu/packages.scm index 959777ff8f..cca2a393e5 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -52,7 +53,9 @@ %default-package-module-path fold-packages + fold-packages* fold-available-packages + find-packages-by-name*/direct find-newest-available-packages find-packages-by-name @@ -250,6 +253,23 @@ is guaranteed to never traverse the same package twice." init modules)) +(define* (fold-packages* proc init + #:optional + (modules (all-modules (%package-module-path) + #:warn + warn-about-load-error)) + #:key (select? (negate hidden-package?))) + "Call (PROC PACKAGE RESULT) for each available package defined in one of +MODULES that matches SELECT?, using INIT as the initial value of RESULT. It +is guaranteed to never traverse the same package twice." + (fold-module-public-variables* (lambda (module symbol var result) + (let ((object (variable-ref var))) + (if (and (package? object) (select? object)) + (proc module symbol object result) + result))) + init + modules)) + (define %package-cache-file ;; Location of the package cache. "/lib/guix/package.cache") @@ -297,6 +317,27 @@ decreasing version order." matching) matching))))) +(define find-packages-by-name*/direct ;bypass the cache + (let ((packages (delay + (fold-packages* (lambda (mod sym p r) + (vhash-cons (package-name p) (list mod sym p) r)) + vlist-null))) + (version>? (match-lambda* + (((_ _ versions) ..1) + (apply version>? (map package-version versions)))))) + (lambda* (name #:optional version) + "Return the list of (<module> <symbol> <package>) with the given NAME. If + VERSION is not #f, then only return packages whose version is prefixed by + VERSION, sorted in decreasing version order." + (let ((matching (sort (vhash-fold* cons '() name (force packages)) + version>?))) + (if version + (filter (match-lambda + ((_ _ package) + (version-prefix? version (package-version package)))) + matching) + matching))))) + (define (cache-lookup cache name) "Lookup package NAME in CACHE. Return a list sorted in increasing version order." diff --git a/tests/packages.scm b/tests/packages.scm index 423c5061aa..9f02b0d5d2 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke@gnu.org> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -1135,11 +1136,23 @@ (((? (cut eq? hello <>))) #t) (wrong (pk 'find-packages-by-name wrong #f)))) +(test-assert "find-packages-by-name*/direct" + (match (find-packages-by-name*/direct "hello") + ((((? (cut eq? (resolve-interface '(gnu packages base)) <>)) + (? (cut eq? 'hello <>)) + (? (cut eq? hello <>)))) #t))) + (test-assert "find-packages-by-name with version" (match (find-packages-by-name "hello" (package-version hello)) (((? (cut eq? hello <>))) #t) (wrong (pk 'find-packages-by-name wrong #f)))) +(test-assert "find-packages-by-name*/direct with version" + (match (find-packages-by-name*/direct "hello" (package-version hello)) + ((((? (cut eq? (resolve-interface '(gnu packages base)) <>)) + (? (cut eq? 'hello <>)) + (? (cut eq? hello <>)))) #t))) + (test-equal "find-packages-by-name with cache" (find-packages-by-name "guile") (call-with-temporary-directory -- 2.24.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH 2/3] gnu: added new procedure, recusive-import-semver 2019-11-28 0:13 ` [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates Martin Becze 2019-11-28 0:16 ` [bug#38408] [PATCH 1/3] gnu: added new function, find-packages-by-name*/direct Martin Becze @ 2019-11-28 0:16 ` Martin Becze 2019-11-28 0:16 ` [bug#38408] [PATCH 3/3] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test Martin Becze ` (8 subsequent siblings) 10 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2019-11-28 0:16 UTC (permalink / raw) To: 38408; +Cc: efraim, Martin Becze * gnu/packages.scm (recusive-import-semver): New Procedure * gnu/packages.scm (package->definition)[arguments]: New argument, "latest" * tests/import-utils.scm: tests for recusive-import-semver --- guix/import/utils.scm | 181 +++++++++++++++++++++++++++++++++++++++-- tests/import-utils.scm | 162 ++++++++++++++++++++++++++++++++++++ 2 files changed, 336 insertions(+), 7 deletions(-) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 4694b6e7ef..6932614f8e 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -32,6 +33,7 @@ #:use-module (guix discovery) #:use-module (guix build-system) #:use-module (guix gexp) + #:use-module (guix memoization) #:use-module (guix store) #:use-module (guix download) #:use-module (gnu packages) @@ -43,6 +45,8 @@ #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-41) + #:use-module (semver) + #:use-module (semver ranges) #:export (factorize-uri flatten @@ -69,7 +73,8 @@ guix-name - recursive-import)) + recursive-import + recursive-import-semver)) (define (factorize-uri uri version) "Factorize URI, a package tarball URI as a string, such that any occurrences @@ -257,13 +262,15 @@ package definition." ((package-inputs ...) `((native-inputs (,'quasiquote ,package-inputs)))))) -(define (package->definition guix-package) +(define* (package->definition guix-package #:optional (latest #t)) (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 latest + name + (string-append name "-" version))) ,guix-package)))) (define (build-system-modules) @@ -414,3 +421,163 @@ dependencies." step ;; initial state (step initial-state))) + +(define* (recursive-import-semver #:key name + (version #f) + name->metadata + metadata->package + metadata-versions + package-dependencies + dependency-name + dependency-range + guix-name + make-sexp) + "Generates a stream of package expressions for the dependencies of the given +NAME and VERSION. The dependencies will be resolved using semantic versioning. +This procedure makes the assumption that most package repositories will, for a +given package provide some <metadata> on that package that includes what +versions of the package that are available and a list of dependencies for each +version. Dependencies are assumed to be composed of a NAME, a semantic RANGE and +other data. + +This procedure takes the following keys: + NAME - The name of the package to import + VERSION - The version of the package to import + NAME->METADATA - A procedure that takes a NAME of a package and returns that +package's <metadata> + METADATA->PACKAGE A procedure that takes a package's <metadata> and VERSION +and returns the <package> for the given VERSION + METADATA-VERSIONS A procedure that that takes a packages <metadata> and +returns a list of version as strings that are available for the given package + PACKAGE-DEPENDENCIES a procedure that returns a list of <dependency> given a +<package> + DEPENDENCY-NAME A procedure that takes a <dependency> and returns the its name + DEPENDENCY-RANGE A procedure that takes a <dependency> and returns that +decency's range as a string + GUIX-NAME A procedure that take a NAME and returns the Guix version of it + MAKE-SEXP A procedure that takes <metadata>, <package> and a list of pairs +containing (EXPORT-NAME <dependency>), returning the package expression as an +s-expression" + (define mem-name->metadata (memoize name->metadata)) + + (define (latest? versions version) + (equal? (car versions) version)) + + (define (sorted-versions metadata) + (sort (metadata-versions metadata) version>?)) + + (define (name->versions name) + (sorted-versions (mem-name->metadata name))) + + (define (semver-range-contains-string? range version) + (semver-range-contains? range + (string->semver version))) + + (define (guix-export-name name version) + (let ((versions (name->versions name)) + (name (guix-name name))) + (if (latest? versions version) + name + (string-append name "-" version)))) + + ;; checks to see if we already defined or want to define a dep + (define (find-known name range known) + (match + (find + (match-lambda ((dep-name version) + (and + (string=? dep-name name) + (semver-range-contains-string? range version)))) + known) + + (#f #f) + ((name version) (list (guix-export-name name version) version #f))) + ) + + ;; searches searches for a package in guix + (define (find-locally name range) + (match + (find + (match-lambda ((_ _ package) + (semver-range-contains-string? + range + (package-version package)))) + (find-packages-by-name*/direct (guix-name name))) + (#f #f) + ((_ export-symbol package) (list + (symbol->string export-symbol) + (package-version package) #f)))) + + ;; searches for a package in some external repo + (define (find-remote name range) + (let* ((versions (name->versions name)) + (version (find + (lambda (ver) + (semver-range-contains-string? range ver)) + versions)) + (export-name (guix-export-name name version))) + `(,export-name ,version #t))) + + + (define (find-dep-version dep known-deps) + (let* ((name (dependency-name dep)) + (range (string->semver-range (dependency-range dep))) + (export-name-version-needed + (or (find-known name range known-deps) + (find-locally name range) + (find-remote name range)))) + `(,name ,@export-name-version-needed ,dep) + )) + + (define (make-package-definition name version known-deps) + (let* ((metadata (mem-name->metadata name)) + (versions (sorted-versions metadata)) + (package (metadata->package metadata version)) + (deps (map (lambda (dep) + (find-dep-version dep known-deps)) + (package-dependencies package))) + (sexp + (make-sexp metadata package + (map + (match-lambda ((_ export-symbol _ _ dep) + (list export-symbol dep))) + deps)))) + (values + (package->definition sexp (latest? versions version)) + (filter-map + (match-lambda ((name _ version need? dep) + (if need? + (list name version) + #f))) + deps)))) + + (define initial-state + (list #f + (list + ;; packages to find + (list name (if version + version + (car (name->versions name))))) + ;; packages that have been found + (list))) + + (define (step state) + (match state + ((prev ((next-name next-version) . rest) done) + (receive (package dependencies) + (make-package-definition next-name next-version + (append done rest `((,next-name ,next-version)))) + (list + package + (append rest dependencies) + (cons (list next-name next-version) done)))) + ((prev '() done) + (list #f '() done)))) + + (stream-unfold + ;; map: produce a stream element + (match-lambda ((latest queue done) latest)) + ;; predicate + (match-lambda ((latest queue done) latest)) + step + (step initial-state))) diff --git a/tests/import-utils.scm b/tests/import-utils.scm index c3ab25d788..4ed3a5e1da 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 <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2016 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,6 +25,10 @@ #:use-module (guix packages) #:use-module (guix build-system) #:use-module (gnu packages) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-41) #:use-module (srfi srfi-64)) (test-begin "import-utils") @@ -120,4 +125,161 @@ ("license" . #f)))) (package-native-inputs (alist->package meta)))) +(define-record-type <metadata> + (make-metadata name versions) + metadata? + (name metadata-name) + (versions metadata-versions)) + +(define-record-type <package> + (make-package version dependencies) + package? + (version package-version) + (dependencies package-dependencies)) + +(define-record-type <dependency> + (make-dependency name range) + dependency? + (name dependency-name) + (range dependency-range)) + +(define (metadata-semver-versions metadata) + (map (lambda (p) + (package-version p)) + (metadata-versions metadata))) + +(define (metadata->package metadata version) + (find + (lambda (package) + (equal? (package-version package) version)) + (metadata-versions metadata))) + +(define (make-sexp metadata package dependencies) + `(package + (name ,(guix-name (metadata-name metadata))) + (version ,(package-version package)) + (dependcies ,(map + (match-lambda ((public-name dep) + (list (guix-name (dependency-name dep)) public-name))) + dependencies)))) + +(define (guix-name name) + (string-append "test-" name)) + +(define packages + `(("no-deps" . (("1.0.0" . ()) ("0.1.0" . ()))) + ("one-dep" . (("1.0.0" . (("no-deps" "^1.0"))) + ("0.1.0" . (("no-deps" "^0.1.0"))))) + ("shared-dep" . (("1.0.0" . (("one-dep" "^0.1.0") + ("no-deps" "*"))))) + ("recursive" . (("1.0.0" . (("recursive" "=1.0.0"))))) + ("already-packaged" . (("1.0.0" . (("rust" "~1.28"))))))) + +(define (name->metadata name) + (let ((versions (assoc-ref packages name))) + (make-metadata name + (map + (match-lambda + ((version . deps) + (make-package version + (map + (lambda (name-range) + (apply make-dependency name-range)) + deps)))) + versions)))) + +(define* (test-recursive-importer name version #:optional (guix-name guix-name)) + (recursive-import-semver #:name name + #:version version + #:name->metadata name->metadata + #:metadata->package metadata->package + #:metadata-versions metadata-semver-versions + #:package-dependencies package-dependencies + #:dependency-name dependency-name + #:dependency-range dependency-range + #:guix-name guix-name + #:make-sexp make-sexp)) + +(test-equal "recursive import test with no dependencies" + `((define-public test-no-deps + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ())))) + (stream->list (test-recursive-importer "no-deps" "1.0.0"))) + +(test-equal "recursive import test with one dependencies" + `((define-public test-one-dep + (package + (name "test-one-dep") + (version "1.0.0") + (dependcies (("test-no-deps" "test-no-deps"))))) + (define-public test-no-deps + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ())))) + (stream->list (test-recursive-importer "one-dep" "1.0.0"))) + +(test-equal "recursive import test with recursuve dependencies" + `((define-public test-recursive + (package + (name "test-recursive") + (version "1.0.0") + (dependcies (("test-recursive" "test-recursive")))))) + (stream->list (test-recursive-importer "recursive" "1.0.0"))) + +(test-equal "recursive import test with no dependencies using an old version" + `((define-public test-no-deps-0.1.0 + (package + (name "test-no-deps") + (version "0.1.0") + (dependcies ())))) + (stream->list (test-recursive-importer "no-deps" "0.1.0"))) + +(test-equal "recursive import test with one dependencies unsing an old version" + `((define-public test-one-dep-0.1.0 + (package + (name "test-one-dep") + (version "0.1.0") + (dependcies (("test-no-deps" "test-no-deps-0.1.0"))))) + (define-public test-no-deps-0.1.0 + (package + (name "test-no-deps") + (version "0.1.0") + (dependcies ())))) + (stream->list (test-recursive-importer "one-dep" "0.1.0"))) + +(test-equal "recursive import test with with dependency that is already in the repo" + `((define-public test-already-packaged + (package (name "test-already-packaged") + (version "1.0.0") + (dependcies + (("test-rust" "rust-1.28")))))) + (stream->list (test-recursive-importer "already-packaged" "1.0.0" identity))) + +(test-equal "shared dependencies" + `((define-public test-shared-dep + (package + (name "test-shared-dep") + (version "1.0.0") + (dependcies (("test-one-dep" "test-one-dep-0.1.0") + ("test-no-deps" "test-no-deps"))))) + (define-public test-one-dep-0.1.0 + (package + (name "test-one-dep") + (version "0.1.0") + (dependcies (("test-no-deps" "test-no-deps-0.1.0"))))) + (define-public test-no-deps + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ()))) + (define-public test-no-deps-0.1.0 + (package + (name "test-no-deps") + (version "0.1.0") + (dependcies())))) + (stream->list (test-recursive-importer "shared-dep" "1.0.0"))) + (test-end "import-utils") -- 2.24.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH 3/3] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test. 2019-11-28 0:13 ` [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates Martin Becze 2019-11-28 0:16 ` [bug#38408] [PATCH 1/3] gnu: added new function, find-packages-by-name*/direct Martin Becze 2019-11-28 0:16 ` [bug#38408] [PATCH 2/3] gnu: added new procedure, recusive-import-semver Martin Becze @ 2019-11-28 0:16 ` Martin Becze 2019-11-30 16:36 ` Martin Becze 2019-12-05 20:05 ` [bug#38408] [PATCH v2 0/5] Semantic version aware recusive importer for crates Martin Becze ` (7 subsequent siblings) 10 siblings, 1 reply; 107+ messages in thread From: Martin Becze @ 2019-11-28 0:16 UTC (permalink / raw) To: 38408; +Cc: efraim, Martin Becze * 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 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH 3/3] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test. 2019-11-28 0:16 ` [bug#38408] [PATCH 3/3] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test Martin Becze @ 2019-11-30 16:36 ` Martin Becze 2019-12-01 9:00 ` Efraim Flashner 0 siblings, 1 reply; 107+ messages in thread From: Martin Becze @ 2019-11-30 16:36 UTC (permalink / raw) To: 38408; +Cc: efraim [-- Attachment #1: Type: text/plain, Size: 12858 bytes --] 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. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-added-skip-build-t-to-the-output-of-make-crate-sexp-.patch --] [-- Type: text/x-diff; name=0001-added-skip-build-t-to-the-output-of-make-crate-sexp-.patch, Size: 1876 bytes --] From 3f2ff3b4dc4cdf8b0282316b9c2426291da8a6c7 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Sat, 30 Nov 2019 11:27:05 -0500 Subject: [PATCH] added "#:skip-build? #t" to the output of (make-crate-sexp). Most the the packages imported will be libaries and won't need to build. The top level package will build them though. * guix/import/crate.scm (make-crate-sexp): added "#:skip-build? #t" to the output --- guix/import/crate.scm | 3 ++- tests/crate.scm | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) 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-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))) (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") -- 2.24.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH 3/3] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test. 2019-11-30 16:36 ` Martin Becze @ 2019-12-01 9:00 ` Efraim Flashner 0 siblings, 0 replies; 107+ messages in thread From: Efraim Flashner @ 2019-12-01 9:00 UTC (permalink / raw) To: Martin Becze; +Cc: 38408 [-- Attachment #1: Type: text/plain, Size: 16189 bytes --] 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 <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. 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 <mjbecze@riseup.net> > Date: Sat, 30 Nov 2019 11:27:05 -0500 > Subject: [PATCH] added "#:skip-build? #t" to the output of (make-crate-sexp). > Most the the packages imported will be libaries and won't need to build. The > top level package will build them though. > > * guix/import/crate.scm (make-crate-sexp): added "#:skip-build? #t" to the output > --- > guix/import/crate.scm | 3 ++- > tests/crate.scm | 3 ++- > 2 files changed, 4 insertions(+), 2 deletions(-) > > 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-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))) > (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") > -- > 2.24.0 > -- Efraim Flashner <efraim@flashner.co.il> אפרים פלשנר GPG key = A28B F40C 3E55 1372 662D 14F7 41AA E7DC CA3D 8351 Confidentiality cannot be guaranteed on emails sent or received unencrypted [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 833 bytes --] ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v2 0/5] Semantic version aware recusive importer for crates 2019-11-28 0:13 ` [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates Martin Becze ` (2 preceding siblings ...) 2019-11-28 0:16 ` [bug#38408] [PATCH 3/3] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test Martin Becze @ 2019-12-05 20:05 ` Martin Becze 2019-12-05 20:05 ` [bug#38408] [PATCH v2 1/5] gnu: added new function, find-packages-by-name*/direct Martin Becze ` (4 more replies) 2019-12-06 18:21 ` [bug#38408] [PATCH v3 0/5] Semantic version aware recusive importer for crates Martin Becze ` (6 subsequent siblings) 10 siblings, 5 replies; 107+ messages in thread From: Martin Becze @ 2019-12-05 20:05 UTC (permalink / raw) To: 38408; +Cc: Martin Becze This version just builds a bit on the prevouse version (https://issues.guix.gnu.org/issue/38408#0) I found while testing some crates have build-dependencies and nor dependencies that are the same. While in guix build and normal dependiences are treated the same way (ie source only). So the recusive importer was importing the duplicates so here we dedup the deps. Please let me know if there are any problems! -Martin Martin Becze (5): gnu: added new function, find-packages-by-name*/direct gnu: added new procedure, recusive-import-semver Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test. added "#:skip-build? #t" to the output of (make-crate-sexp). Most the the packages imported will be libaries and won't need to build. The top level package will build them though. guix: crate: Depublicated build and normal dependencies gnu/packages.scm | 41 ++++++++ guix/import/crate.scm | 188 +++++++++++++++++++--------------- guix/import/utils.scm | 181 ++++++++++++++++++++++++++++++-- guix/scripts/import/crate.scm | 9 +- tests/crate.scm | 5 +- tests/import-utils.scm | 162 +++++++++++++++++++++++++++++ tests/packages.scm | 13 +++ 7 files changed, 501 insertions(+), 98 deletions(-) -- 2.24.0 ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v2 1/5] gnu: added new function, find-packages-by-name*/direct 2019-12-05 20:05 ` [bug#38408] [PATCH v2 0/5] Semantic version aware recusive importer for crates Martin Becze @ 2019-12-05 20:05 ` Martin Becze 2019-12-05 20:05 ` [bug#38408] [PATCH v2 2/5] gnu: added new procedure, recusive-import-semver Martin Becze ` (3 subsequent siblings) 4 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2019-12-05 20:05 UTC (permalink / raw) To: 38408; +Cc: Martin Becze * gnu/packages.scm (find-packages-by-naem*/direct) --- gnu/packages.scm | 41 +++++++++++++++++++++++++++++++++++++++++ tests/packages.scm | 13 +++++++++++++ 2 files changed, 54 insertions(+) diff --git a/gnu/packages.scm b/gnu/packages.scm index 959777ff8f..cca2a393e5 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -52,7 +53,9 @@ %default-package-module-path fold-packages + fold-packages* fold-available-packages + find-packages-by-name*/direct find-newest-available-packages find-packages-by-name @@ -250,6 +253,23 @@ is guaranteed to never traverse the same package twice." init modules)) +(define* (fold-packages* proc init + #:optional + (modules (all-modules (%package-module-path) + #:warn + warn-about-load-error)) + #:key (select? (negate hidden-package?))) + "Call (PROC PACKAGE RESULT) for each available package defined in one of +MODULES that matches SELECT?, using INIT as the initial value of RESULT. It +is guaranteed to never traverse the same package twice." + (fold-module-public-variables* (lambda (module symbol var result) + (let ((object (variable-ref var))) + (if (and (package? object) (select? object)) + (proc module symbol object result) + result))) + init + modules)) + (define %package-cache-file ;; Location of the package cache. "/lib/guix/package.cache") @@ -297,6 +317,27 @@ decreasing version order." matching) matching))))) +(define find-packages-by-name*/direct ;bypass the cache + (let ((packages (delay + (fold-packages* (lambda (mod sym p r) + (vhash-cons (package-name p) (list mod sym p) r)) + vlist-null))) + (version>? (match-lambda* + (((_ _ versions) ..1) + (apply version>? (map package-version versions)))))) + (lambda* (name #:optional version) + "Return the list of (<module> <symbol> <package>) with the given NAME. If + VERSION is not #f, then only return packages whose version is prefixed by + VERSION, sorted in decreasing version order." + (let ((matching (sort (vhash-fold* cons '() name (force packages)) + version>?))) + (if version + (filter (match-lambda + ((_ _ package) + (version-prefix? version (package-version package)))) + matching) + matching))))) + (define (cache-lookup cache name) "Lookup package NAME in CACHE. Return a list sorted in increasing version order." diff --git a/tests/packages.scm b/tests/packages.scm index 423c5061aa..9f02b0d5d2 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke@gnu.org> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -1135,11 +1136,23 @@ (((? (cut eq? hello <>))) #t) (wrong (pk 'find-packages-by-name wrong #f)))) +(test-assert "find-packages-by-name*/direct" + (match (find-packages-by-name*/direct "hello") + ((((? (cut eq? (resolve-interface '(gnu packages base)) <>)) + (? (cut eq? 'hello <>)) + (? (cut eq? hello <>)))) #t))) + (test-assert "find-packages-by-name with version" (match (find-packages-by-name "hello" (package-version hello)) (((? (cut eq? hello <>))) #t) (wrong (pk 'find-packages-by-name wrong #f)))) +(test-assert "find-packages-by-name*/direct with version" + (match (find-packages-by-name*/direct "hello" (package-version hello)) + ((((? (cut eq? (resolve-interface '(gnu packages base)) <>)) + (? (cut eq? 'hello <>)) + (? (cut eq? hello <>)))) #t))) + (test-equal "find-packages-by-name with cache" (find-packages-by-name "guile") (call-with-temporary-directory -- 2.24.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v2 2/5] gnu: added new procedure, recusive-import-semver 2019-12-05 20:05 ` [bug#38408] [PATCH v2 0/5] Semantic version aware recusive importer for crates Martin Becze 2019-12-05 20:05 ` [bug#38408] [PATCH v2 1/5] gnu: added new function, find-packages-by-name*/direct Martin Becze @ 2019-12-05 20:05 ` Martin Becze 2019-12-05 20:05 ` [bug#38408] [PATCH v2 3/5] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test Martin Becze ` (2 subsequent siblings) 4 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2019-12-05 20:05 UTC (permalink / raw) To: 38408; +Cc: Martin Becze * gnu/packages.scm (recusive-import-semver): New Procedure * gnu/packages.scm (package->definition)[arguments]: New argument, "latest" * tests/import-utils.scm: tests for recusive-import-semver --- guix/import/utils.scm | 181 +++++++++++++++++++++++++++++++++++++++-- tests/import-utils.scm | 162 ++++++++++++++++++++++++++++++++++++ 2 files changed, 336 insertions(+), 7 deletions(-) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 4694b6e7ef..6932614f8e 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -32,6 +33,7 @@ #:use-module (guix discovery) #:use-module (guix build-system) #:use-module (guix gexp) + #:use-module (guix memoization) #:use-module (guix store) #:use-module (guix download) #:use-module (gnu packages) @@ -43,6 +45,8 @@ #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-41) + #:use-module (semver) + #:use-module (semver ranges) #:export (factorize-uri flatten @@ -69,7 +73,8 @@ guix-name - recursive-import)) + recursive-import + recursive-import-semver)) (define (factorize-uri uri version) "Factorize URI, a package tarball URI as a string, such that any occurrences @@ -257,13 +262,15 @@ package definition." ((package-inputs ...) `((native-inputs (,'quasiquote ,package-inputs)))))) -(define (package->definition guix-package) +(define* (package->definition guix-package #:optional (latest #t)) (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 latest + name + (string-append name "-" version))) ,guix-package)))) (define (build-system-modules) @@ -414,3 +421,163 @@ dependencies." step ;; initial state (step initial-state))) + +(define* (recursive-import-semver #:key name + (version #f) + name->metadata + metadata->package + metadata-versions + package-dependencies + dependency-name + dependency-range + guix-name + make-sexp) + "Generates a stream of package expressions for the dependencies of the given +NAME and VERSION. The dependencies will be resolved using semantic versioning. +This procedure makes the assumption that most package repositories will, for a +given package provide some <metadata> on that package that includes what +versions of the package that are available and a list of dependencies for each +version. Dependencies are assumed to be composed of a NAME, a semantic RANGE and +other data. + +This procedure takes the following keys: + NAME - The name of the package to import + VERSION - The version of the package to import + NAME->METADATA - A procedure that takes a NAME of a package and returns that +package's <metadata> + METADATA->PACKAGE A procedure that takes a package's <metadata> and VERSION +and returns the <package> for the given VERSION + METADATA-VERSIONS A procedure that that takes a packages <metadata> and +returns a list of version as strings that are available for the given package + PACKAGE-DEPENDENCIES a procedure that returns a list of <dependency> given a +<package> + DEPENDENCY-NAME A procedure that takes a <dependency> and returns the its name + DEPENDENCY-RANGE A procedure that takes a <dependency> and returns that +decency's range as a string + GUIX-NAME A procedure that take a NAME and returns the Guix version of it + MAKE-SEXP A procedure that takes <metadata>, <package> and a list of pairs +containing (EXPORT-NAME <dependency>), returning the package expression as an +s-expression" + (define mem-name->metadata (memoize name->metadata)) + + (define (latest? versions version) + (equal? (car versions) version)) + + (define (sorted-versions metadata) + (sort (metadata-versions metadata) version>?)) + + (define (name->versions name) + (sorted-versions (mem-name->metadata name))) + + (define (semver-range-contains-string? range version) + (semver-range-contains? range + (string->semver version))) + + (define (guix-export-name name version) + (let ((versions (name->versions name)) + (name (guix-name name))) + (if (latest? versions version) + name + (string-append name "-" version)))) + + ;; checks to see if we already defined or want to define a dep + (define (find-known name range known) + (match + (find + (match-lambda ((dep-name version) + (and + (string=? dep-name name) + (semver-range-contains-string? range version)))) + known) + + (#f #f) + ((name version) (list (guix-export-name name version) version #f))) + ) + + ;; searches searches for a package in guix + (define (find-locally name range) + (match + (find + (match-lambda ((_ _ package) + (semver-range-contains-string? + range + (package-version package)))) + (find-packages-by-name*/direct (guix-name name))) + (#f #f) + ((_ export-symbol package) (list + (symbol->string export-symbol) + (package-version package) #f)))) + + ;; searches for a package in some external repo + (define (find-remote name range) + (let* ((versions (name->versions name)) + (version (find + (lambda (ver) + (semver-range-contains-string? range ver)) + versions)) + (export-name (guix-export-name name version))) + `(,export-name ,version #t))) + + + (define (find-dep-version dep known-deps) + (let* ((name (dependency-name dep)) + (range (string->semver-range (dependency-range dep))) + (export-name-version-needed + (or (find-known name range known-deps) + (find-locally name range) + (find-remote name range)))) + `(,name ,@export-name-version-needed ,dep) + )) + + (define (make-package-definition name version known-deps) + (let* ((metadata (mem-name->metadata name)) + (versions (sorted-versions metadata)) + (package (metadata->package metadata version)) + (deps (map (lambda (dep) + (find-dep-version dep known-deps)) + (package-dependencies package))) + (sexp + (make-sexp metadata package + (map + (match-lambda ((_ export-symbol _ _ dep) + (list export-symbol dep))) + deps)))) + (values + (package->definition sexp (latest? versions version)) + (filter-map + (match-lambda ((name _ version need? dep) + (if need? + (list name version) + #f))) + deps)))) + + (define initial-state + (list #f + (list + ;; packages to find + (list name (if version + version + (car (name->versions name))))) + ;; packages that have been found + (list))) + + (define (step state) + (match state + ((prev ((next-name next-version) . rest) done) + (receive (package dependencies) + (make-package-definition next-name next-version + (append done rest `((,next-name ,next-version)))) + (list + package + (append rest dependencies) + (cons (list next-name next-version) done)))) + ((prev '() done) + (list #f '() done)))) + + (stream-unfold + ;; map: produce a stream element + (match-lambda ((latest queue done) latest)) + ;; predicate + (match-lambda ((latest queue done) latest)) + step + (step initial-state))) diff --git a/tests/import-utils.scm b/tests/import-utils.scm index c3ab25d788..4ed3a5e1da 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 <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2016 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,6 +25,10 @@ #:use-module (guix packages) #:use-module (guix build-system) #:use-module (gnu packages) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-41) #:use-module (srfi srfi-64)) (test-begin "import-utils") @@ -120,4 +125,161 @@ ("license" . #f)))) (package-native-inputs (alist->package meta)))) +(define-record-type <metadata> + (make-metadata name versions) + metadata? + (name metadata-name) + (versions metadata-versions)) + +(define-record-type <package> + (make-package version dependencies) + package? + (version package-version) + (dependencies package-dependencies)) + +(define-record-type <dependency> + (make-dependency name range) + dependency? + (name dependency-name) + (range dependency-range)) + +(define (metadata-semver-versions metadata) + (map (lambda (p) + (package-version p)) + (metadata-versions metadata))) + +(define (metadata->package metadata version) + (find + (lambda (package) + (equal? (package-version package) version)) + (metadata-versions metadata))) + +(define (make-sexp metadata package dependencies) + `(package + (name ,(guix-name (metadata-name metadata))) + (version ,(package-version package)) + (dependcies ,(map + (match-lambda ((public-name dep) + (list (guix-name (dependency-name dep)) public-name))) + dependencies)))) + +(define (guix-name name) + (string-append "test-" name)) + +(define packages + `(("no-deps" . (("1.0.0" . ()) ("0.1.0" . ()))) + ("one-dep" . (("1.0.0" . (("no-deps" "^1.0"))) + ("0.1.0" . (("no-deps" "^0.1.0"))))) + ("shared-dep" . (("1.0.0" . (("one-dep" "^0.1.0") + ("no-deps" "*"))))) + ("recursive" . (("1.0.0" . (("recursive" "=1.0.0"))))) + ("already-packaged" . (("1.0.0" . (("rust" "~1.28"))))))) + +(define (name->metadata name) + (let ((versions (assoc-ref packages name))) + (make-metadata name + (map + (match-lambda + ((version . deps) + (make-package version + (map + (lambda (name-range) + (apply make-dependency name-range)) + deps)))) + versions)))) + +(define* (test-recursive-importer name version #:optional (guix-name guix-name)) + (recursive-import-semver #:name name + #:version version + #:name->metadata name->metadata + #:metadata->package metadata->package + #:metadata-versions metadata-semver-versions + #:package-dependencies package-dependencies + #:dependency-name dependency-name + #:dependency-range dependency-range + #:guix-name guix-name + #:make-sexp make-sexp)) + +(test-equal "recursive import test with no dependencies" + `((define-public test-no-deps + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ())))) + (stream->list (test-recursive-importer "no-deps" "1.0.0"))) + +(test-equal "recursive import test with one dependencies" + `((define-public test-one-dep + (package + (name "test-one-dep") + (version "1.0.0") + (dependcies (("test-no-deps" "test-no-deps"))))) + (define-public test-no-deps + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ())))) + (stream->list (test-recursive-importer "one-dep" "1.0.0"))) + +(test-equal "recursive import test with recursuve dependencies" + `((define-public test-recursive + (package + (name "test-recursive") + (version "1.0.0") + (dependcies (("test-recursive" "test-recursive")))))) + (stream->list (test-recursive-importer "recursive" "1.0.0"))) + +(test-equal "recursive import test with no dependencies using an old version" + `((define-public test-no-deps-0.1.0 + (package + (name "test-no-deps") + (version "0.1.0") + (dependcies ())))) + (stream->list (test-recursive-importer "no-deps" "0.1.0"))) + +(test-equal "recursive import test with one dependencies unsing an old version" + `((define-public test-one-dep-0.1.0 + (package + (name "test-one-dep") + (version "0.1.0") + (dependcies (("test-no-deps" "test-no-deps-0.1.0"))))) + (define-public test-no-deps-0.1.0 + (package + (name "test-no-deps") + (version "0.1.0") + (dependcies ())))) + (stream->list (test-recursive-importer "one-dep" "0.1.0"))) + +(test-equal "recursive import test with with dependency that is already in the repo" + `((define-public test-already-packaged + (package (name "test-already-packaged") + (version "1.0.0") + (dependcies + (("test-rust" "rust-1.28")))))) + (stream->list (test-recursive-importer "already-packaged" "1.0.0" identity))) + +(test-equal "shared dependencies" + `((define-public test-shared-dep + (package + (name "test-shared-dep") + (version "1.0.0") + (dependcies (("test-one-dep" "test-one-dep-0.1.0") + ("test-no-deps" "test-no-deps"))))) + (define-public test-one-dep-0.1.0 + (package + (name "test-one-dep") + (version "0.1.0") + (dependcies (("test-no-deps" "test-no-deps-0.1.0"))))) + (define-public test-no-deps + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ()))) + (define-public test-no-deps-0.1.0 + (package + (name "test-no-deps") + (version "0.1.0") + (dependcies())))) + (stream->list (test-recursive-importer "shared-dep" "1.0.0"))) + (test-end "import-utils") -- 2.24.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v2 3/5] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test. 2019-12-05 20:05 ` [bug#38408] [PATCH v2 0/5] Semantic version aware recusive importer for crates Martin Becze 2019-12-05 20:05 ` [bug#38408] [PATCH v2 1/5] gnu: added new function, find-packages-by-name*/direct Martin Becze 2019-12-05 20:05 ` [bug#38408] [PATCH v2 2/5] gnu: added new procedure, recusive-import-semver Martin Becze @ 2019-12-05 20:05 ` Martin Becze 2019-12-05 20:05 ` [bug#38408] [PATCH v2 4/5] added "#:skip-build? #t" to the output of (make-crate-sexp). Most the the packages imported will be libaries and won't need to build. The top level package will build them though Martin Becze 2019-12-05 20:05 ` [bug#38408] [PATCH v2 5/5] guix: crate: Depublicated build and normal dependencies Martin Becze 4 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2019-12-05 20:05 UTC (permalink / raw) To: 38408; +Cc: Martin Becze * 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 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v2 4/5] added "#:skip-build? #t" to the output of (make-crate-sexp). Most the the packages imported will be libaries and won't need to build. The top level package will build them though. 2019-12-05 20:05 ` [bug#38408] [PATCH v2 0/5] Semantic version aware recusive importer for crates Martin Becze ` (2 preceding siblings ...) 2019-12-05 20:05 ` [bug#38408] [PATCH v2 3/5] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test Martin Becze @ 2019-12-05 20:05 ` Martin Becze 2019-12-05 20:05 ` [bug#38408] [PATCH v2 5/5] guix: crate: Depublicated build and normal dependencies Martin Becze 4 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2019-12-05 20:05 UTC (permalink / raw) To: 38408; +Cc: Martin Becze * guix/import/crate.scm (make-crate-sexp): added "#:skip-build? #t" to the output --- guix/import/crate.scm | 3 ++- tests/crate.scm | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) 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-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))) (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") -- 2.24.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v2 5/5] guix: crate: Depublicated build and normal dependencies 2019-12-05 20:05 ` [bug#38408] [PATCH v2 0/5] Semantic version aware recusive importer for crates Martin Becze ` (3 preceding siblings ...) 2019-12-05 20:05 ` [bug#38408] [PATCH v2 4/5] added "#:skip-build? #t" to the output of (make-crate-sexp). Most the the packages imported will be libaries and won't need to build. The top level package will build them though Martin Becze @ 2019-12-05 20:05 ` Martin Becze 4 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2019-12-05 20:05 UTC (permalink / raw) To: 38408; +Cc: Martin Becze * guix/import/crate.scm: (crate-version-dependencies): dedup deps --- guix/import/crate.scm | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 5683369b7a..f3c36ba516 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -109,14 +109,26 @@ record or #f if it was not found." "Return the list of <crate-dependency> records of VERSION, a <crate-version>." (let* ((path (assoc-ref (crate-version-links version) "dependencies")) - (url (string-append (%crate-base-url) path))) - (match (assoc-ref (or (json-fetch url) '()) "dependencies") - ((? vector? vector) - (filter (lambda (dep) - (not (eq? (crate-dependency-kind dep) 'dev))) - (map json->crate-dependency (vector->list vector)))) - (_ - '())))) + (url (string-append (%crate-base-url) path)) + (deps-list (match (assoc-ref (or (json-fetch url) '()) "dependencies") + ((? vector? vector) (vector->list vector)) + (_ + '()))) + ;; turn the raw list into <dependency>'s and remove dev depenedencies + (deps (filter-map (lambda (json) + (let ((dep (json->crate-dependency json))) + (if (eq? (crate-dependency-kind dep) 'dev) + #f + dep))) + deps-list)) + ;; split normal and build dependencies + (deps-normal deps-build (partition (lambda (dep) + (eq? (crate-dependency-kind dep) 'normal)) + deps))) + ;;remove duplicate normal and build dependencies + (lset-union (lambda (a b) + (string= (crate-dependency-id a) (crate-dependency-id a))) + deps-normal deps-build))) \f ;;; -- 2.24.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v3 0/5] Semantic version aware recusive importer for crates 2019-11-28 0:13 ` [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates Martin Becze ` (3 preceding siblings ...) 2019-12-05 20:05 ` [bug#38408] [PATCH v2 0/5] Semantic version aware recusive importer for crates Martin Becze @ 2019-12-06 18:21 ` Martin Becze 2019-12-06 18:21 ` [bug#38408] [PATCH v3 1/5] gnu: added new function, find-packages-by-name*/direct Martin Becze ` (4 more replies) 2019-12-10 19:23 ` [bug#38408] [PATCH v4 0/6] Semantic version aware recusive importer for crates Martin Becze ` (5 subsequent siblings) 10 siblings, 5 replies; 107+ messages in thread From: Martin Becze @ 2019-12-06 18:21 UTC (permalink / raw) To: 38408; +Cc: Martin Becze This version makes one little change from the prevous version (https://issues.guix.gnu.org/issue/38408#13). I found out that crates could have duplicate dependencies in for every possible target in their Cargo.toml. So just depuplicating the build dependencies agains the normal depedencies was not enough. We need to make sure all the dependencies are unqie! -Martin Martin Becze (5): gnu: added new function, find-packages-by-name*/direct gnu: added new procedure, recusive-import-semver Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test. added "#:skip-build? #t" to the output of (make-crate-sexp). Most the the packages imported will be libaries and won't need to build. The top level package will build them though. guix: crate: Depublicated dependencies gnu/packages.scm | 41 ++++++++ guix/import/crate.scm | 188 +++++++++++++++++++--------------- guix/import/utils.scm | 181 ++++++++++++++++++++++++++++++-- guix/scripts/import/crate.scm | 9 +- tests/crate.scm | 5 +- tests/import-utils.scm | 162 +++++++++++++++++++++++++++++ tests/packages.scm | 13 +++ 7 files changed, 501 insertions(+), 98 deletions(-) -- 2.24.0 ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v3 1/5] gnu: added new function, find-packages-by-name*/direct 2019-12-06 18:21 ` [bug#38408] [PATCH v3 0/5] Semantic version aware recusive importer for crates Martin Becze @ 2019-12-06 18:21 ` Martin Becze 2019-12-06 18:21 ` [bug#38408] [PATCH v3 2/5] gnu: added new procedure, recusive-import-semver Martin Becze ` (3 subsequent siblings) 4 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2019-12-06 18:21 UTC (permalink / raw) To: 38408; +Cc: Martin Becze * gnu/packages.scm (find-packages-by-naem*/direct) --- gnu/packages.scm | 41 +++++++++++++++++++++++++++++++++++++++++ tests/packages.scm | 13 +++++++++++++ 2 files changed, 54 insertions(+) diff --git a/gnu/packages.scm b/gnu/packages.scm index 959777ff8f..cca2a393e5 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -52,7 +53,9 @@ %default-package-module-path fold-packages + fold-packages* fold-available-packages + find-packages-by-name*/direct find-newest-available-packages find-packages-by-name @@ -250,6 +253,23 @@ is guaranteed to never traverse the same package twice." init modules)) +(define* (fold-packages* proc init + #:optional + (modules (all-modules (%package-module-path) + #:warn + warn-about-load-error)) + #:key (select? (negate hidden-package?))) + "Call (PROC PACKAGE RESULT) for each available package defined in one of +MODULES that matches SELECT?, using INIT as the initial value of RESULT. It +is guaranteed to never traverse the same package twice." + (fold-module-public-variables* (lambda (module symbol var result) + (let ((object (variable-ref var))) + (if (and (package? object) (select? object)) + (proc module symbol object result) + result))) + init + modules)) + (define %package-cache-file ;; Location of the package cache. "/lib/guix/package.cache") @@ -297,6 +317,27 @@ decreasing version order." matching) matching))))) +(define find-packages-by-name*/direct ;bypass the cache + (let ((packages (delay + (fold-packages* (lambda (mod sym p r) + (vhash-cons (package-name p) (list mod sym p) r)) + vlist-null))) + (version>? (match-lambda* + (((_ _ versions) ..1) + (apply version>? (map package-version versions)))))) + (lambda* (name #:optional version) + "Return the list of (<module> <symbol> <package>) with the given NAME. If + VERSION is not #f, then only return packages whose version is prefixed by + VERSION, sorted in decreasing version order." + (let ((matching (sort (vhash-fold* cons '() name (force packages)) + version>?))) + (if version + (filter (match-lambda + ((_ _ package) + (version-prefix? version (package-version package)))) + matching) + matching))))) + (define (cache-lookup cache name) "Lookup package NAME in CACHE. Return a list sorted in increasing version order." diff --git a/tests/packages.scm b/tests/packages.scm index 423c5061aa..9f02b0d5d2 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke@gnu.org> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -1135,11 +1136,23 @@ (((? (cut eq? hello <>))) #t) (wrong (pk 'find-packages-by-name wrong #f)))) +(test-assert "find-packages-by-name*/direct" + (match (find-packages-by-name*/direct "hello") + ((((? (cut eq? (resolve-interface '(gnu packages base)) <>)) + (? (cut eq? 'hello <>)) + (? (cut eq? hello <>)))) #t))) + (test-assert "find-packages-by-name with version" (match (find-packages-by-name "hello" (package-version hello)) (((? (cut eq? hello <>))) #t) (wrong (pk 'find-packages-by-name wrong #f)))) +(test-assert "find-packages-by-name*/direct with version" + (match (find-packages-by-name*/direct "hello" (package-version hello)) + ((((? (cut eq? (resolve-interface '(gnu packages base)) <>)) + (? (cut eq? 'hello <>)) + (? (cut eq? hello <>)))) #t))) + (test-equal "find-packages-by-name with cache" (find-packages-by-name "guile") (call-with-temporary-directory -- 2.24.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v3 2/5] gnu: added new procedure, recusive-import-semver 2019-12-06 18:21 ` [bug#38408] [PATCH v3 0/5] Semantic version aware recusive importer for crates Martin Becze 2019-12-06 18:21 ` [bug#38408] [PATCH v3 1/5] gnu: added new function, find-packages-by-name*/direct Martin Becze @ 2019-12-06 18:21 ` Martin Becze 2019-12-06 18:21 ` [bug#38408] [PATCH v3 3/5] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test Martin Becze ` (2 subsequent siblings) 4 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2019-12-06 18:21 UTC (permalink / raw) To: 38408; +Cc: Martin Becze * gnu/packages.scm (recusive-import-semver): New Procedure * gnu/packages.scm (package->definition)[arguments]: New argument, "latest" * tests/import-utils.scm: tests for recusive-import-semver --- guix/import/utils.scm | 181 +++++++++++++++++++++++++++++++++++++++-- tests/import-utils.scm | 162 ++++++++++++++++++++++++++++++++++++ 2 files changed, 336 insertions(+), 7 deletions(-) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 4694b6e7ef..6932614f8e 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -32,6 +33,7 @@ #:use-module (guix discovery) #:use-module (guix build-system) #:use-module (guix gexp) + #:use-module (guix memoization) #:use-module (guix store) #:use-module (guix download) #:use-module (gnu packages) @@ -43,6 +45,8 @@ #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-41) + #:use-module (semver) + #:use-module (semver ranges) #:export (factorize-uri flatten @@ -69,7 +73,8 @@ guix-name - recursive-import)) + recursive-import + recursive-import-semver)) (define (factorize-uri uri version) "Factorize URI, a package tarball URI as a string, such that any occurrences @@ -257,13 +262,15 @@ package definition." ((package-inputs ...) `((native-inputs (,'quasiquote ,package-inputs)))))) -(define (package->definition guix-package) +(define* (package->definition guix-package #:optional (latest #t)) (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 latest + name + (string-append name "-" version))) ,guix-package)))) (define (build-system-modules) @@ -414,3 +421,163 @@ dependencies." step ;; initial state (step initial-state))) + +(define* (recursive-import-semver #:key name + (version #f) + name->metadata + metadata->package + metadata-versions + package-dependencies + dependency-name + dependency-range + guix-name + make-sexp) + "Generates a stream of package expressions for the dependencies of the given +NAME and VERSION. The dependencies will be resolved using semantic versioning. +This procedure makes the assumption that most package repositories will, for a +given package provide some <metadata> on that package that includes what +versions of the package that are available and a list of dependencies for each +version. Dependencies are assumed to be composed of a NAME, a semantic RANGE and +other data. + +This procedure takes the following keys: + NAME - The name of the package to import + VERSION - The version of the package to import + NAME->METADATA - A procedure that takes a NAME of a package and returns that +package's <metadata> + METADATA->PACKAGE A procedure that takes a package's <metadata> and VERSION +and returns the <package> for the given VERSION + METADATA-VERSIONS A procedure that that takes a packages <metadata> and +returns a list of version as strings that are available for the given package + PACKAGE-DEPENDENCIES a procedure that returns a list of <dependency> given a +<package> + DEPENDENCY-NAME A procedure that takes a <dependency> and returns the its name + DEPENDENCY-RANGE A procedure that takes a <dependency> and returns that +decency's range as a string + GUIX-NAME A procedure that take a NAME and returns the Guix version of it + MAKE-SEXP A procedure that takes <metadata>, <package> and a list of pairs +containing (EXPORT-NAME <dependency>), returning the package expression as an +s-expression" + (define mem-name->metadata (memoize name->metadata)) + + (define (latest? versions version) + (equal? (car versions) version)) + + (define (sorted-versions metadata) + (sort (metadata-versions metadata) version>?)) + + (define (name->versions name) + (sorted-versions (mem-name->metadata name))) + + (define (semver-range-contains-string? range version) + (semver-range-contains? range + (string->semver version))) + + (define (guix-export-name name version) + (let ((versions (name->versions name)) + (name (guix-name name))) + (if (latest? versions version) + name + (string-append name "-" version)))) + + ;; checks to see if we already defined or want to define a dep + (define (find-known name range known) + (match + (find + (match-lambda ((dep-name version) + (and + (string=? dep-name name) + (semver-range-contains-string? range version)))) + known) + + (#f #f) + ((name version) (list (guix-export-name name version) version #f))) + ) + + ;; searches searches for a package in guix + (define (find-locally name range) + (match + (find + (match-lambda ((_ _ package) + (semver-range-contains-string? + range + (package-version package)))) + (find-packages-by-name*/direct (guix-name name))) + (#f #f) + ((_ export-symbol package) (list + (symbol->string export-symbol) + (package-version package) #f)))) + + ;; searches for a package in some external repo + (define (find-remote name range) + (let* ((versions (name->versions name)) + (version (find + (lambda (ver) + (semver-range-contains-string? range ver)) + versions)) + (export-name (guix-export-name name version))) + `(,export-name ,version #t))) + + + (define (find-dep-version dep known-deps) + (let* ((name (dependency-name dep)) + (range (string->semver-range (dependency-range dep))) + (export-name-version-needed + (or (find-known name range known-deps) + (find-locally name range) + (find-remote name range)))) + `(,name ,@export-name-version-needed ,dep) + )) + + (define (make-package-definition name version known-deps) + (let* ((metadata (mem-name->metadata name)) + (versions (sorted-versions metadata)) + (package (metadata->package metadata version)) + (deps (map (lambda (dep) + (find-dep-version dep known-deps)) + (package-dependencies package))) + (sexp + (make-sexp metadata package + (map + (match-lambda ((_ export-symbol _ _ dep) + (list export-symbol dep))) + deps)))) + (values + (package->definition sexp (latest? versions version)) + (filter-map + (match-lambda ((name _ version need? dep) + (if need? + (list name version) + #f))) + deps)))) + + (define initial-state + (list #f + (list + ;; packages to find + (list name (if version + version + (car (name->versions name))))) + ;; packages that have been found + (list))) + + (define (step state) + (match state + ((prev ((next-name next-version) . rest) done) + (receive (package dependencies) + (make-package-definition next-name next-version + (append done rest `((,next-name ,next-version)))) + (list + package + (append rest dependencies) + (cons (list next-name next-version) done)))) + ((prev '() done) + (list #f '() done)))) + + (stream-unfold + ;; map: produce a stream element + (match-lambda ((latest queue done) latest)) + ;; predicate + (match-lambda ((latest queue done) latest)) + step + (step initial-state))) diff --git a/tests/import-utils.scm b/tests/import-utils.scm index c3ab25d788..4ed3a5e1da 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 <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2016 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,6 +25,10 @@ #:use-module (guix packages) #:use-module (guix build-system) #:use-module (gnu packages) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-41) #:use-module (srfi srfi-64)) (test-begin "import-utils") @@ -120,4 +125,161 @@ ("license" . #f)))) (package-native-inputs (alist->package meta)))) +(define-record-type <metadata> + (make-metadata name versions) + metadata? + (name metadata-name) + (versions metadata-versions)) + +(define-record-type <package> + (make-package version dependencies) + package? + (version package-version) + (dependencies package-dependencies)) + +(define-record-type <dependency> + (make-dependency name range) + dependency? + (name dependency-name) + (range dependency-range)) + +(define (metadata-semver-versions metadata) + (map (lambda (p) + (package-version p)) + (metadata-versions metadata))) + +(define (metadata->package metadata version) + (find + (lambda (package) + (equal? (package-version package) version)) + (metadata-versions metadata))) + +(define (make-sexp metadata package dependencies) + `(package + (name ,(guix-name (metadata-name metadata))) + (version ,(package-version package)) + (dependcies ,(map + (match-lambda ((public-name dep) + (list (guix-name (dependency-name dep)) public-name))) + dependencies)))) + +(define (guix-name name) + (string-append "test-" name)) + +(define packages + `(("no-deps" . (("1.0.0" . ()) ("0.1.0" . ()))) + ("one-dep" . (("1.0.0" . (("no-deps" "^1.0"))) + ("0.1.0" . (("no-deps" "^0.1.0"))))) + ("shared-dep" . (("1.0.0" . (("one-dep" "^0.1.0") + ("no-deps" "*"))))) + ("recursive" . (("1.0.0" . (("recursive" "=1.0.0"))))) + ("already-packaged" . (("1.0.0" . (("rust" "~1.28"))))))) + +(define (name->metadata name) + (let ((versions (assoc-ref packages name))) + (make-metadata name + (map + (match-lambda + ((version . deps) + (make-package version + (map + (lambda (name-range) + (apply make-dependency name-range)) + deps)))) + versions)))) + +(define* (test-recursive-importer name version #:optional (guix-name guix-name)) + (recursive-import-semver #:name name + #:version version + #:name->metadata name->metadata + #:metadata->package metadata->package + #:metadata-versions metadata-semver-versions + #:package-dependencies package-dependencies + #:dependency-name dependency-name + #:dependency-range dependency-range + #:guix-name guix-name + #:make-sexp make-sexp)) + +(test-equal "recursive import test with no dependencies" + `((define-public test-no-deps + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ())))) + (stream->list (test-recursive-importer "no-deps" "1.0.0"))) + +(test-equal "recursive import test with one dependencies" + `((define-public test-one-dep + (package + (name "test-one-dep") + (version "1.0.0") + (dependcies (("test-no-deps" "test-no-deps"))))) + (define-public test-no-deps + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ())))) + (stream->list (test-recursive-importer "one-dep" "1.0.0"))) + +(test-equal "recursive import test with recursuve dependencies" + `((define-public test-recursive + (package + (name "test-recursive") + (version "1.0.0") + (dependcies (("test-recursive" "test-recursive")))))) + (stream->list (test-recursive-importer "recursive" "1.0.0"))) + +(test-equal "recursive import test with no dependencies using an old version" + `((define-public test-no-deps-0.1.0 + (package + (name "test-no-deps") + (version "0.1.0") + (dependcies ())))) + (stream->list (test-recursive-importer "no-deps" "0.1.0"))) + +(test-equal "recursive import test with one dependencies unsing an old version" + `((define-public test-one-dep-0.1.0 + (package + (name "test-one-dep") + (version "0.1.0") + (dependcies (("test-no-deps" "test-no-deps-0.1.0"))))) + (define-public test-no-deps-0.1.0 + (package + (name "test-no-deps") + (version "0.1.0") + (dependcies ())))) + (stream->list (test-recursive-importer "one-dep" "0.1.0"))) + +(test-equal "recursive import test with with dependency that is already in the repo" + `((define-public test-already-packaged + (package (name "test-already-packaged") + (version "1.0.0") + (dependcies + (("test-rust" "rust-1.28")))))) + (stream->list (test-recursive-importer "already-packaged" "1.0.0" identity))) + +(test-equal "shared dependencies" + `((define-public test-shared-dep + (package + (name "test-shared-dep") + (version "1.0.0") + (dependcies (("test-one-dep" "test-one-dep-0.1.0") + ("test-no-deps" "test-no-deps"))))) + (define-public test-one-dep-0.1.0 + (package + (name "test-one-dep") + (version "0.1.0") + (dependcies (("test-no-deps" "test-no-deps-0.1.0"))))) + (define-public test-no-deps + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ()))) + (define-public test-no-deps-0.1.0 + (package + (name "test-no-deps") + (version "0.1.0") + (dependcies())))) + (stream->list (test-recursive-importer "shared-dep" "1.0.0"))) + (test-end "import-utils") -- 2.24.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v3 3/5] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test. 2019-12-06 18:21 ` [bug#38408] [PATCH v3 0/5] Semantic version aware recusive importer for crates Martin Becze 2019-12-06 18:21 ` [bug#38408] [PATCH v3 1/5] gnu: added new function, find-packages-by-name*/direct Martin Becze 2019-12-06 18:21 ` [bug#38408] [PATCH v3 2/5] gnu: added new procedure, recusive-import-semver Martin Becze @ 2019-12-06 18:21 ` Martin Becze 2019-12-06 18:21 ` [bug#38408] [PATCH v3 4/5] added "#:skip-build? #t" to the output of (make-crate-sexp). Most the the packages imported will be libaries and won't need to build. The top level package will build them though Martin Becze 2019-12-06 18:21 ` [bug#38408] [PATCH v3 5/5] guix: crate: Depublicated dependencies Martin Becze 4 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2019-12-06 18:21 UTC (permalink / raw) To: 38408; +Cc: Martin Becze * 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 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v3 4/5] added "#:skip-build? #t" to the output of (make-crate-sexp). Most the the packages imported will be libaries and won't need to build. The top level package will build them though. 2019-12-06 18:21 ` [bug#38408] [PATCH v3 0/5] Semantic version aware recusive importer for crates Martin Becze ` (2 preceding siblings ...) 2019-12-06 18:21 ` [bug#38408] [PATCH v3 3/5] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test Martin Becze @ 2019-12-06 18:21 ` Martin Becze 2019-12-06 18:21 ` [bug#38408] [PATCH v3 5/5] guix: crate: Depublicated dependencies Martin Becze 4 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2019-12-06 18:21 UTC (permalink / raw) To: 38408; +Cc: Martin Becze * guix/import/crate.scm (make-crate-sexp): added "#:skip-build? #t" to the output --- guix/import/crate.scm | 3 ++- tests/crate.scm | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) 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-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))) (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") -- 2.24.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v3 5/5] guix: crate: Depublicated dependencies 2019-12-06 18:21 ` [bug#38408] [PATCH v3 0/5] Semantic version aware recusive importer for crates Martin Becze ` (3 preceding siblings ...) 2019-12-06 18:21 ` [bug#38408] [PATCH v3 4/5] added "#:skip-build? #t" to the output of (make-crate-sexp). Most the the packages imported will be libaries and won't need to build. The top level package will build them though Martin Becze @ 2019-12-06 18:21 ` Martin Becze 4 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2019-12-06 18:21 UTC (permalink / raw) To: 38408; +Cc: Martin Becze * guix/import/crate.scm: (crate-version-dependencies): dedup deps --- guix/import/crate.scm | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 5683369b7a..f3c36ba516 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -109,14 +109,26 @@ record or #f if it was not found." "Return the list of <crate-dependency> records of VERSION, a <crate-version>." (let* ((path (assoc-ref (crate-version-links version) "dependencies")) - (url (string-append (%crate-base-url) path))) - (match (assoc-ref (or (json-fetch url) '()) "dependencies") - ((? vector? vector) - (filter (lambda (dep) - (not (eq? (crate-dependency-kind dep) 'dev))) - (map json->crate-dependency (vector->list vector)))) - (_ - '())))) + (url (string-append (%crate-base-url) path)) + (deps-list (match (assoc-ref (or (json-fetch url) '()) "dependencies") + ((? vector? vector) (vector->list vector)) + (_ + '()))) + ;; turn the raw list into <dependency>'s and remove dev depenedencies + (deps (filter-map (lambda (json) + (let ((dep (json->crate-dependency json))) + (if (eq? (crate-dependency-kind dep) 'dev) + #f + dep))) + deps-list)) + ;; split normal and build dependencies + (deps-normal deps-build (partition (lambda (dep) + (eq? (crate-dependency-kind dep) 'normal)) + deps))) + ;;remove duplicate normal and build dependencies + (lset-union (lambda (a b) + (string= (crate-dependency-id a) (crate-dependency-id a))) + deps-normal deps-build))) \f ;;; -- 2.24.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v4 0/6] Semantic version aware recusive importer for crates 2019-11-28 0:13 ` [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates Martin Becze ` (4 preceding siblings ...) 2019-12-06 18:21 ` [bug#38408] [PATCH v3 0/5] Semantic version aware recusive importer for crates Martin Becze @ 2019-12-10 19:23 ` Martin Becze 2019-12-10 19:23 ` [bug#38408] [PATCH v4 1/6] gnu: added new function, find-packages-by-name*/direct Martin Becze ` (5 more replies) 2019-12-16 23:30 ` [bug#38408] Rewrote recursive-import-semver based on topological-sort Martin Becze ` (4 subsequent siblings) 10 siblings, 6 replies; 107+ messages in thread From: Martin Becze @ 2019-12-10 19:23 UTC (permalink / raw) To: 38408; +Cc: Martin Becze Hi Guix, This version adds a feature. You can an import a crate using a semantive version range. ie. "guix import crate -r ripgrep@^1". Let me know if you have any suggetions or stuff to fix on this patch! Thanks. -Martin Martin Becze (6): gnu: added new function, find-packages-by-name*/direct gnu: added new procedure, recusive-import-semver Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test. added "#:skip-build? #t" to the output of (make-crate-sexp). Most the the packages imported will be libaries and won't need to build. The top level package will build them though. guix: crate: Depublicated dependencies guix: import: recursive-import-semver: allow the range of a package to be specified when begining import. gnu/packages.scm | 41 ++++++++ guix/import/crate.scm | 186 +++++++++++++++++--------------- guix/import/utils.scm | 192 ++++++++++++++++++++++++++++++++-- guix/scripts/import/crate.scm | 9 +- tests/crate.scm | 5 +- tests/import-utils.scm | 175 +++++++++++++++++++++++++++++++ tests/packages.scm | 13 +++ 7 files changed, 522 insertions(+), 99 deletions(-) -- 2.24.0 ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v4 1/6] gnu: added new function, find-packages-by-name*/direct 2019-12-10 19:23 ` [bug#38408] [PATCH v4 0/6] Semantic version aware recusive importer for crates Martin Becze @ 2019-12-10 19:23 ` Martin Becze 2019-12-19 22:00 ` Ludovic Courtès 2019-12-10 19:23 ` [bug#38408] [PATCH v4 2/6] gnu: added new procedure, recusive-import-semver Martin Becze ` (4 subsequent siblings) 5 siblings, 1 reply; 107+ messages in thread From: Martin Becze @ 2019-12-10 19:23 UTC (permalink / raw) To: 38408; +Cc: Martin Becze * gnu/packages.scm (find-packages-by-naem*/direct) --- gnu/packages.scm | 41 +++++++++++++++++++++++++++++++++++++++++ tests/packages.scm | 13 +++++++++++++ 2 files changed, 54 insertions(+) diff --git a/gnu/packages.scm b/gnu/packages.scm index 959777ff8f..cca2a393e5 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -52,7 +53,9 @@ %default-package-module-path fold-packages + fold-packages* fold-available-packages + find-packages-by-name*/direct find-newest-available-packages find-packages-by-name @@ -250,6 +253,23 @@ is guaranteed to never traverse the same package twice." init modules)) +(define* (fold-packages* proc init + #:optional + (modules (all-modules (%package-module-path) + #:warn + warn-about-load-error)) + #:key (select? (negate hidden-package?))) + "Call (PROC PACKAGE RESULT) for each available package defined in one of +MODULES that matches SELECT?, using INIT as the initial value of RESULT. It +is guaranteed to never traverse the same package twice." + (fold-module-public-variables* (lambda (module symbol var result) + (let ((object (variable-ref var))) + (if (and (package? object) (select? object)) + (proc module symbol object result) + result))) + init + modules)) + (define %package-cache-file ;; Location of the package cache. "/lib/guix/package.cache") @@ -297,6 +317,27 @@ decreasing version order." matching) matching))))) +(define find-packages-by-name*/direct ;bypass the cache + (let ((packages (delay + (fold-packages* (lambda (mod sym p r) + (vhash-cons (package-name p) (list mod sym p) r)) + vlist-null))) + (version>? (match-lambda* + (((_ _ versions) ..1) + (apply version>? (map package-version versions)))))) + (lambda* (name #:optional version) + "Return the list of (<module> <symbol> <package>) with the given NAME. If + VERSION is not #f, then only return packages whose version is prefixed by + VERSION, sorted in decreasing version order." + (let ((matching (sort (vhash-fold* cons '() name (force packages)) + version>?))) + (if version + (filter (match-lambda + ((_ _ package) + (version-prefix? version (package-version package)))) + matching) + matching))))) + (define (cache-lookup cache name) "Lookup package NAME in CACHE. Return a list sorted in increasing version order." diff --git a/tests/packages.scm b/tests/packages.scm index 423c5061aa..9f02b0d5d2 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke@gnu.org> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -1135,11 +1136,23 @@ (((? (cut eq? hello <>))) #t) (wrong (pk 'find-packages-by-name wrong #f)))) +(test-assert "find-packages-by-name*/direct" + (match (find-packages-by-name*/direct "hello") + ((((? (cut eq? (resolve-interface '(gnu packages base)) <>)) + (? (cut eq? 'hello <>)) + (? (cut eq? hello <>)))) #t))) + (test-assert "find-packages-by-name with version" (match (find-packages-by-name "hello" (package-version hello)) (((? (cut eq? hello <>))) #t) (wrong (pk 'find-packages-by-name wrong #f)))) +(test-assert "find-packages-by-name*/direct with version" + (match (find-packages-by-name*/direct "hello" (package-version hello)) + ((((? (cut eq? (resolve-interface '(gnu packages base)) <>)) + (? (cut eq? 'hello <>)) + (? (cut eq? hello <>)))) #t))) + (test-equal "find-packages-by-name with cache" (find-packages-by-name "guile") (call-with-temporary-directory -- 2.24.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v4 1/6] gnu: added new function, find-packages-by-name*/direct 2019-12-10 19:23 ` [bug#38408] [PATCH v4 1/6] gnu: added new function, find-packages-by-name*/direct Martin Becze @ 2019-12-19 22:00 ` Ludovic Courtès 2019-12-20 18:37 ` Martin Becze 0 siblings, 1 reply; 107+ messages in thread From: Ludovic Courtès @ 2019-12-19 22:00 UTC (permalink / raw) To: Martin Becze; +Cc: 38408 Hello! I’m not a Crate expert so I’m only commenting on non-Crate-specific bits. Martin Becze <mjbecze@riseup.net> skribis: > * gnu/packages.scm (find-packages-by-naem*/direct) [...] > +(define* (fold-packages* proc init > + #:optional > + (modules (all-modules (%package-module-path) > + #:warn > + warn-about-load-error)) > + #:key (select? (negate hidden-package?))) > + "Call (PROC PACKAGE RESULT) for each available package defined in one of > +MODULES that matches SELECT?, using INIT as the initial value of RESULT. It > +is guaranteed to never traverse the same package twice." > + (fold-module-public-variables* (lambda (module symbol var result) > + (let ((object (variable-ref var))) > + (if (and (package? object) (select? object)) > + (proc module symbol object result) I’m wary of exposing variable names, especially in such a central API. > +(define find-packages-by-name*/direct ;bypass the cache Providing an explicit cache bypassing method also sounds worrying to me: the cache is supposed to be transparent and semantics-preserving. More generally, I think adding new features to an importer shouldn’t require modifications in this area, as a matter of separating concerns. WDYT? Thanks, Ludo’. ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v4 1/6] gnu: added new function, find-packages-by-name*/direct 2019-12-19 22:00 ` Ludovic Courtès @ 2019-12-20 18:37 ` Martin Becze 2019-12-27 18:38 ` Ludovic Courtès 0 siblings, 1 reply; 107+ messages in thread From: Martin Becze @ 2019-12-20 18:37 UTC (permalink / raw) To: Ludovic Courtès; +Cc: 38408 [-- Attachment #1: Type: text/plain, Size: 500 bytes --] > > Providing an explicit cache bypassing method also sounds worrying to me: > the cache is supposed to be transparent and semantics-preserving. > > More generally, I think adding new features to an importer shouldn’t > require modifications in this area, as a matter of separating concerns. > > WDYT? > > Thanks, > Ludo’. yes I agree, I removed that in the last version! Which also rebases off the new topological sort procedure. I'll attach the latest patches here, in case you missed it. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: v5-0001-guix-import-added-recusive-import-semver.patch --] [-- Type: text/x-diff; name=v5-0001-guix-import-added-recusive-import-semver.patch, Size: 9441 bytes --] From eeffdf569c4d7fbfd843e0b48404b6a2f3d46343 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Mon, 16 Dec 2019 17:08:16 -0500 Subject: [PATCH v5 1/4] guix: import: added recusive-import-semver * guix/import/utils.scm (recusive-import-semver): New Varible * guix/import/utils.scm (package->definition)[arguments]: Add append-verions option --- guix/import/utils.scm | 168 ++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 161 insertions(+), 7 deletions(-) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index d17d400ddf..7f75f50e23 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -40,10 +41,13 @@ #:use-module (ice-9 rdelim) #:use-module (ice-9 receive) #:use-module (ice-9 regex) + #:use-module (semver) + #:use-module (semver ranges) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-71) #:export (factorize-uri flatten @@ -70,7 +74,8 @@ guix-name - recursive-import)) + recursive-import + recursive-import-semver)) (define (factorize-uri uri version) "Factorize URI, a package tarball URI as a string, such that any occurrences @@ -258,13 +263,13 @@ 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) @@ -428,3 +433,152 @@ name corresponding to the upstream name." (remove exists? (node-dependencies node)))) node-name))) + +(define* (recursive-import-semver #:key + name + (range "*") + name->metadata + metadata->package + metadata-versions + package-dependencies + dependency-name + dependency-range + guix-name + make-sexp) + "Generates a list of package expressions for the dependencies of the given +NAME and version RANGE. The dependencies will be resolved using semantic versioning. +This procedure makes the assumption that most package repositories will, for a +given package provide some <metadata> on that package that includes what +versions of the package that are available and a list of dependencies for each +version. Dependencies are assumed to be composed of a NAME, a semantic RANGE and +other data. + +This procedure takes the following keys: + NAME - The name of the package to import + RANGE - The version range of the package to import + NAME->METADATA - A procedure that takes a NAME of a package and returns that +package's <metadata> + METADATA->PACKAGE A procedure that takes a package's <metadata> and VERSION +and returns the <package> for the given VERSION + METADATA-VERSIONS A procedure that that takes a packages <metadata> and +returns a list of version as strings that are available for the given package + PACKAGE-DEPENDENCIES a procedure that returns a list of <dependency> given a +<package> + DEPENDENCY-NAME A procedure that takes a <dependency> and returns the its name + DEPENDENCY-RANGE A procedure that takes a <dependency> and returns that +decency's range as a string + GUIX-NAME A procedure that take a NAME and returns the Guix version of it + MAKE-SEXP A procedure that takes <metadata>, <package> and a list of pairs +containing (EXPORT-NAME <dependency>), returning the package expression as an +s-expression" + (define-record-type <node-dependency> + (make-node-dependency dependency version exists?) + node-dependency? + (dependency node-dependency-dependency) + (version node-dependency-version) + (exists? node-dependency-exists?)) + + (define-record-type <node> + (make-node name version metadata package dependencies) + node? + (name node-name) + (version node-version) + (metadata node-metadata) + (package node-package) + (dependencies node-dependencies)) + + (define mem-name->metadata (memoize name->metadata)) + (define mem-package-dependencies (memoize package-dependencies)) + + (define (semver-range-contains-string? range version) + (semver-range-contains? range (string->semver version))) + + (define (name+version name version) + (string-append name "-" version)) + + (define (public-name name version) + "Given a NAME and a VERSION of a package, returns the name of the +symbol used is define-public" + (guix-name (name+version name version))) + + ;; searches searches for a package in guix + (define (find-locally name range) + (match (find + (lambda (package) + (semver-range-contains-string? + range + (package-version package))) + (find-packages-by-name (guix-name name))) + (#f #f) + (package (list (package-version package) #t)))) + + ;; searches for a package in some external repo + (define (find-remote name range) + (let* ((versions (sort + (metadata-versions + (mem-name->metadata name)) + version>?)) + (version (find + (lambda (ver) + (semver-range-contains-string? range ver)) + versions))) + (list version #f))) + + (define (find-by-name-range name range) + "Given a NAME, RANGE this will return a VERSION and BOOL which repesents +whether the package has been encountered or not." + (let ((semver-range (string->semver-range range))) + (apply values + (or (find-locally name semver-range) + (find-remote name semver-range))))) + + (define (make-package-definition node) + (let* ((metadata (node-metadata node)) + (package (node-package node)) + (dependencies ;; a list of (public-name dependency) + (map (lambda (node-dep) + (let* ((dep (node-dependency-dependency node-dep)) + (ver (node-dependency-version node-dep)) + (name (dependency-name dep))) + (list (public-name name ver) dep))) + (node-dependencies node))) + (sexp (make-sexp metadata package dependencies))) + (package->definition sexp #t))) + + (define (dependency->node-dependency dep) + (let* ((name (dependency-name dep)) + (range (dependency-range dep)) + (version exists? (find-by-name-range name range))) + (make-node-dependency dep version exists?))) + + (define (name-version->node name version) + (let* ((metadata (mem-name->metadata name)) + (package (metadata->package metadata version)) + (dependencies (mem-package-dependencies package)) + (node-dependencies (map (lambda (dep) + (dependency->node-dependency dep)) + dependencies))) + (make-node name version metadata package node-dependencies))) + + (define (node-dependency->node node-dependency) + (let* ((dependency (node-dependency-dependency node-dependency)) + (name (dependency-name dependency)) + (version (node-dependency-version node-dependency))) + (name-version->node name version))) + + (let ((version exists? (find-by-name-range name range))) + (if exists? + (display + (string-append "package " (name+version name version) " alread exists - ") + (current-error-port)) + (map make-package-definition + (topological-sort (list (name-version->node name version)) + (lambda (node) + (map (lambda (dep) + (node-dependency->node dep)) + (remove node-dependency-exists? + (node-dependencies node)))) + (lambda (node) + (name+version + (node-name node) + (node-version node)))))))) -- 2.24.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: v5-0002-guix-import-crate-crate-recusive-import-use-recus.patch --] [-- Type: text/x-diff; name=v5-0002-guix-import-crate-crate-recusive-import-use-recus.patch, Size: 23572 bytes --] From d3130d97a02f29bfe388650fe40131aa5c762f04 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Mon, 16 Dec 2019 17:33:50 -0500 Subject: [PATCH v5 2/4] guix: import: crate: crate-recusive-import, use recusive-import-semver * guix/import/crate.scm (crate-recusive-import): use recusive-import-semver * guix/import/crate.scm (make-crate-sexp)[argumnets]: use <crate> and <version> * guix/import/crate.scm (crate-version-dependencies): dedup dependencies * guix/test/crate.scm: updated test --- guix/import/crate.scm | 175 +++++++++++++++++-------------- tests/crate.scm | 232 ++++++++++++++++++++++++------------------ 2 files changed, 229 insertions(+), 178 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 4c3f8000d0..3e5b022873 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 @@ -108,13 +109,22 @@ record or #f if it was not found." "Return the list of <crate-dependency> records of VERSION, a <crate-version>." (let* ((path (assoc-ref (crate-version-links version) "dependencies")) - (url (string-append (%crate-base-url) path))) - (match (assoc-ref (or (json-fetch url) '()) "dependencies") - ((? vector? vector) - (map json->crate-dependency (vector->list vector))) - (_ - '())))) - + (url (string-append (%crate-base-url) path)) + (deps-list (match (assoc-ref (or (json-fetch url) '()) "dependencies") + ((? vector? vector) (vector->list vector)) + (_ + '()))) + ;; turn the raw list into <dependency>'s and remove dev depenedencies + (deps (filter-map (lambda (json) + (let ((dep (json->crate-dependency json))) + (if (eq? (crate-dependency-kind dep) 'dev) + #f + dep))) + deps-list))) + ;;remove duplicate dependencies + (apply lset-adjoin `(,(lambda (a b) + (string-ci=? (crate-dependency-id a) (crate-dependency-id b))) + () ,@deps)))) \f ;;; ;;; Converting crates to Guix packages. @@ -141,42 +151,55 @@ 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))))) + + (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 `(#:skip-build? #t) + (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 (string->license string) (filter-map (lambda (license) @@ -187,15 +210,24 @@ and LICENSE." 'unknown-license!))) (string-split string (string->char-set " /")))) +(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 (normal-dependency? dependency) - (eq? (crate-dependency-kind dependency) 'normal)) - (define crate (lookup-crate crate-name)) @@ -204,38 +236,28 @@ 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)) + + (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)) - (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 (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 range) + (recursive-import-semver + #:name name + #:range (if range range "*") + #: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." @@ -284,4 +306,3 @@ latest version of CRATE-NAME." (description "Updater for crates.io packages") (pred crate-package?) (latest latest-release))) - diff --git a/tests/crate.scm b/tests/crate.scm index 61933a8de8..42c94b9996 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -56,6 +57,7 @@ { \"crate_id\": \"bar\", \"kind\": \"normal\", + \"req\": \"1\" } ] }") @@ -88,18 +90,22 @@ { \"crate_id\": \"intermediate-1\", \"kind\": \"normal\", + \"req\": \"1\" }, { \"crate_id\": \"intermediate-2\", \"kind\": \"normal\", + \"req\": \"1\" } { \"crate_id\": \"leaf-alice\", \"kind\": \"normal\", + \"req\": \"1\" }, { \"crate_id\": \"leaf-bob\", \"kind\": \"normal\", + \"req\": \"1\" }, ] }") @@ -132,14 +138,17 @@ { \"crate_id\": \"intermediate-2\", \"kind\": \"normal\", + \"req\": \"1\" }, { \"crate_id\": \"leaf-alice\", \"kind\": \"normal\", + \"req\": \"1\" }, { \"crate_id\": \"leaf-bob\", \"kind\": \"normal\", + \"req\": \"1\" } ] }") @@ -172,6 +181,7 @@ { \"crate_id\": \"leaf-bob\", \"kind\": \"normal\", + \"req\": \"1\" }, ] }") @@ -268,14 +278,15 @@ ('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))))) ('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") @@ -335,107 +346,126 @@ ("https://crates.io/api/v1/crates/leaf-bob/1.0.0/dependencies" (open-input-string test-leaf-bob-dependencies)) (_ (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-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 ".crate")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'cargo-build-system) + ('arguments + ('quasiquote + ('#:skip-build? #t + '#:cargo-inputs (("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)))) + ('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 ".crate")) + ('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-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 ".crate")) + ('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 ".crate")) + ('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-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 ".crate")) + ('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.24.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #4: v5-0003-guix-tests-added-tests-for-recursive-import-semve.patch --] [-- Type: text/x-diff; name=v5-0003-guix-tests-added-tests-for-recursive-import-semve.patch, Size: 7378 bytes --] From 5495834ca375186912eeed40c7c8ce96254c36b3 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Mon, 16 Dec 2019 17:46:47 -0500 Subject: [PATCH v5 3/4] guix: tests: added tests for recursive-import-semver * guix/tests/import-utils.scm: tests for recursive-import-semver --- tests/import-utils.scm | 177 ++++++++++++++++++++++++++++++++++++++++- 1 file changed, 175 insertions(+), 2 deletions(-) diff --git a/tests/import-utils.scm b/tests/import-utils.scm index 87dda3238f..2ee81386ec 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 <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2016 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,8 +25,10 @@ #:use-module (guix packages) #:use-module (guix build-system) #:use-module (gnu packages) - #:use-module (srfi srfi-64) - #:use-module (ice-9 match)) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-64)) (test-begin "import-utils") @@ -141,4 +144,174 @@ ("license" . #f)))) (package-native-inputs (alist->package meta)))) +(define-record-type <metadata> + (make-metadata name versions) + metadata? + (name metadata-name) + (versions metadata-versions)) + +(define-record-type <package> + (make-package version dependencies) + package? + (version package-version) + (dependencies package-dependencies)) + +(define-record-type <dependency> + (make-dependency name range) + dependency? + (name dependency-name) + (range dependency-range)) + +(define (metadata-semver-versions metadata) + (map (lambda (p) + (package-version p)) + (metadata-versions metadata))) + +(define (metadata->package metadata version) + (find + (lambda (package) + (equal? (package-version package) version)) + (metadata-versions metadata))) + +(define (make-sexp metadata package dependencies) + `(package + (name ,(guix-name (metadata-name metadata))) + (version ,(package-version package)) + (dependcies ,(map + (match-lambda ((public-name dep) + (list (guix-name (dependency-name dep)) public-name))) + dependencies)))) + +(define (guix-name name) + (string-append "test-" name)) + +(define packages + `(("no-deps" . (("1.0.0" . ()) ("0.1.0" . ()))) + ("one-dep" . (("1.0.0" . (("no-deps" "^1.0"))) + ("0.1.0" . (("no-deps" "^0.1.0"))))) + ("shared-dep" . (("1.0.0" . (("one-dep" "^0.1.0") + ("no-deps" "*"))))) + ("recursive" . (("1.0.0" . (("recursive" "=1.0.0"))))) + ("already-packaged" . (("1.0.0" . (("rust" "~1.28"))))))) + +(define (name->metadata name) + (let ((versions (assoc-ref packages name))) + (make-metadata name + (map + (match-lambda + ((version . deps) + (make-package version + (map + (lambda (name-range) + (apply make-dependency name-range)) + deps)))) + versions)))) + +(define* (test-recursive-importer name version #:optional (guix-name guix-name)) + (recursive-import-semver #:name name + #:range version + #:name->metadata name->metadata + #:metadata->package metadata->package + #:metadata-versions metadata-semver-versions + #:package-dependencies package-dependencies + #:dependency-name dependency-name + #:dependency-range dependency-range + #:guix-name guix-name + #:make-sexp make-sexp)) + +(test-equal "recursive import test with no dependencies" + `((define-public test-no-deps-1.0.0 + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ())))) + (test-recursive-importer "no-deps" "1.0.0")) + +(test-equal "recursive import test with one dependencies" + `((define-public test-no-deps-1.0.0 + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ()))) + (define-public test-one-dep-1.0.0 + (package + (name "test-one-dep") + (version "1.0.0") + (dependcies (("test-no-deps" "test-no-deps-1.0.0")))))) + (test-recursive-importer "one-dep" "1.0.0")) + +(test-equal "recursive import test with recursuve dependencies" + `((define-public test-recursive-1.0.0 + (package + (name "test-recursive") + (version "1.0.0") + (dependcies (("test-recursive" "test-recursive-1.0.0")))))) + (test-recursive-importer "recursive" "1.0.0")) + +(test-equal "recursive import test with no dependencies using an old version" + `((define-public test-no-deps-0.1.0 + (package + (name "test-no-deps") + (version "0.1.0") + (dependcies ())))) + (test-recursive-importer "no-deps" "0.1.0")) + +(test-equal "recursive import test with one dependencies unsing an old version" + `((define-public test-no-deps-0.1.0 + (package + (name "test-no-deps") + (version "0.1.0") + (dependcies ()))) + (define-public test-one-dep-0.1.0 + (package + (name "test-one-dep") + (version "0.1.0") + (dependcies (("test-no-deps" "test-no-deps-0.1.0")))))) + (test-recursive-importer "one-dep" "0.1.0")) + +(test-equal "recursive import test with a version range" + `((define-public test-no-deps-1.0.0 + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ()))) + (define-public test-one-dep-1.0.0 + (package + (name "test-one-dep") + (version "1.0.0") + (dependcies (("test-no-deps" "test-no-deps-1.0.0")))))) + (test-recursive-importer "one-dep" "*")) + +(test-equal "recursive import test with with dependency that is already in the repo" + `((define-public test-already-packaged-1.0.0 + (package (name "test-already-packaged") + (version "1.0.0") + (dependcies + (("test-rust" "rust-1.28.0")))))) + (test-recursive-importer "already-packaged" "1.0.0" identity)) + +(test-equal "shared dependencies" + `((define-public test-no-deps-1.0.0 + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ()))) + (define-public test-no-deps-0.1.0 + (package + (name "test-no-deps") + (version "0.1.0") + (dependcies ()))) + (define-public test-one-dep-0.1.0 + (package + (name "test-one-dep") + (version "0.1.0") + (dependcies (("test-no-deps" "test-no-deps-0.1.0"))))) + (define-public test-shared-dep-1.0.0 + (package + (name "test-shared-dep") + (version "1.0.0") + (dependcies (("test-one-dep" "test-one-dep-0.1.0") + ("test-no-deps" "test-no-deps-1.0.0")))))) + (test-recursive-importer "shared-dep" "1.0.0")) + (test-end "import-utils") -- 2.24.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #5: v5-0004-gnu-scripts-import-crate-Remove-define-public-gen.patch --] [-- Type: text/x-diff; name=v5-0004-gnu-scripts-import-crate-Remove-define-public-gen.patch, Size: 1273 bytes --] From aa6aaeacb5f91508f4158999ba6e7f95e8309bed Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Mon, 16 Dec 2019 18:11:38 -0500 Subject: [PATCH v5 4/4] gnu: scripts: import: crate: Remove `define-public` generation from UI * guix/scripts/import/crate.scm (guix-import-crate): Remove `define-public` generation from UI --- guix/scripts/import/crate.scm | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm index 92034dab3c..9a08c9b8b4 100644 --- a/guix/scripts/import/crate.scm +++ b/guix/scripts/import/crate.scm @@ -95,12 +95,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)) - (crate-recursive-import name)) + (crate-recursive-import name version) (let ((sexp (crate->guix-package name version))) (unless sexp (leave (G_ "failed to download meta-data for package '~a'~%") -- 2.24.1 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v4 1/6] gnu: added new function, find-packages-by-name*/direct 2019-12-20 18:37 ` Martin Becze @ 2019-12-27 18:38 ` Ludovic Courtès 2020-01-18 16:40 ` [bug#38408] [PATCH v6] Semantic version aware recusive importer for crates Martin Becze 0 siblings, 1 reply; 107+ messages in thread From: Ludovic Courtès @ 2019-12-27 18:38 UTC (permalink / raw) To: Martin Becze; +Cc: 38408 Hi Martin, Sorry for the late reply. Martin Becze <mjbecze@riseup.net> skribis: >> Providing an explicit cache bypassing method also sounds worrying to me: >> the cache is supposed to be transparent and semantics-preserving. >> >> More generally, I think adding new features to an importer shouldn’t >> require modifications in this area, as a matter of separating concerns. >> >> WDYT? >> >> Thanks, >> Ludo’. > > yes I agree, I removed that in the last version! Which also rebases off > the new topological sort procedure. I'll attach the latest patches here, > in case you missed it. Thanks! > From eeffdf569c4d7fbfd843e0b48404b6a2f3d46343 Mon Sep 17 00:00:00 2001 > From: Martin Becze <mjbecze@riseup.net> > Date: Mon, 16 Dec 2019 17:08:16 -0500 > Subject: [PATCH v5 1/4] guix: import: added recusive-import-semver > > * guix/import/utils.scm (recusive-import-semver): New Varible > * guix/import/utils.scm (package->definition)[arguments]: Add append-verions option [...] > +(define* (recursive-import-semver #:key > + name > + (range "*") > + name->metadata > + metadata->package > + metadata-versions > + package-dependencies > + dependency-name > + dependency-range > + guix-name > + make-sexp) > + "Generates a list of package expressions for the dependencies of the given > +NAME and version RANGE. The dependencies will be resolved using semantic versioning. > +This procedure makes the assumption that most package repositories will, for a > +given package provide some <metadata> on that package that includes what > +versions of the package that are available and a list of dependencies for each > +version. Dependencies are assumed to be composed of a NAME, a semantic RANGE and > +other data. > + > +This procedure takes the following keys: > + NAME - The name of the package to import > + RANGE - The version range of the package to import > + NAME->METADATA - A procedure that takes a NAME of a package and returns that > +package's <metadata> > + METADATA->PACKAGE A procedure that takes a package's <metadata> and VERSION > +and returns the <package> for the given VERSION > + METADATA-VERSIONS A procedure that that takes a packages <metadata> and > +returns a list of version as strings that are available for the given package > + PACKAGE-DEPENDENCIES a procedure that returns a list of <dependency> given a > +<package> > + DEPENDENCY-NAME A procedure that takes a <dependency> and returns the its name > + DEPENDENCY-RANGE A procedure that takes a <dependency> and returns that > +decency's range as a string > + GUIX-NAME A procedure that take a NAME and returns the Guix version of it > + MAKE-SEXP A procedure that takes <metadata>, <package> and a list of pairs > +containing (EXPORT-NAME <dependency>), returning the package expression as an > +s-expression" As noted in my previous message, I think this interface is too complex, and since it’s used in a single importer, it would be best to have it directly in (guix import crate). If/when there’s a need to share that logic among several importers, then we can look for ways to factorize whatever needs to be factorized. In the meantime, there are probably semver-related things that could naturally to a helper (guix import semver) module, although perhaps most of that is already provided by guile-semver? > + (define-record-type <node-dependency> Also, as a rule of thumb, we wouldn’t want to duplicate these data types and related code. WDYT? Thanks, Ludo’. ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v6] Semantic version aware recusive importer for crates 2019-12-27 18:38 ` Ludovic Courtès @ 2020-01-18 16:40 ` Martin Becze 0 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2020-01-18 16:40 UTC (permalink / raw) To: Ludovic Courtès; +Cc: 38408 [-- Attachment #1.1: Type: text/plain, Size: 4265 bytes --] okkkie! finally got this rewote! Patches attached. > As noted in my previous message, I think this interface is too > complex, and since it’s used in a single importer, it would be best > to have it directly in (guix import crate). This is now done! > In the meantime, there are probably semver-related things that could > naturally to a helper (guix import semver) module, although perhaps > most of that is already provided by guile-semver? guile-semver is pretty easy to work with so I didn't need to use many helpers. The one I did use I think I will try to submit to guile-semver itself. On 12/27/19 1:38 PM, Ludovic Courtès wrote: > Hi Martin, > > Sorry for the late reply. > > Martin Becze <mjbecze@riseup.net> skribis: > >>> Providing an explicit cache bypassing method also sounds >>> worrying to me: the cache is supposed to be transparent and >>> semantics-preserving. >>> >>> More generally, I think adding new features to an importer >>> shouldn’t require modifications in this area, as a matter of >>> separating concerns. >>> >>> WDYT? >>> >>> Thanks, Ludo’. >> >> yes I agree, I removed that in the last version! Which also >> rebases off the new topological sort procedure. I'll attach the >> latest patches here, in case you missed it. > > Thanks! > >> From eeffdf569c4d7fbfd843e0b48404b6a2f3d46343 Mon Sep 17 00:00:00 >> 2001 From: Martin Becze <mjbecze@riseup.net> Date: Mon, 16 Dec >> 2019 17:08:16 -0500 Subject: [PATCH v5 1/4] guix: import: added >> recusive-import-semver >> >> * guix/import/utils.scm (recusive-import-semver): New Varible * >> guix/import/utils.scm (package->definition)[arguments]: Add >> append-verions option > > [...] > >> +(define* (recursive-import-semver #:key + name + (range "*") + >> name->metadata + metadata->package + metadata-versions + >> package-dependencies + dependency-name + dependency-range + >> guix-name + make-sexp) + "Generates a list of package expressions >> for the dependencies of the given +NAME and version RANGE. The >> dependencies will be resolved using semantic versioning. +This >> procedure makes the assumption that most package repositories will, >> for a +given package provide some <metadata> on that package that >> includes what +versions of the package that are available and a >> list of dependencies for each +version. Dependencies are assumed to >> be composed of a NAME, a semantic RANGE and +other data. + +This >> procedure takes the following keys: + NAME - The name of the >> package to import + RANGE - The version range of the package to >> import + NAME->METADATA - A procedure that takes a NAME of a >> package and returns that +package's <metadata> + METADATA->PACKAGE >> A procedure that takes a package's <metadata> and VERSION +and >> returns the <package> for the given VERSION + METADATA-VERSIONS A >> procedure that that takes a packages <metadata> and +returns a >> list of version as strings that are available for the given package >> + PACKAGE-DEPENDENCIES a procedure that returns a list of >> <dependency> given a +<package> + DEPENDENCY-NAME A procedure >> that takes a <dependency> and returns the its name + >> DEPENDENCY-RANGE A procedure that takes a <dependency> and returns >> that +decency's range as a string + GUIX-NAME A procedure that >> take a NAME and returns the Guix version of it + MAKE-SEXP A >> procedure that takes <metadata>, <package> and a list of pairs >> +containing (EXPORT-NAME <dependency>), returning the package >> expression as an +s-expression" > > As noted in my previous message, I think this interface is too > complex, and since it’s used in a single importer, it would be best > to have it directly in (guix import crate). > > If/when there’s a need to share that logic among several importers, > then we can look for ways to factorize whatever needs to be > factorized. > > In the meantime, there are probably semver-related things that could > naturally to a helper (guix import semver) module, although perhaps > most of that is already provided by guile-semver? > >> + (define-record-type <node-dependency> > > Also, as a rule of thumb, we wouldn’t want to duplicate these data > types and related code. > > WDYT? > > Thanks, Ludo’. [-- Attachment #1.2: Type: text/html, Size: 5400 bytes --] [-- Attachment #2: v6-0001-guix-import-recursive-import-Allow-for-version-nu.patch --] [-- Type: text/x-patch, Size: 16714 bytes --] From 7747d27ed32069acb193b3811b30a5a3cc8cfd5b Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Sat, 18 Jan 2020 05:05:03 -0500 Subject: [PATCH v6 1/2] guix: import: (recursive-import) Allow for version numbers * guix/import/utils.scm (package->definition) [arguments] added optional `append-version?` * guix/import/utils.scm (recursive-import) [arguments] added key `version` and moved `repo` to be a key * tests/import-utils.scm * guix/import/cran.scm (cran->guix-package) [argument]: change `repo` to a key * guix/import/cran.scm (cran-recursive-import) [argument]: change `repo` to a key * guix/scripts/import/cran.scm: change `repo` to a key * guix/import/elpa.scm (elpa->guix-pakcage) [argumnets]: change `repo` to a key * guix/import/elpa.scm (elpa-recursive-import) [argumnets]: change `repo` to a key * guix/scripts/import/elpa.scm: change `repo` to a key * guix/import/gem.scm (gem->guix-package) [arguments]: change `repo` to a key * guix/import/gem.scm (recursive-import) [arguments]: change `repo` to a key * guix/import/opam.scm (opam-recurive-import) [arguments]: change `repo` to a key * guix/import/pypi.scm (pypi-recursive-import) [arguments]: change `repo` to a key * guix/import/stackage.scm (stackage-recursive-import) [arguments]: change `repo` to a key --- 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 | 57 +++++++++++++++++++++++------------- guix/scripts/import/cran.scm | 5 ++-- guix/scripts/import/elpa.scm | 4 ++- tests/import-utils.scm | 8 +++-- 10 files changed, 69 insertions(+), 40 deletions(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index bcb37ed250..9e05dfcba8 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -506,7 +507,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))) @@ -521,8 +522,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 <beffa@fbengineering.ch> ;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -245,7 +246,7 @@ type '<elpa-package>'." (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 '<elpa-package>'." (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 0bf9ff2552..e744d9e69d 100644 --- a/guix/import/gem.scm +++ b/guix/import/gem.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -117,7 +118,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 ((package (rubygems-fetch package-name))) @@ -201,6 +202,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 394415fdd4..87c823a98c 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 <julien@lepiller.eu> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 354cae9c4c..f0702d6403 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -415,8 +416,8 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." description license)))))))) (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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 d17d400ddf..59430d3e66 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 @@ -258,13 +260,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) @@ -399,32 +403,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 <node> - (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 lookup-node - (remove exists? + (map (lambda (name-version) + (apply lookup-node name-version)) + (remove (lambda (name-version) + (apply exists? name-version)) (node-dependencies node)))) - node-name))) + (lambda (node) + (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 <bavier@member.fsf.org> ;;; Copyright © 2015, 2017, 2019 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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/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 <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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.0 [-- Attachment #3: v6-0002-guix-import-crate-Use-semver-to-resovle-module-ve.patch --] [-- Type: text/x-patch, Size: 28034 bytes --] From a405e3ffdf2716b9920f6b74e4690c9b7731f67a Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Sat, 18 Jan 2020 10:44:18 -0500 Subject: [PATCH v6 2/2] guix: import: crate: Use semver to resovle module versions * guix/import/crate.scm (make-crate-sexp): formatting, added '#:skip-build?' to build system args; added package definition geneation * guix/import/crate.scm (crate->guix-package): [arguments] moved `verions` to a key. Use semver to resolve the correct module versions * guix/import/crate.scm (crate-name->package0name): [arguments] add #:optional `version` arguement * guix/scripts/import/crate.scm remove package definition generation; changed `version` to a key * tests/crate.scm: added version data to (recursuve-import) test --- guix/import/crate.scm | 140 +++++++++------- guix/scripts/import/crate.scm | 11 +- tests/crate.scm | 290 +++++++++++++++++++--------------- tests/elpa.scm | 3 +- 4 files changed, 258 insertions(+), 186 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 57823c3639..6847a7046b 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 <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -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) @@ -35,9 +36,12 @@ #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (json) + #:use-module (semver) + #:use-module (semver ranges) #: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,7 +90,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 @@ -105,6 +109,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 <crate-dependency> records of VERSION, a <crate-version>." @@ -150,34 +156,40 @@ 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 - cargo-development-inputs)) + (cargo-inputs + (map + (lambda (name-version) + (apply crate-name->package-name name-version)) cargo-inputs)) + (cargo-development-inputs + (map + (lambda (name-version) + (apply crate-name->package-name name-version)) 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 + (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 `(#:skip-build? #t) + (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)) + (home-page ,(match home-page + (() "") + (_ home-page))) + (synopsis ,synopsis) + (description ,(beautify-description description)) + (license ,(match license + (() #f) + ((license) license) + (_ `(list ,@license))))))) + (close-port port) + (package->definition pkg #t))) (define (string->license string) (filter-map (lambda (license) @@ -188,37 +200,60 @@ 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)) + (mem-lookup-crate crate-name)) (define version-number (or version (crate-latest-version crate))) - (define version* + (define (find-version crate range) + "finds the a vesion of a crate that fulfils the semver <range>" (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 (mem-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<? name))))) + (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<?))) + (let* ((dependencies (crate-version-dependencies version*)) + (dep-crates dev-dep-crates (partition normal-dependency? dependencies)) + (cargo-inputs (sort-map-deps dep-crates)) + ;; for now we are skipping the resolution of the development inputs + ;; since most crates are libaries and we only want to test at the + ;; app level. This probably should be parameterized though. + (cargo-development-inputs '())) (values (make-crate-sexp #:name crate-name #:version (crate-version-number version*) @@ -230,15 +265,12 @@ latest version of CRATE-NAME." #:description (crate-description crate) #:license (and=> (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) @@ -252,8 +284,11 @@ latest version of CRATE-NAME." (match parts ((name _ ...) name)))) -(define (crate-name->package-name name) - (string-append "rust-" (string-join (string-split name #\_) "-"))) +(define* (crate-name->package-name name #:optional version) + (let ((name (guix-name "rust-" name))) + (if version + (string-append name "-" version) + name))) \f ;;; @@ -288,4 +323,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 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 <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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))))) 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 <beffa@fbengineering.ch> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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") -- 2.25.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v4 2/6] gnu: added new procedure, recusive-import-semver 2019-12-10 19:23 ` [bug#38408] [PATCH v4 0/6] Semantic version aware recusive importer for crates Martin Becze 2019-12-10 19:23 ` [bug#38408] [PATCH v4 1/6] gnu: added new function, find-packages-by-name*/direct Martin Becze @ 2019-12-10 19:23 ` Martin Becze 2019-12-19 22:07 ` Ludovic Courtès 2019-12-10 19:23 ` [bug#38408] [PATCH v4 3/6] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test Martin Becze ` (3 subsequent siblings) 5 siblings, 1 reply; 107+ messages in thread From: Martin Becze @ 2019-12-10 19:23 UTC (permalink / raw) To: 38408; +Cc: Martin Becze * gnu/packages.scm (recusive-import-semver): New Procedure * gnu/packages.scm (package->definition)[arguments]: New argument, "latest" * tests/import-utils.scm: tests for recusive-import-semver --- guix/import/utils.scm | 181 +++++++++++++++++++++++++++++++++++++++-- tests/import-utils.scm | 162 ++++++++++++++++++++++++++++++++++++ 2 files changed, 336 insertions(+), 7 deletions(-) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 4694b6e7ef..6932614f8e 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -32,6 +33,7 @@ #:use-module (guix discovery) #:use-module (guix build-system) #:use-module (guix gexp) + #:use-module (guix memoization) #:use-module (guix store) #:use-module (guix download) #:use-module (gnu packages) @@ -43,6 +45,8 @@ #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-41) + #:use-module (semver) + #:use-module (semver ranges) #:export (factorize-uri flatten @@ -69,7 +73,8 @@ guix-name - recursive-import)) + recursive-import + recursive-import-semver)) (define (factorize-uri uri version) "Factorize URI, a package tarball URI as a string, such that any occurrences @@ -257,13 +262,15 @@ package definition." ((package-inputs ...) `((native-inputs (,'quasiquote ,package-inputs)))))) -(define (package->definition guix-package) +(define* (package->definition guix-package #:optional (latest #t)) (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 latest + name + (string-append name "-" version))) ,guix-package)))) (define (build-system-modules) @@ -414,3 +421,163 @@ dependencies." step ;; initial state (step initial-state))) + +(define* (recursive-import-semver #:key name + (version #f) + name->metadata + metadata->package + metadata-versions + package-dependencies + dependency-name + dependency-range + guix-name + make-sexp) + "Generates a stream of package expressions for the dependencies of the given +NAME and VERSION. The dependencies will be resolved using semantic versioning. +This procedure makes the assumption that most package repositories will, for a +given package provide some <metadata> on that package that includes what +versions of the package that are available and a list of dependencies for each +version. Dependencies are assumed to be composed of a NAME, a semantic RANGE and +other data. + +This procedure takes the following keys: + NAME - The name of the package to import + VERSION - The version of the package to import + NAME->METADATA - A procedure that takes a NAME of a package and returns that +package's <metadata> + METADATA->PACKAGE A procedure that takes a package's <metadata> and VERSION +and returns the <package> for the given VERSION + METADATA-VERSIONS A procedure that that takes a packages <metadata> and +returns a list of version as strings that are available for the given package + PACKAGE-DEPENDENCIES a procedure that returns a list of <dependency> given a +<package> + DEPENDENCY-NAME A procedure that takes a <dependency> and returns the its name + DEPENDENCY-RANGE A procedure that takes a <dependency> and returns that +decency's range as a string + GUIX-NAME A procedure that take a NAME and returns the Guix version of it + MAKE-SEXP A procedure that takes <metadata>, <package> and a list of pairs +containing (EXPORT-NAME <dependency>), returning the package expression as an +s-expression" + (define mem-name->metadata (memoize name->metadata)) + + (define (latest? versions version) + (equal? (car versions) version)) + + (define (sorted-versions metadata) + (sort (metadata-versions metadata) version>?)) + + (define (name->versions name) + (sorted-versions (mem-name->metadata name))) + + (define (semver-range-contains-string? range version) + (semver-range-contains? range + (string->semver version))) + + (define (guix-export-name name version) + (let ((versions (name->versions name)) + (name (guix-name name))) + (if (latest? versions version) + name + (string-append name "-" version)))) + + ;; checks to see if we already defined or want to define a dep + (define (find-known name range known) + (match + (find + (match-lambda ((dep-name version) + (and + (string=? dep-name name) + (semver-range-contains-string? range version)))) + known) + + (#f #f) + ((name version) (list (guix-export-name name version) version #f))) + ) + + ;; searches searches for a package in guix + (define (find-locally name range) + (match + (find + (match-lambda ((_ _ package) + (semver-range-contains-string? + range + (package-version package)))) + (find-packages-by-name*/direct (guix-name name))) + (#f #f) + ((_ export-symbol package) (list + (symbol->string export-symbol) + (package-version package) #f)))) + + ;; searches for a package in some external repo + (define (find-remote name range) + (let* ((versions (name->versions name)) + (version (find + (lambda (ver) + (semver-range-contains-string? range ver)) + versions)) + (export-name (guix-export-name name version))) + `(,export-name ,version #t))) + + + (define (find-dep-version dep known-deps) + (let* ((name (dependency-name dep)) + (range (string->semver-range (dependency-range dep))) + (export-name-version-needed + (or (find-known name range known-deps) + (find-locally name range) + (find-remote name range)))) + `(,name ,@export-name-version-needed ,dep) + )) + + (define (make-package-definition name version known-deps) + (let* ((metadata (mem-name->metadata name)) + (versions (sorted-versions metadata)) + (package (metadata->package metadata version)) + (deps (map (lambda (dep) + (find-dep-version dep known-deps)) + (package-dependencies package))) + (sexp + (make-sexp metadata package + (map + (match-lambda ((_ export-symbol _ _ dep) + (list export-symbol dep))) + deps)))) + (values + (package->definition sexp (latest? versions version)) + (filter-map + (match-lambda ((name _ version need? dep) + (if need? + (list name version) + #f))) + deps)))) + + (define initial-state + (list #f + (list + ;; packages to find + (list name (if version + version + (car (name->versions name))))) + ;; packages that have been found + (list))) + + (define (step state) + (match state + ((prev ((next-name next-version) . rest) done) + (receive (package dependencies) + (make-package-definition next-name next-version + (append done rest `((,next-name ,next-version)))) + (list + package + (append rest dependencies) + (cons (list next-name next-version) done)))) + ((prev '() done) + (list #f '() done)))) + + (stream-unfold + ;; map: produce a stream element + (match-lambda ((latest queue done) latest)) + ;; predicate + (match-lambda ((latest queue done) latest)) + step + (step initial-state))) diff --git a/tests/import-utils.scm b/tests/import-utils.scm index c3ab25d788..4ed3a5e1da 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 <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2016 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,6 +25,10 @@ #:use-module (guix packages) #:use-module (guix build-system) #:use-module (gnu packages) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-41) #:use-module (srfi srfi-64)) (test-begin "import-utils") @@ -120,4 +125,161 @@ ("license" . #f)))) (package-native-inputs (alist->package meta)))) +(define-record-type <metadata> + (make-metadata name versions) + metadata? + (name metadata-name) + (versions metadata-versions)) + +(define-record-type <package> + (make-package version dependencies) + package? + (version package-version) + (dependencies package-dependencies)) + +(define-record-type <dependency> + (make-dependency name range) + dependency? + (name dependency-name) + (range dependency-range)) + +(define (metadata-semver-versions metadata) + (map (lambda (p) + (package-version p)) + (metadata-versions metadata))) + +(define (metadata->package metadata version) + (find + (lambda (package) + (equal? (package-version package) version)) + (metadata-versions metadata))) + +(define (make-sexp metadata package dependencies) + `(package + (name ,(guix-name (metadata-name metadata))) + (version ,(package-version package)) + (dependcies ,(map + (match-lambda ((public-name dep) + (list (guix-name (dependency-name dep)) public-name))) + dependencies)))) + +(define (guix-name name) + (string-append "test-" name)) + +(define packages + `(("no-deps" . (("1.0.0" . ()) ("0.1.0" . ()))) + ("one-dep" . (("1.0.0" . (("no-deps" "^1.0"))) + ("0.1.0" . (("no-deps" "^0.1.0"))))) + ("shared-dep" . (("1.0.0" . (("one-dep" "^0.1.0") + ("no-deps" "*"))))) + ("recursive" . (("1.0.0" . (("recursive" "=1.0.0"))))) + ("already-packaged" . (("1.0.0" . (("rust" "~1.28"))))))) + +(define (name->metadata name) + (let ((versions (assoc-ref packages name))) + (make-metadata name + (map + (match-lambda + ((version . deps) + (make-package version + (map + (lambda (name-range) + (apply make-dependency name-range)) + deps)))) + versions)))) + +(define* (test-recursive-importer name version #:optional (guix-name guix-name)) + (recursive-import-semver #:name name + #:version version + #:name->metadata name->metadata + #:metadata->package metadata->package + #:metadata-versions metadata-semver-versions + #:package-dependencies package-dependencies + #:dependency-name dependency-name + #:dependency-range dependency-range + #:guix-name guix-name + #:make-sexp make-sexp)) + +(test-equal "recursive import test with no dependencies" + `((define-public test-no-deps + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ())))) + (stream->list (test-recursive-importer "no-deps" "1.0.0"))) + +(test-equal "recursive import test with one dependencies" + `((define-public test-one-dep + (package + (name "test-one-dep") + (version "1.0.0") + (dependcies (("test-no-deps" "test-no-deps"))))) + (define-public test-no-deps + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ())))) + (stream->list (test-recursive-importer "one-dep" "1.0.0"))) + +(test-equal "recursive import test with recursuve dependencies" + `((define-public test-recursive + (package + (name "test-recursive") + (version "1.0.0") + (dependcies (("test-recursive" "test-recursive")))))) + (stream->list (test-recursive-importer "recursive" "1.0.0"))) + +(test-equal "recursive import test with no dependencies using an old version" + `((define-public test-no-deps-0.1.0 + (package + (name "test-no-deps") + (version "0.1.0") + (dependcies ())))) + (stream->list (test-recursive-importer "no-deps" "0.1.0"))) + +(test-equal "recursive import test with one dependencies unsing an old version" + `((define-public test-one-dep-0.1.0 + (package + (name "test-one-dep") + (version "0.1.0") + (dependcies (("test-no-deps" "test-no-deps-0.1.0"))))) + (define-public test-no-deps-0.1.0 + (package + (name "test-no-deps") + (version "0.1.0") + (dependcies ())))) + (stream->list (test-recursive-importer "one-dep" "0.1.0"))) + +(test-equal "recursive import test with with dependency that is already in the repo" + `((define-public test-already-packaged + (package (name "test-already-packaged") + (version "1.0.0") + (dependcies + (("test-rust" "rust-1.28")))))) + (stream->list (test-recursive-importer "already-packaged" "1.0.0" identity))) + +(test-equal "shared dependencies" + `((define-public test-shared-dep + (package + (name "test-shared-dep") + (version "1.0.0") + (dependcies (("test-one-dep" "test-one-dep-0.1.0") + ("test-no-deps" "test-no-deps"))))) + (define-public test-one-dep-0.1.0 + (package + (name "test-one-dep") + (version "0.1.0") + (dependcies (("test-no-deps" "test-no-deps-0.1.0"))))) + (define-public test-no-deps + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ()))) + (define-public test-no-deps-0.1.0 + (package + (name "test-no-deps") + (version "0.1.0") + (dependcies())))) + (stream->list (test-recursive-importer "shared-dep" "1.0.0"))) + (test-end "import-utils") -- 2.24.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v4 2/6] gnu: added new procedure, recusive-import-semver 2019-12-10 19:23 ` [bug#38408] [PATCH v4 2/6] gnu: added new procedure, recusive-import-semver Martin Becze @ 2019-12-19 22:07 ` Ludovic Courtès 2019-12-20 18:46 ` Martin Becze 0 siblings, 1 reply; 107+ messages in thread From: Ludovic Courtès @ 2019-12-19 22:07 UTC (permalink / raw) To: Martin Becze; +Cc: 38408 Martin Becze <mjbecze@riseup.net> skribis: > * gnu/packages.scm (recusive-import-semver): New Procedure > * gnu/packages.scm (package->definition)[arguments]: New argument, "latest" ^ This is actually guix/import/utils.scm. :-) > * tests/import-utils.scm: tests for recusive-import-semver > +(define* (recursive-import-semver #:key name > + (version #f) > + name->metadata > + metadata->package > + metadata-versions > + package-dependencies > + dependency-name > + dependency-range > + guix-name > + make-sexp) That’s intimidating. :-) Since there’s currently a single user, the Crate importer, I would rather have semver-handling directly in (guix import crate). Sure we can try to write it in a way that clearly separates semver handling from Crate-specific bits, but we shouldn’t try to make it too generic at this point, IMO. WDYT? The <crate> and <crate-version> records provide the information needed to implement what you have in mind, I think. Thanks, Ludo’. ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v4 2/6] gnu: added new procedure, recusive-import-semver 2019-12-19 22:07 ` Ludovic Courtès @ 2019-12-20 18:46 ` Martin Becze 0 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2019-12-20 18:46 UTC (permalink / raw) To: Ludovic Courtès; +Cc: 38408 > Since there’s currently a single user, the Crate importer, I would > rather have semver-handling directly in (guix import crate). Sure we > can try to write it in a way that clearly separates semver handling from > Crate-specific bits, but we shouldn’t try to make it too generic at this > point, IMO. > > WDYT? I don't have strong opinion but I'm happy to write it this way! ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v4 3/6] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test. 2019-12-10 19:23 ` [bug#38408] [PATCH v4 0/6] Semantic version aware recusive importer for crates Martin Becze 2019-12-10 19:23 ` [bug#38408] [PATCH v4 1/6] gnu: added new function, find-packages-by-name*/direct Martin Becze 2019-12-10 19:23 ` [bug#38408] [PATCH v4 2/6] gnu: added new procedure, recusive-import-semver Martin Becze @ 2019-12-10 19:23 ` Martin Becze 2019-12-10 19:23 ` [bug#38408] [PATCH v4 4/6] added "#:skip-build? #t" to the output of (make-crate-sexp). Most the the packages imported will be libaries and won't need to build. The top level package will build them though Martin Becze ` (2 subsequent siblings) 5 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2019-12-10 19:23 UTC (permalink / raw) To: 38408; +Cc: Martin Becze * 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 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v4 4/6] added "#:skip-build? #t" to the output of (make-crate-sexp). Most the the packages imported will be libaries and won't need to build. The top level package will build them though. 2019-12-10 19:23 ` [bug#38408] [PATCH v4 0/6] Semantic version aware recusive importer for crates Martin Becze ` (2 preceding siblings ...) 2019-12-10 19:23 ` [bug#38408] [PATCH v4 3/6] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test Martin Becze @ 2019-12-10 19:23 ` Martin Becze 2019-12-10 19:23 ` [bug#38408] [PATCH v4 5/6] guix: crate: Depublicated dependencies Martin Becze 2019-12-10 19:23 ` [bug#38408] [PATCH v4 6/6] guix: import: recursive-import-semver: allow the range of a package to be specified when begining import Martin Becze 5 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2019-12-10 19:23 UTC (permalink / raw) To: 38408; +Cc: Martin Becze * guix/import/crate.scm (make-crate-sexp): added "#:skip-build? #t" to the output --- guix/import/crate.scm | 3 ++- tests/crate.scm | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) 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-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))) (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") -- 2.24.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v4 5/6] guix: crate: Depublicated dependencies 2019-12-10 19:23 ` [bug#38408] [PATCH v4 0/6] Semantic version aware recusive importer for crates Martin Becze ` (3 preceding siblings ...) 2019-12-10 19:23 ` [bug#38408] [PATCH v4 4/6] added "#:skip-build? #t" to the output of (make-crate-sexp). Most the the packages imported will be libaries and won't need to build. The top level package will build them though Martin Becze @ 2019-12-10 19:23 ` Martin Becze 2019-12-10 19:23 ` [bug#38408] [PATCH v4 6/6] guix: import: recursive-import-semver: allow the range of a package to be specified when begining import Martin Becze 5 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2019-12-10 19:23 UTC (permalink / raw) To: 38408; +Cc: Martin Becze * guix/import/crate.scm: (crate-version-dependencies): dedup deps --- guix/import/crate.scm | 25 ++++++++++++++++--------- 1 file changed, 16 insertions(+), 9 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 5683369b7a..535ac2d8e5 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -109,15 +109,22 @@ record or #f if it was not found." "Return the list of <crate-dependency> records of VERSION, a <crate-version>." (let* ((path (assoc-ref (crate-version-links version) "dependencies")) - (url (string-append (%crate-base-url) path))) - (match (assoc-ref (or (json-fetch url) '()) "dependencies") - ((? vector? vector) - (filter (lambda (dep) - (not (eq? (crate-dependency-kind dep) 'dev))) - (map json->crate-dependency (vector->list vector)))) - (_ - '())))) - + (url (string-append (%crate-base-url) path)) + (deps-list (match (assoc-ref (or (json-fetch url) '()) "dependencies") + ((? vector? vector) (vector->list vector)) + (_ + '()))) + ;; turn the raw list into <dependency>'s and remove dev depenedencies + (deps (filter-map (lambda (json) + (let ((dep (json->crate-dependency json))) + (if (eq? (crate-dependency-kind dep) 'dev) + #f + dep))) + deps-list))) + ;;remove duplicate dependencies + (apply lset-adjoin `(,(lambda (a b) + (string-ci=? (crate-dependency-id a) (crate-dependency-id b))) + () ,@deps)))) \f ;;; ;;; Converting crates to Guix packages. -- 2.24.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v4 6/6] guix: import: recursive-import-semver: allow the range of a package to be specified when begining import. 2019-12-10 19:23 ` [bug#38408] [PATCH v4 0/6] Semantic version aware recusive importer for crates Martin Becze ` (4 preceding siblings ...) 2019-12-10 19:23 ` [bug#38408] [PATCH v4 5/6] guix: crate: Depublicated dependencies Martin Becze @ 2019-12-10 19:23 ` Martin Becze 5 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2019-12-10 19:23 UTC (permalink / raw) To: 38408; +Cc: Martin Becze * guix/import/crate.scm (crate-recursive-import) changed param version to range * guix/import/util.scm (recursive-import-semver) changed param version to range * guix/tests/import-utils.scm added range test for (recursive-import-semver) --- guix/import/crate.scm | 5 +-- guix/import/utils.scm | 69 ++++++++++++++++++++++++------------------ tests/import-utils.scm | 15 ++++++++- 3 files changed, 57 insertions(+), 32 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 535ac2d8e5..cd9ab61cca 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -247,10 +247,11 @@ latest version of CRATE-NAME." (crate-version-dependencies version*))) (make-crate-sexp crate version* dependencies)) -(define* (crate-recursive-import name #:optional version) + +(define* (crate-recursive-import name #:optional range) (recursive-import-semver #:name name - #:version version + #:range (if range range "*") #:name->metadata lookup-crate #:metadata->package crate->crate-version #:metadata-versions crate->versions diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 6932614f8e..35d5c79286 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -422,8 +422,9 @@ dependencies." ;; initial state (step initial-state))) -(define* (recursive-import-semver #:key name - (version #f) +(define* (recursive-import-semver #:key + name + (range "*") name->metadata metadata->package metadata-versions @@ -433,7 +434,7 @@ dependencies." guix-name make-sexp) "Generates a stream of package expressions for the dependencies of the given -NAME and VERSION. The dependencies will be resolved using semantic versioning. +NAME and version RANGE. The dependencies will be resolved using semantic versioning. This procedure makes the assumption that most package repositories will, for a given package provide some <metadata> on that package that includes what versions of the package that are available and a list of dependencies for each @@ -442,7 +443,7 @@ other data. This procedure takes the following keys: NAME - The name of the package to import - VERSION - The version of the package to import + RANGE - The version range of the package to import NAME->METADATA - A procedure that takes a NAME of a package and returns that package's <metadata> METADATA->PACKAGE A procedure that takes a package's <metadata> and VERSION @@ -473,6 +474,8 @@ s-expression" (semver-range-contains? range (string->semver version))) + ;; given a name of a package and a version number this returns the export + ;; symbol that will be used (define (guix-export-name name version) (let ((versions (name->versions name)) (name (guix-name name))) @@ -518,14 +521,17 @@ s-expression" (export-name (guix-export-name name version))) `(,export-name ,version #t))) + (define (find-dep-version-by-name-range name range-string known-deps) + (let ((range (string->semver-range range-string))) + (or (find-known name range known-deps) + (find-locally name range) + (find-remote name range)))) (define (find-dep-version dep known-deps) (let* ((name (dependency-name dep)) - (range (string->semver-range (dependency-range dep))) + (range (dependency-range dep)) (export-name-version-needed - (or (find-known name range known-deps) - (find-locally name range) - (find-remote name range)))) + (find-dep-version-by-name-range name range known-deps))) `(,name ,@export-name-version-needed ,dep) )) @@ -536,12 +542,12 @@ s-expression" (deps (map (lambda (dep) (find-dep-version dep known-deps)) (package-dependencies package))) + (deps-with-export-symbol (map + (match-lambda ((_ export-symbol _ _ dep) + (list export-symbol dep))) + deps)) (sexp - (make-sexp metadata package - (map - (match-lambda ((_ export-symbol _ _ dep) - (list export-symbol dep))) - deps)))) + (make-sexp metadata package deps-with-export-symbol))) (values (package->definition sexp (latest? versions version)) (filter-map @@ -551,15 +557,12 @@ s-expression" #f))) deps)))) - (define initial-state - (list #f - (list - ;; packages to find - (list name (if version - version - (car (name->versions name))))) - ;; packages that have been found - (list))) + (define (initial-state name version) + `(#f + ;; packages to find + ,(list (list name version)) + ;; packages that have been found + ())) (define (step state) (match state @@ -573,11 +576,19 @@ s-expression" (cons (list next-name next-version) done)))) ((prev '() done) (list #f '() done)))) + + (define (create-stream initial-state) + (stream-unfold + ;; map: produce a stream element + (match-lambda ((latest queue done) latest)) + ;; predicate + (match-lambda ((latest queue done) latest)) + step + (step initial-state))) - (stream-unfold - ;; map: produce a stream element - (match-lambda ((latest queue done) latest)) - ;; predicate - (match-lambda ((latest queue done) latest)) - step - (step initial-state))) + (match (find-dep-version-by-name-range name range '()) + ((_ version #t) + (create-stream (initial-state name version))) + ;; if the initial package alread exsits then just return its export symbol + ((export-name _ #f) + (list->stream (list export-name))))) diff --git a/tests/import-utils.scm b/tests/import-utils.scm index 4ed3a5e1da..022b8f2b32 100644 --- a/tests/import-utils.scm +++ b/tests/import-utils.scm @@ -190,7 +190,7 @@ (define* (test-recursive-importer name version #:optional (guix-name guix-name)) (recursive-import-semver #:name name - #:version version + #:range version #:name->metadata name->metadata #:metadata->package metadata->package #:metadata-versions metadata-semver-versions @@ -250,6 +250,19 @@ (dependcies ())))) (stream->list (test-recursive-importer "one-dep" "0.1.0"))) +(test-equal "recursive import test with a version range" + `((define-public test-one-dep + (package + (name "test-one-dep") + (version "1.0.0") + (dependcies (("test-no-deps" "test-no-deps"))))) + (define-public test-no-deps + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ())))) + (stream->list (test-recursive-importer "one-dep" "*"))) + (test-equal "recursive import test with with dependency that is already in the repo" `((define-public test-already-packaged (package (name "test-already-packaged") -- 2.24.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] Rewrote recursive-import-semver based on topological-sort 2019-11-28 0:13 ` [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates Martin Becze ` (5 preceding siblings ...) 2019-12-10 19:23 ` [bug#38408] [PATCH v4 0/6] Semantic version aware recusive importer for crates Martin Becze @ 2019-12-16 23:30 ` Martin Becze 2020-02-04 12:18 ` [bug#38408] [PATCH v9 0/8] recursive semver crate importer! Martin Becze ` (3 subsequent siblings) 10 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2019-12-16 23:30 UTC (permalink / raw) To: 38408 [-- Attachment #1: Type: text/plain, Size: 1587 bytes --] Hello Guix, I rewrote the recursive-import-semver procedure to use the new topological-sort procedure. I also return a list instead of a stream like (recursive-import). So to recap (recursive-import-semver) imports dependency using semantic version to find the correct version of a dependency. The crate importer has also be converted to use recursive-import-semver. It will now use recursive-import-semver when "guix import crate -r" is used. You can also specify the range that you would like to import such as guix import crate -r rand@^0.6". Here is an example of the format that it will produce. (define-public rust-bincode-1.2.1 (package (name "rust-bincode") (version "1.2.1") (source (origin (method url-fetch) (uri (crate-uri "bincode" version)) (file-name (string-append name "-" version ".crate")) (sha256 (base32 "1gvxm3n67xv1874fwxmnlircdlphlk1hcw75ykrrnw9l2nky4lsp")))) (build-system cargo-build-system) (arguments `(#:skip-build? #t #:cargo-inputs (("rust-byteorder-1.3.2" ,rust-byteorder-1.3.2) ("rust-serde-1.0.103" ,rust-serde-1.0.103)))) (home-page "https://github.com/servo/bincode") (synopsis "A binary serialization / deserialization strategy that uses Serde for transforming structs into bytes and vice versa!") (description "This package provides a binary serialization / deserialization strategy that uses Serde for transforming structs into bytes and vice versa!") (license license:expat))) -Martin [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-guix-import-added-recusive-import-semver.patch --] [-- Type: text/x-diff; name=0001-guix-import-added-recusive-import-semver.patch, Size: 9438 bytes --] From eeffdf569c4d7fbfd843e0b48404b6a2f3d46343 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Mon, 16 Dec 2019 17:08:16 -0500 Subject: [PATCH 1/4] guix: import: added recusive-import-semver * guix/import/utils.scm (recusive-import-semver): New Varible * guix/import/utils.scm (package->definition)[arguments]: Add append-verions option --- guix/import/utils.scm | 168 ++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 161 insertions(+), 7 deletions(-) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index d17d400ddf..7f75f50e23 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -40,10 +41,13 @@ #:use-module (ice-9 rdelim) #:use-module (ice-9 receive) #:use-module (ice-9 regex) + #:use-module (semver) + #:use-module (semver ranges) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-71) #:export (factorize-uri flatten @@ -70,7 +74,8 @@ guix-name - recursive-import)) + recursive-import + recursive-import-semver)) (define (factorize-uri uri version) "Factorize URI, a package tarball URI as a string, such that any occurrences @@ -258,13 +263,13 @@ 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) @@ -428,3 +433,152 @@ name corresponding to the upstream name." (remove exists? (node-dependencies node)))) node-name))) + +(define* (recursive-import-semver #:key + name + (range "*") + name->metadata + metadata->package + metadata-versions + package-dependencies + dependency-name + dependency-range + guix-name + make-sexp) + "Generates a list of package expressions for the dependencies of the given +NAME and version RANGE. The dependencies will be resolved using semantic versioning. +This procedure makes the assumption that most package repositories will, for a +given package provide some <metadata> on that package that includes what +versions of the package that are available and a list of dependencies for each +version. Dependencies are assumed to be composed of a NAME, a semantic RANGE and +other data. + +This procedure takes the following keys: + NAME - The name of the package to import + RANGE - The version range of the package to import + NAME->METADATA - A procedure that takes a NAME of a package and returns that +package's <metadata> + METADATA->PACKAGE A procedure that takes a package's <metadata> and VERSION +and returns the <package> for the given VERSION + METADATA-VERSIONS A procedure that that takes a packages <metadata> and +returns a list of version as strings that are available for the given package + PACKAGE-DEPENDENCIES a procedure that returns a list of <dependency> given a +<package> + DEPENDENCY-NAME A procedure that takes a <dependency> and returns the its name + DEPENDENCY-RANGE A procedure that takes a <dependency> and returns that +decency's range as a string + GUIX-NAME A procedure that take a NAME and returns the Guix version of it + MAKE-SEXP A procedure that takes <metadata>, <package> and a list of pairs +containing (EXPORT-NAME <dependency>), returning the package expression as an +s-expression" + (define-record-type <node-dependency> + (make-node-dependency dependency version exists?) + node-dependency? + (dependency node-dependency-dependency) + (version node-dependency-version) + (exists? node-dependency-exists?)) + + (define-record-type <node> + (make-node name version metadata package dependencies) + node? + (name node-name) + (version node-version) + (metadata node-metadata) + (package node-package) + (dependencies node-dependencies)) + + (define mem-name->metadata (memoize name->metadata)) + (define mem-package-dependencies (memoize package-dependencies)) + + (define (semver-range-contains-string? range version) + (semver-range-contains? range (string->semver version))) + + (define (name+version name version) + (string-append name "-" version)) + + (define (public-name name version) + "Given a NAME and a VERSION of a package, returns the name of the +symbol used is define-public" + (guix-name (name+version name version))) + + ;; searches searches for a package in guix + (define (find-locally name range) + (match (find + (lambda (package) + (semver-range-contains-string? + range + (package-version package))) + (find-packages-by-name (guix-name name))) + (#f #f) + (package (list (package-version package) #t)))) + + ;; searches for a package in some external repo + (define (find-remote name range) + (let* ((versions (sort + (metadata-versions + (mem-name->metadata name)) + version>?)) + (version (find + (lambda (ver) + (semver-range-contains-string? range ver)) + versions))) + (list version #f))) + + (define (find-by-name-range name range) + "Given a NAME, RANGE this will return a VERSION and BOOL which repesents +whether the package has been encountered or not." + (let ((semver-range (string->semver-range range))) + (apply values + (or (find-locally name semver-range) + (find-remote name semver-range))))) + + (define (make-package-definition node) + (let* ((metadata (node-metadata node)) + (package (node-package node)) + (dependencies ;; a list of (public-name dependency) + (map (lambda (node-dep) + (let* ((dep (node-dependency-dependency node-dep)) + (ver (node-dependency-version node-dep)) + (name (dependency-name dep))) + (list (public-name name ver) dep))) + (node-dependencies node))) + (sexp (make-sexp metadata package dependencies))) + (package->definition sexp #t))) + + (define (dependency->node-dependency dep) + (let* ((name (dependency-name dep)) + (range (dependency-range dep)) + (version exists? (find-by-name-range name range))) + (make-node-dependency dep version exists?))) + + (define (name-version->node name version) + (let* ((metadata (mem-name->metadata name)) + (package (metadata->package metadata version)) + (dependencies (mem-package-dependencies package)) + (node-dependencies (map (lambda (dep) + (dependency->node-dependency dep)) + dependencies))) + (make-node name version metadata package node-dependencies))) + + (define (node-dependency->node node-dependency) + (let* ((dependency (node-dependency-dependency node-dependency)) + (name (dependency-name dependency)) + (version (node-dependency-version node-dependency))) + (name-version->node name version))) + + (let ((version exists? (find-by-name-range name range))) + (if exists? + (display + (string-append "package " (name+version name version) " alread exists - ") + (current-error-port)) + (map make-package-definition + (topological-sort (list (name-version->node name version)) + (lambda (node) + (map (lambda (dep) + (node-dependency->node dep)) + (remove node-dependency-exists? + (node-dependencies node)))) + (lambda (node) + (name+version + (node-name node) + (node-version node)))))))) -- 2.24.0 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0002-guix-import-crate-crate-recusive-import-use-recusive.patch --] [-- Type: text/x-diff; name=0002-guix-import-crate-crate-recusive-import-use-recusive.patch, Size: 23569 bytes --] From d3130d97a02f29bfe388650fe40131aa5c762f04 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Mon, 16 Dec 2019 17:33:50 -0500 Subject: [PATCH 2/4] guix: import: crate: crate-recusive-import, use recusive-import-semver * guix/import/crate.scm (crate-recusive-import): use recusive-import-semver * guix/import/crate.scm (make-crate-sexp)[argumnets]: use <crate> and <version> * guix/import/crate.scm (crate-version-dependencies): dedup dependencies * guix/test/crate.scm: updated test --- guix/import/crate.scm | 175 +++++++++++++++++-------------- tests/crate.scm | 232 ++++++++++++++++++++++++------------------ 2 files changed, 229 insertions(+), 178 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 4c3f8000d0..3e5b022873 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 @@ -108,13 +109,22 @@ record or #f if it was not found." "Return the list of <crate-dependency> records of VERSION, a <crate-version>." (let* ((path (assoc-ref (crate-version-links version) "dependencies")) - (url (string-append (%crate-base-url) path))) - (match (assoc-ref (or (json-fetch url) '()) "dependencies") - ((? vector? vector) - (map json->crate-dependency (vector->list vector))) - (_ - '())))) - + (url (string-append (%crate-base-url) path)) + (deps-list (match (assoc-ref (or (json-fetch url) '()) "dependencies") + ((? vector? vector) (vector->list vector)) + (_ + '()))) + ;; turn the raw list into <dependency>'s and remove dev depenedencies + (deps (filter-map (lambda (json) + (let ((dep (json->crate-dependency json))) + (if (eq? (crate-dependency-kind dep) 'dev) + #f + dep))) + deps-list))) + ;;remove duplicate dependencies + (apply lset-adjoin `(,(lambda (a b) + (string-ci=? (crate-dependency-id a) (crate-dependency-id b))) + () ,@deps)))) \f ;;; ;;; Converting crates to Guix packages. @@ -141,42 +151,55 @@ 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))))) + + (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 `(#:skip-build? #t) + (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 (string->license string) (filter-map (lambda (license) @@ -187,15 +210,24 @@ and LICENSE." 'unknown-license!))) (string-split string (string->char-set " /")))) +(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 (normal-dependency? dependency) - (eq? (crate-dependency-kind dependency) 'normal)) - (define crate (lookup-crate crate-name)) @@ -204,38 +236,28 @@ 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)) + + (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)) - (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 (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 range) + (recursive-import-semver + #:name name + #:range (if range range "*") + #: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." @@ -284,4 +306,3 @@ latest version of CRATE-NAME." (description "Updater for crates.io packages") (pred crate-package?) (latest latest-release))) - diff --git a/tests/crate.scm b/tests/crate.scm index 61933a8de8..42c94b9996 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -56,6 +57,7 @@ { \"crate_id\": \"bar\", \"kind\": \"normal\", + \"req\": \"1\" } ] }") @@ -88,18 +90,22 @@ { \"crate_id\": \"intermediate-1\", \"kind\": \"normal\", + \"req\": \"1\" }, { \"crate_id\": \"intermediate-2\", \"kind\": \"normal\", + \"req\": \"1\" } { \"crate_id\": \"leaf-alice\", \"kind\": \"normal\", + \"req\": \"1\" }, { \"crate_id\": \"leaf-bob\", \"kind\": \"normal\", + \"req\": \"1\" }, ] }") @@ -132,14 +138,17 @@ { \"crate_id\": \"intermediate-2\", \"kind\": \"normal\", + \"req\": \"1\" }, { \"crate_id\": \"leaf-alice\", \"kind\": \"normal\", + \"req\": \"1\" }, { \"crate_id\": \"leaf-bob\", \"kind\": \"normal\", + \"req\": \"1\" } ] }") @@ -172,6 +181,7 @@ { \"crate_id\": \"leaf-bob\", \"kind\": \"normal\", + \"req\": \"1\" }, ] }") @@ -268,14 +278,15 @@ ('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))))) ('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") @@ -335,107 +346,126 @@ ("https://crates.io/api/v1/crates/leaf-bob/1.0.0/dependencies" (open-input-string test-leaf-bob-dependencies)) (_ (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-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 ".crate")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'cargo-build-system) + ('arguments + ('quasiquote + ('#:skip-build? #t + '#:cargo-inputs (("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)))) + ('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 ".crate")) + ('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-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 ".crate")) + ('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 ".crate")) + ('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-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 ".crate")) + ('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.24.0 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #4: 0003-guix-tests-added-tests-for-recursive-import-semver.patch --] [-- Type: text/x-diff; name=0003-guix-tests-added-tests-for-recursive-import-semver.patch, Size: 7375 bytes --] From 5495834ca375186912eeed40c7c8ce96254c36b3 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Mon, 16 Dec 2019 17:46:47 -0500 Subject: [PATCH 3/4] guix: tests: added tests for recursive-import-semver * guix/tests/import-utils.scm: tests for recursive-import-semver --- tests/import-utils.scm | 177 ++++++++++++++++++++++++++++++++++++++++- 1 file changed, 175 insertions(+), 2 deletions(-) diff --git a/tests/import-utils.scm b/tests/import-utils.scm index 87dda3238f..2ee81386ec 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 <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2016 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,8 +25,10 @@ #:use-module (guix packages) #:use-module (guix build-system) #:use-module (gnu packages) - #:use-module (srfi srfi-64) - #:use-module (ice-9 match)) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-64)) (test-begin "import-utils") @@ -141,4 +144,174 @@ ("license" . #f)))) (package-native-inputs (alist->package meta)))) +(define-record-type <metadata> + (make-metadata name versions) + metadata? + (name metadata-name) + (versions metadata-versions)) + +(define-record-type <package> + (make-package version dependencies) + package? + (version package-version) + (dependencies package-dependencies)) + +(define-record-type <dependency> + (make-dependency name range) + dependency? + (name dependency-name) + (range dependency-range)) + +(define (metadata-semver-versions metadata) + (map (lambda (p) + (package-version p)) + (metadata-versions metadata))) + +(define (metadata->package metadata version) + (find + (lambda (package) + (equal? (package-version package) version)) + (metadata-versions metadata))) + +(define (make-sexp metadata package dependencies) + `(package + (name ,(guix-name (metadata-name metadata))) + (version ,(package-version package)) + (dependcies ,(map + (match-lambda ((public-name dep) + (list (guix-name (dependency-name dep)) public-name))) + dependencies)))) + +(define (guix-name name) + (string-append "test-" name)) + +(define packages + `(("no-deps" . (("1.0.0" . ()) ("0.1.0" . ()))) + ("one-dep" . (("1.0.0" . (("no-deps" "^1.0"))) + ("0.1.0" . (("no-deps" "^0.1.0"))))) + ("shared-dep" . (("1.0.0" . (("one-dep" "^0.1.0") + ("no-deps" "*"))))) + ("recursive" . (("1.0.0" . (("recursive" "=1.0.0"))))) + ("already-packaged" . (("1.0.0" . (("rust" "~1.28"))))))) + +(define (name->metadata name) + (let ((versions (assoc-ref packages name))) + (make-metadata name + (map + (match-lambda + ((version . deps) + (make-package version + (map + (lambda (name-range) + (apply make-dependency name-range)) + deps)))) + versions)))) + +(define* (test-recursive-importer name version #:optional (guix-name guix-name)) + (recursive-import-semver #:name name + #:range version + #:name->metadata name->metadata + #:metadata->package metadata->package + #:metadata-versions metadata-semver-versions + #:package-dependencies package-dependencies + #:dependency-name dependency-name + #:dependency-range dependency-range + #:guix-name guix-name + #:make-sexp make-sexp)) + +(test-equal "recursive import test with no dependencies" + `((define-public test-no-deps-1.0.0 + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ())))) + (test-recursive-importer "no-deps" "1.0.0")) + +(test-equal "recursive import test with one dependencies" + `((define-public test-no-deps-1.0.0 + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ()))) + (define-public test-one-dep-1.0.0 + (package + (name "test-one-dep") + (version "1.0.0") + (dependcies (("test-no-deps" "test-no-deps-1.0.0")))))) + (test-recursive-importer "one-dep" "1.0.0")) + +(test-equal "recursive import test with recursuve dependencies" + `((define-public test-recursive-1.0.0 + (package + (name "test-recursive") + (version "1.0.0") + (dependcies (("test-recursive" "test-recursive-1.0.0")))))) + (test-recursive-importer "recursive" "1.0.0")) + +(test-equal "recursive import test with no dependencies using an old version" + `((define-public test-no-deps-0.1.0 + (package + (name "test-no-deps") + (version "0.1.0") + (dependcies ())))) + (test-recursive-importer "no-deps" "0.1.0")) + +(test-equal "recursive import test with one dependencies unsing an old version" + `((define-public test-no-deps-0.1.0 + (package + (name "test-no-deps") + (version "0.1.0") + (dependcies ()))) + (define-public test-one-dep-0.1.0 + (package + (name "test-one-dep") + (version "0.1.0") + (dependcies (("test-no-deps" "test-no-deps-0.1.0")))))) + (test-recursive-importer "one-dep" "0.1.0")) + +(test-equal "recursive import test with a version range" + `((define-public test-no-deps-1.0.0 + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ()))) + (define-public test-one-dep-1.0.0 + (package + (name "test-one-dep") + (version "1.0.0") + (dependcies (("test-no-deps" "test-no-deps-1.0.0")))))) + (test-recursive-importer "one-dep" "*")) + +(test-equal "recursive import test with with dependency that is already in the repo" + `((define-public test-already-packaged-1.0.0 + (package (name "test-already-packaged") + (version "1.0.0") + (dependcies + (("test-rust" "rust-1.28.0")))))) + (test-recursive-importer "already-packaged" "1.0.0" identity)) + +(test-equal "shared dependencies" + `((define-public test-no-deps-1.0.0 + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ()))) + (define-public test-no-deps-0.1.0 + (package + (name "test-no-deps") + (version "0.1.0") + (dependcies ()))) + (define-public test-one-dep-0.1.0 + (package + (name "test-one-dep") + (version "0.1.0") + (dependcies (("test-no-deps" "test-no-deps-0.1.0"))))) + (define-public test-shared-dep-1.0.0 + (package + (name "test-shared-dep") + (version "1.0.0") + (dependcies (("test-one-dep" "test-one-dep-0.1.0") + ("test-no-deps" "test-no-deps-1.0.0")))))) + (test-recursive-importer "shared-dep" "1.0.0")) + (test-end "import-utils") -- 2.24.0 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #5: 0004-gnu-scripts-import-crate-Remove-define-public-genera.patch --] [-- Type: text/x-diff; name=0004-gnu-scripts-import-crate-Remove-define-public-genera.patch, Size: 1270 bytes --] From aa6aaeacb5f91508f4158999ba6e7f95e8309bed Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Mon, 16 Dec 2019 18:11:38 -0500 Subject: [PATCH 4/4] gnu: scripts: import: crate: Remove `define-public` generation from UI * guix/scripts/import/crate.scm (guix-import-crate): Remove `define-public` generation from UI --- guix/scripts/import/crate.scm | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm index 92034dab3c..9a08c9b8b4 100644 --- a/guix/scripts/import/crate.scm +++ b/guix/scripts/import/crate.scm @@ -95,12 +95,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)) - (crate-recursive-import name)) + (crate-recursive-import name version) (let ((sexp (crate->guix-package name version))) (unless sexp (leave (G_ "failed to download meta-data for package '~a'~%") -- 2.24.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 0/8] recursive semver crate importer! 2019-11-28 0:13 ` [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates Martin Becze ` (6 preceding siblings ...) 2019-12-16 23:30 ` [bug#38408] Rewrote recursive-import-semver based on topological-sort Martin Becze @ 2020-02-04 12:18 ` Martin Becze 2020-02-04 12:18 ` [bug#38408] [PATCH v9 1/8] guix: import: (recursive-import) Allow for version numbers Martin Becze ` (8 more replies) 2020-11-07 22:19 ` [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates Hartmut Goebel ` (2 subsequent siblings) 10 siblings, 9 replies; 107+ messages in thread From: Martin Becze @ 2020-02-04 12:18 UTC (permalink / raw) To: 38408; +Cc: ludo, efraim, jsoo1, Martin Becze Here is the another version of the recursive semver crate importer! And hopefully the best one so far. The first 3 commits actully implement the and add semver support. The rest are mainly ergonomics such as * triming version numbers from package name * better deduplication of dependencies * top level importing of development dependenies I think it has incorpated the feedback i got from everyone so far, but if i forgot something or if there is more to add let me know! Cheers ~Martin Martin Becze (8): guix: import: (recursive-import) Allow for version numbers guix: import: crate: Use semver to resovle module versions Added Guile-Semver as a dependency to guix guix: import: utils: allow generation of inputs to be version aware guix: import: crate: deduplicate dependencies guix: import: crate: memorize crate->guix-package guix: import: utils: trim patch version from names guix: import: parametrized importing of dev dependencies configure.ac | 7 + doc/guix.texi | 2 + gnu/packages/package-management.scm | 7 +- guix/import/cran.scm | 8 +- guix/import/crate.scm | 111 +++++++---- 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 | 79 +++++--- guix/scripts/import/cran.scm | 5 +- guix/scripts/import/crate.scm | 13 +- guix/scripts/import/elpa.scm | 4 +- tests/crate.scm | 289 ++++++++++++++++------------ tests/elpa.scm | 3 +- tests/import-utils.scm | 8 +- 17 files changed, 346 insertions(+), 217 deletions(-) -- 2.25.0 ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 1/8] guix: import: (recursive-import) Allow for version numbers 2020-02-04 12:18 ` [bug#38408] [PATCH v9 0/8] recursive semver crate importer! Martin Becze @ 2020-02-04 12:18 ` Martin Becze 2020-02-17 10:03 ` Efraim Flashner 2020-02-04 12:18 ` [bug#38408] [PATCH v9 2/8] guix: import: crate: Use semver to resovle module versions Martin Becze ` (7 subsequent siblings) 8 siblings, 1 reply; 107+ messages in thread From: Martin Becze @ 2020-02-04 12:18 UTC (permalink / raw) To: 38408; +Cc: ludo, efraim, jsoo1, Martin Becze 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 (package->definition): added optional `append-version?` * guix/import/utils.scm (recursive-import): added key `version` and moved `repo` to be a key * guix/import/cran.scm (cran->guix-package): change `repo` to a key * guix/import/cran.scm (cran-recursive-import): change `repo` to a key * guix/scripts/import/cran.scm: change `repo` to a key * guix/import/elpa.scm (elpa->guix-pakcage): change `repo` to a key * guix/import/elpa.scm (elpa-recursive-import): change `repo` to a key * guix/scripts/import/elpa.scm: change `repo` to a key * guix/import/gem.scm (gem->guix-package): change `repo` to a key * guix/import/gem.scm (recursive-import): change `repo` to a key * guix/import/opam.scm (opam-recurive-import): change `repo` to a key * guix/import/pypi.scm (pypi-recursive-import): change `repo` to a key * guix/import/stackage.scm (stackage-recursive-import): change `repo` to a key --- 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 | 57 +++++++++++++++++++++++------------- guix/scripts/import/cran.scm | 5 ++-- guix/scripts/import/elpa.scm | 4 ++- tests/elpa.scm | 3 +- tests/import-utils.scm | 8 +++-- 11 files changed, 71 insertions(+), 41 deletions(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index bcb37ed250..9e05dfcba8 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -506,7 +507,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))) @@ -521,8 +522,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 <beffa@fbengineering.ch> ;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -245,7 +246,7 @@ type '<elpa-package>'." (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 '<elpa-package>'." (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 0bf9ff2552..e744d9e69d 100644 --- a/guix/import/gem.scm +++ b/guix/import/gem.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -117,7 +118,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 ((package (rubygems-fetch package-name))) @@ -201,6 +202,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 394415fdd4..87c823a98c 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 <julien@lepiller.eu> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 354cae9c4c..f0702d6403 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -415,8 +416,8 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." description license)))))))) (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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 d17d400ddf..59430d3e66 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 @@ -258,13 +260,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) @@ -399,32 +403,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 <node> - (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 lookup-node - (remove exists? + (map (lambda (name-version) + (apply lookup-node name-version)) + (remove (lambda (name-version) + (apply exists? name-version)) (node-dependencies node)))) - node-name))) + (lambda (node) + (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 <bavier@member.fsf.org> ;;; Copyright © 2015, 2017, 2019 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 1/8] guix: import: (recursive-import) Allow for version numbers 2020-02-04 12:18 ` [bug#38408] [PATCH v9 1/8] guix: import: (recursive-import) Allow for version numbers Martin Becze @ 2020-02-17 10:03 ` Efraim Flashner 0 siblings, 0 replies; 107+ messages in thread From: Efraim Flashner @ 2020-02-17 10:03 UTC (permalink / raw) To: Martin Becze; +Cc: 38408, ludo, jsoo1 [-- Attachment #1.1: Type: text/plain, Size: 301 bytes --] The tree has moved a bit since you sent the patch, here's a copy I made that applies. -- Efraim Flashner <efraim@flashner.co.il> אפרים פלשנר GPG key = A28B F40C 3E55 1372 662D 14F7 41AA E7DC CA3D 8351 Confidentiality cannot be guaranteed on emails sent or received unencrypted [-- Attachment #1.2: 0001-guix-import-recursive-import-Allow-for-version-numbe.patch --] [-- Type: text/plain, Size: 17433 bytes --] From 72be956188ead1aa11a1e9df972ad803323041cc Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Tue, 4 Feb 2020 07:18:18 -0500 Subject: [PATCH 1/8] guix: import: (recursive-import) Allow for version numbers 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 (package->definition): added optional `append-version?` * guix/import/utils.scm (recursive-import): added key `version` and moved `repo` to be a key * guix/import/cran.scm (cran->guix-package): change `repo` to a key * guix/import/cran.scm (cran-recursive-import): change `repo` to a key * guix/scripts/import/cran.scm: change `repo` to a key * guix/import/elpa.scm (elpa->guix-pakcage): change `repo` to a key * guix/import/elpa.scm (elpa-recursive-import): change `repo` to a key * guix/scripts/import/elpa.scm: change `repo` to a key * guix/import/gem.scm (gem->guix-package): change `repo` to a key * guix/import/gem.scm (recursive-import): change `repo` to a key * guix/import/opam.scm (opam-recurive-import): change `repo` to a key * guix/import/pypi.scm (pypi-recursive-import): change `repo` to a key * guix/import/stackage.scm (stackage-recursive-import): change `repo` to a key --- guix/import/cran.scm | 8 +++-- guix/import/elpa.scm | 6 ++-- guix/import/gem.scm | 4 ++- 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, 71 insertions(+), 41 deletions(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index bcb37ed250..9e05dfcba8 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -506,7 +507,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))) @@ -521,8 +522,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 <beffa@fbengineering.ch> ;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -245,7 +246,7 @@ type '<elpa-package>'." (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 '<elpa-package>'." (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..54f158fa65 100644 --- a/guix/import/gem.scm +++ b/guix/import/gem.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -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 394415fdd4..87c823a98c 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 <julien@lepiller.eu> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 6897f42be3..abd933e2e1 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -6,6 +6,7 @@ ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -429,8 +430,8 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." description license)))))))) (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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 d17d400ddf..8c434a3eea 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 @@ -258,13 +260,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) @@ -399,32 +403,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 <node> - (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 lookup-node - (remove exists? - (node-dependencies node)))) - node-name))) + (map (lambda (name-version) + (apply lookup-node name-version)) + (remove (lambda (name-version) + (apply exists? name-version)) + (node-dependencies node)))) + (lambda (node) + (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 <bavier@member.fsf.org> ;;; Copyright © 2015, 2017, 2019 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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.0 [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 833 bytes --] ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 2/8] guix: import: crate: Use semver to resovle module versions 2020-02-04 12:18 ` [bug#38408] [PATCH v9 0/8] recursive semver crate importer! Martin Becze 2020-02-04 12:18 ` [bug#38408] [PATCH v9 1/8] guix: import: (recursive-import) Allow for version numbers Martin Becze @ 2020-02-04 12:18 ` Martin Becze 2020-02-17 14:35 ` Ludovic Courtès 2020-02-04 12:18 ` [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix Martin Becze ` (6 subsequent siblings) 8 siblings, 1 reply; 107+ messages in thread From: Martin Becze @ 2020-02-04 12:18 UTC (permalink / raw) To: 38408; +Cc: ludo, efraim, jsoo1, Martin Becze * guix/import/crate.scm (make-crate-sexp): formatting, added '#:skip-build?' to build system args; added package definition geneation * guix/import/crate.scm (crate->guix-package): Use semver to resolve the correct module versions * tests/crate.scm: added version data to (recursuve-import) test --- guix/import/crate.scm | 87 ++++++---- guix/scripts/import/crate.scm | 11 +- tests/crate.scm | 290 +++++++++++++++++++--------------- 3 files changed, 225 insertions(+), 163 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 57823c3639..84b152620c 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 <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -35,9 +35,12 @@ #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (json) + #:use-module (semver) + #:use-module (semver ranges) #: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,7 +89,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 @@ -150,9 +153,14 @@ 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 - cargo-development-inputs)) + (cargo-inputs + (map + (lambda (name-version) + (apply crate-name->package-name name-version)) cargo-inputs)) + (cargo-development-inputs + (map + (lambda (name-version) + (apply crate-name->package-name name-version)) cargo-development-inputs)) (pkg `(package (name ,guix-name) (version ,version) @@ -164,9 +172,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 +186,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 +197,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 +218,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 <range>" (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<? name))))) + (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<?))) + (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 '())) (values (make-crate-sexp #:name crate-name #:version (crate-version-number version*) @@ -230,15 +259,12 @@ latest version of CRATE-NAME." #:description (crate-description crate) #:license (and=> (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 +279,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)) \f ;;; @@ -288,4 +314,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 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 <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 2/8] guix: import: crate: Use semver to resovle module versions 2020-02-04 12:18 ` [bug#38408] [PATCH v9 2/8] guix: import: crate: Use semver to resovle module versions Martin Becze @ 2020-02-17 14:35 ` Ludovic Courtès 2020-02-17 14:57 ` Efraim Flashner 0 siblings, 1 reply; 107+ messages in thread From: Ludovic Courtès @ 2020-02-17 14:35 UTC (permalink / raw) To: Martin Becze; +Cc: 38408, efraim, jsoo1 Hi Martin & Efraim, Thinking more about it, I’m not sure I fully understand why we need to pay attention to semver here: Martin Becze <mjbecze@riseup.net> skribis: > +(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 +218,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 <range>" > (find (lambda (version) > - (string=? (crate-version-number version) > - version-number)) > + (semver-range-contains-string? > + range > + (crate-version-number version))) > (crate-versions crate))) The reason I wonder is that the HTTP API gives us rather precise dependency requirements: --8<---------------cut here---------------start------------->8--- scheme@(guix import crate)> (crate-version-dependencies (car (crate-versions (lookup-crate "blake2-rfc")))) $8 = (#<<crate-dependency> id: "arrayvec" kind: normal requirement: "^0.4.6"> #<<crate-dependency> id: "constant_time_eq" kind: normal requirement: "^0.1.0"> #<<crate-dependency> id: "data-encoding" kind: dev requirement: "^2.0.0"> #<<crate-dependency> id: "clippy" kind: normal requirement: "^0.0.41">) --8<---------------cut here---------------end--------------->8--- In the example above, the importer could “just” fetch version 0.4.6 of arrayvec, version 0.1.0 of constant_time_eq, etc., no? It’s an approximation because the caret (^) means more than just this, but hopefully it’s a good approximation. Am I missing something? Ludo’. ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 2/8] guix: import: crate: Use semver to resovle module versions 2020-02-17 14:35 ` Ludovic Courtès @ 2020-02-17 14:57 ` Efraim Flashner 2020-02-17 15:37 ` Ludovic Courtès 0 siblings, 1 reply; 107+ messages in thread From: Efraim Flashner @ 2020-02-17 14:57 UTC (permalink / raw) To: Ludovic Courtès; +Cc: 38408, jsoo1, Martin Becze [-- Attachment #1: Type: text/plain, Size: 3078 bytes --] On Mon, Feb 17, 2020 at 03:35:20PM +0100, Ludovic Courtès wrote: > Hi Martin & Efraim, > > Thinking more about it, I’m not sure I fully understand why we need to > pay attention to semver here: > > Martin Becze <mjbecze@riseup.net> skribis: > > > +(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 +218,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 <range>" > > (find (lambda (version) > > - (string=? (crate-version-number version) > > - version-number)) > > + (semver-range-contains-string? > > + range > > + (crate-version-number version))) > > (crate-versions crate))) > > The reason I wonder is that the HTTP API gives us rather precise > dependency requirements: > > --8<---------------cut here---------------start------------->8--- > scheme@(guix import crate)> (crate-version-dependencies (car (crate-versions (lookup-crate "blake2-rfc")))) > $8 = (#<<crate-dependency> id: "arrayvec" kind: normal requirement: "^0.4.6"> #<<crate-dependency> id: "constant_time_eq" kind: normal requirement: "^0.1.0"> #<<crate-dependency> id: "data-encoding" kind: dev requirement: "^2.0.0"> #<<crate-dependency> id: "clippy" kind: normal requirement: "^0.0.41">) > --8<---------------cut here---------------end--------------->8--- > > In the example above, the importer could “just” fetch version 0.4.6 of > arrayvec, version 0.1.0 of constant_time_eq, etc., no? > > It’s an approximation because the caret (^) means more than just this, > but hopefully it’s a good approximation. > > Am I missing something? > > Ludo’. Here we're looking at a minimum of 0.4.6 for arrayvec. According to here¹ we'd really want to import 0.4.12, which is the latest 0.4.x release. ¹ https://crates.io/crates/arrayvec/versions -- Efraim Flashner <efraim@flashner.co.il> אפרים פלשנר GPG key = A28B F40C 3E55 1372 662D 14F7 41AA E7DC CA3D 8351 Confidentiality cannot be guaranteed on emails sent or received unencrypted [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 833 bytes --] ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 2/8] guix: import: crate: Use semver to resovle module versions 2020-02-17 14:57 ` Efraim Flashner @ 2020-02-17 15:37 ` Ludovic Courtès 2020-02-18 8:56 ` Martin Becze 0 siblings, 1 reply; 107+ messages in thread From: Ludovic Courtès @ 2020-02-17 15:37 UTC (permalink / raw) To: Efraim Flashner; +Cc: 38408, jsoo1, Martin Becze Efraim Flashner <efraim@flashner.co.il> skribis: > On Mon, Feb 17, 2020 at 03:35:20PM +0100, Ludovic Courtès wrote: [...] >> --8<---------------cut here---------------start------------->8--- >> scheme@(guix import crate)> (crate-version-dependencies (car (crate-versions (lookup-crate "blake2-rfc")))) >> $8 = (#<<crate-dependency> id: "arrayvec" kind: normal requirement: "^0.4.6"> #<<crate-dependency> id: "constant_time_eq" kind: normal requirement: "^0.1.0"> #<<crate-dependency> id: "data-encoding" kind: dev requirement: "^2.0.0"> #<<crate-dependency> id: "clippy" kind: normal requirement: "^0.0.41">) >> --8<---------------cut here---------------end--------------->8--- >> >> In the example above, the importer could “just” fetch version 0.4.6 of >> arrayvec, version 0.1.0 of constant_time_eq, etc., no? >> >> It’s an approximation because the caret (^) means more than just this, >> but hopefully it’s a good approximation. >> >> Am I missing something? >> >> Ludo’. > > Here we're looking at a minimum of 0.4.6 for arrayvec. According to > here¹ we'd really want to import 0.4.12, which is the latest 0.4.x > release. That’s why I wrote that 0.4.6 is an approximation (probably a good one because it’s apparently known to work.) We can do something smarter, but then it’s only useful if the updater is equally smart—that is, it can update 0.4.6 to 0.4.13 whenever that version is out, knowing that blake2-rfc will still work fine. Tricky! WDYT? Ludo’. ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 2/8] guix: import: crate: Use semver to resovle module versions 2020-02-17 15:37 ` Ludovic Courtès @ 2020-02-18 8:56 ` Martin Becze 0 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2020-02-18 8:56 UTC (permalink / raw) To: Ludovic Courtès, Efraim Flashner; +Cc: 38408, jsoo1 On 2/17/20 10:37 AM, Ludovic Courtès wrote: > That’s why I wrote that 0.4.6 is an approximation (probably a good one > because it’s apparently known to work.) Just grabbing the version from the semver range would work for some ranage would break on Hyphenated ranges (1.2.3 - 2), Combining ranges (>=0.14 <16) and on the asterisk range operator (1.*.* or 2.*) Currently we are just trying to pick the most recent version that fits in the semver range. > We can do something smarter, but then it’s only useful if the updater is > equally smart—that is, it can update 0.4.6 to 0.4.13 whenever that > version is out, knowing that blake2-rfc will still work fine. Yep argeed! I would like to fix the updater as well, but i thought i should wait to send that in after this one gets in. Also it can quickly turns in to a SAT problem. I think we have two basic options though. 1) update everything to the newest possible version (easiest and this is what the importer does currently) 2) make the smallest possible dependency graph for all packages (harder, involves a SAT solver) ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-02-04 12:18 ` [bug#38408] [PATCH v9 0/8] recursive semver crate importer! Martin Becze 2020-02-04 12:18 ` [bug#38408] [PATCH v9 1/8] guix: import: (recursive-import) Allow for version numbers Martin Becze 2020-02-04 12:18 ` [bug#38408] [PATCH v9 2/8] guix: import: crate: Use semver to resovle module versions Martin Becze @ 2020-02-04 12:18 ` Martin Becze 2020-02-17 10:03 ` Efraim Flashner 2020-02-04 12:18 ` [bug#38408] [PATCH v9 4/8] guix: import: utils: allow generation of inputs to be version aware Martin Becze ` (5 subsequent siblings) 8 siblings, 1 reply; 107+ messages in thread From: Martin Becze @ 2020-02-04 12:18 UTC (permalink / raw) To: 38408; +Cc: ludo, efraim, jsoo1, Martin Becze * configure.ac: added check for guile-semver * gnu/packages/package-management.scm (guix): added guile-semver as dep --- configure.ac | 7 +++++++ doc/guix.texi | 2 ++ gnu/packages/package-management.scm | 7 +++++-- 3 files changed, 14 insertions(+), 2 deletions(-) diff --git a/configure.ac b/configure.ac index 06e86c209f..461ccaa8e7 100644 --- a/configure.ac +++ b/configure.ac @@ -118,12 +118,19 @@ if test "x$have_guile_git" != "xyes"; then AC_MSG_ERROR([Guile-Git is missing; please install it.]) fi +dnl Check for Guile-Semver +GUILE_MODULE_AVAILABLE([have_guile_semver], [(semver)]) +if test "x$have_guile_semver" != "xyes"; then + AC_MSG_ERROR([Guile-Semver is missing; please install it.]) +fi + dnl Check for Guile-JSON. GUIX_CHECK_GUILE_JSON if test "x$guix_cv_have_recent_guile_json" != "xyes"; then AC_MSG_ERROR([Guile-JSON is missing; please install it.]) fi + dnl Guile-Sqlite3 is used by the (guix store ...) modules. GUIX_CHECK_GUILE_SQLITE3 if test "x$guix_cv_have_recent_guile_sqlite3" != "xyes"; then diff --git a/doc/guix.texi b/doc/guix.texi index 956c25ba9e..8d3d5935cd 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -72,6 +72,7 @@ Copyright @copyright{} 2019 Guillaume Le Vaillant@* Copyright @copyright{} 2020 Leo Prikler@* Copyright @copyright{} 2019, 2020 Simon Tournier@* Copyright @copyright{} 2020 Wiktor Żelazny@* +Copyright @copyright{} 2020 Martin Becze@* Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -762,6 +763,7 @@ or later; @uref{https://gitlab.com/guile-git/guile-git, Guile-Git}, from August 2017 or later; @item @uref{https://savannah.nongnu.org/projects/guile-json/, Guile-JSON} 3.x; +@item @uref{https://ngyro.com/software/guile-semver.html, Guile-Semver} 0.1.x; @item @url{https://zlib.net, zlib}; @item @url{https://www.gnu.org/software/make/, GNU Make}. @end itemize diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm index 422d4f1959..c456071a87 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -11,6 +11,7 @@ ;;; Copyright © 2018, 2019 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2019, 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2019 Jonathan Brielmaier <jonathan.brielmaier@web.de> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -248,8 +249,9 @@ (ssh (assoc-ref inputs "guile-ssh")) (gnutls (assoc-ref inputs "gnutls")) (locales (assoc-ref inputs "glibc-utf8-locales")) + (semver (assoc-ref inputs "guile-semver")) (deps (list gcrypt json sqlite gnutls - git bs ssh)) + git bs ssh semver)) (effective (read-line (open-pipe* OPEN_READ @@ -322,7 +324,8 @@ ("guile-json" ,guile-json-3) ("guile-sqlite3" ,guile-sqlite3) ("guile-ssh" ,guile-ssh) - ("guile-git" ,guile-git))) + ("guile-git" ,guile-git) + ("guile-semver",guile-semver))) (home-page "https://www.gnu.org/software/guix/") (synopsis "Functional package manager for installed software packages and versions") -- 2.25.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-02-04 12:18 ` [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix Martin Becze @ 2020-02-17 10:03 ` Efraim Flashner 2020-02-17 14:36 ` Ludovic Courtès 0 siblings, 1 reply; 107+ messages in thread From: Efraim Flashner @ 2020-02-17 10:03 UTC (permalink / raw) To: Martin Becze; +Cc: 38408, ludo, jsoo1 [-- Attachment #1.1: Type: text/plain, Size: 302 bytes --] The tree has moved a bit since you sent the patch, here's a copy I made that applies -- Efraim Flashner <efraim@flashner.co.il> אפרים פלשנר GPG key = A28B F40C 3E55 1372 662D 14F7 41AA E7DC CA3D 8351 Confidentiality cannot be guaranteed on emails sent or received unencrypted [-- Attachment #1.2: 0003-Added-Guile-Semver-as-a-dependency-to-guix.patch --] [-- Type: text/plain, Size: 3737 bytes --] From 578d6f023c706df999c1b1b1bb23c9771b279857 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Tue, 4 Feb 2020 07:18:20 -0500 Subject: [PATCH 3/8] Added Guile-Semver as a dependency to guix * configure.ac: added check for guile-semver * gnu/packages/package-management.scm (guix): added guile-semver as dep Signed-off-by: Efraim Flashner <efraim@flashner.co.il> --- configure.ac | 6 ++++++ doc/guix.texi | 2 ++ gnu/packages/package-management.scm | 7 +++++-- 3 files changed, 13 insertions(+), 2 deletions(-) diff --git a/configure.ac b/configure.ac index 06e86c209f..0896c23955 100644 --- a/configure.ac +++ b/configure.ac @@ -118,6 +118,12 @@ if test "x$have_guile_git" != "xyes"; then AC_MSG_ERROR([Guile-Git is missing; please install it.]) fi +dnl Check for Guile-Semver +GUILE_MODULE_AVAILABLE([have_guile_semver], [(semver)]) +if test "x$have_guile_semver" != "xyes"; then + AC_MSG_ERROR([Guile-Semver is missing; please install it.]) +fi + dnl Check for Guile-JSON. GUIX_CHECK_GUILE_JSON if test "x$guix_cv_have_recent_guile_json" != "xyes"; then diff --git a/doc/guix.texi b/doc/guix.texi index aa50340fe2..bc6a431b4c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -74,6 +74,7 @@ Copyright @copyright{} 2019, 2020 Simon Tournier@* Copyright @copyright{} 2020 Wiktor Żelazny@* Copyright @copyright{} 2020 Damien Cassou@* Copyright @copyright{} 2020 Jakub Kądziołka@* +Copyright @copyright{} 2020 Martin Becze@* Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -764,6 +765,7 @@ or later; @uref{https://gitlab.com/guile-git/guile-git, Guile-Git}, from August 2017 or later; @item @uref{https://savannah.nongnu.org/projects/guile-json/, Guile-JSON} 3.x; +@item @uref{https://ngyro.com/software/guile-semver.html, Guile-Semver} 0.1.x; @item @url{https://zlib.net, zlib}; @item @url{https://www.gnu.org/software/make/, GNU Make}. @end itemize diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm index 09888ca9e2..2419f49184 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -11,6 +11,7 @@ ;;; Copyright © 2018, 2019 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2019, 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2019 Jonathan Brielmaier <jonathan.brielmaier@web.de> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -248,8 +249,9 @@ (ssh (assoc-ref inputs "guile-ssh")) (gnutls (assoc-ref inputs "gnutls")) (locales (assoc-ref inputs "glibc-utf8-locales")) + (semver (assoc-ref inputs "guile-semver")) (deps (list gcrypt json sqlite gnutls - git bs ssh)) + git bs ssh semver)) (effective (read-line (open-pipe* OPEN_READ @@ -322,7 +324,8 @@ ("guile-json" ,guile-json-3) ("guile-sqlite3" ,guile-sqlite3) ("guile-ssh" ,guile-ssh) - ("guile-git" ,guile-git))) + ("guile-git" ,guile-git) + ("guile-semver",guile-semver))) (home-page "https://www.gnu.org/software/guix/") (synopsis "Functional package manager for installed software packages and versions") -- 2.25.0 [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 833 bytes --] ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-02-17 10:03 ` Efraim Flashner @ 2020-02-17 14:36 ` Ludovic Courtès 2020-02-18 9:30 ` Martin Becze 0 siblings, 1 reply; 107+ messages in thread From: Ludovic Courtès @ 2020-02-17 14:36 UTC (permalink / raw) To: Efraim Flashner; +Cc: 38408, jsoo1, Martin Becze Hi, Efraim Flashner <efraim@flashner.co.il> skribis: > From 578d6f023c706df999c1b1b1bb23c9771b279857 Mon Sep 17 00:00:00 2001 > From: Martin Becze <mjbecze@riseup.net> > Date: Tue, 4 Feb 2020 07:18:20 -0500 > Subject: [PATCH 3/8] Added Guile-Semver as a dependency to guix > > * configure.ac: added check for guile-semver > * gnu/packages/package-management.scm (guix): added guile-semver as dep [...] > +dnl Check for Guile-Semver > +GUILE_MODULE_AVAILABLE([have_guile_semver], [(semver)]) > +if test "x$have_guile_semver" != "xyes"; then > + AC_MSG_ERROR([Guile-Semver is missing; please install it.]) > +fi I think a hard dependency like this is too much. I would very much prefer to deal with it similar to how we deal with Guile-Newt or Guile-Charting: a soft dependency that’s entirely optional. But I guess that also depends on what Guile-Semver is used for. I just posted a question on this topic in that thread. :-) Thanks for reviving this patch series! Ludo’. ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-02-17 14:36 ` Ludovic Courtès @ 2020-02-18 9:30 ` Martin Becze 2020-02-20 9:40 ` Ludovic Courtès 0 siblings, 1 reply; 107+ messages in thread From: Martin Becze @ 2020-02-18 9:30 UTC (permalink / raw) To: Ludovic Courtès, Efraim Flashner; +Cc: 38408, jsoo1 I'm looking at guile-charting now, and i don't understand how it is being used as a soft dependency. in guix/scripts/size.scm line 195 it is getting used with "(module-autoload!"... is that it? On 2/17/20 9:36 AM, Ludovic Courtès wrote: > Hi, > > Efraim Flashner <efraim@flashner.co.il> skribis: > >> From 578d6f023c706df999c1b1b1bb23c9771b279857 Mon Sep 17 00:00:00 2001 >> From: Martin Becze <mjbecze@riseup.net> >> Date: Tue, 4 Feb 2020 07:18:20 -0500 >> Subject: [PATCH 3/8] Added Guile-Semver as a dependency to guix >> >> * configure.ac: added check for guile-semver >> * gnu/packages/package-management.scm (guix): added guile-semver as dep > > [...] > >> +dnl Check for Guile-Semver >> +GUILE_MODULE_AVAILABLE([have_guile_semver], [(semver)]) >> +if test "x$have_guile_semver" != "xyes"; then >> + AC_MSG_ERROR([Guile-Semver is missing; please install it.]) >> +fi > > I think a hard dependency like this is too much. > > I would very much prefer to deal with it similar to how we deal with > Guile-Newt or Guile-Charting: a soft dependency that’s entirely > optional. > > But I guess that also depends on what Guile-Semver is used for. > I just posted a question on this topic in that thread. :-) > > Thanks for reviving this patch series! > > Ludo’. > ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-02-18 9:30 ` Martin Becze @ 2020-02-20 9:40 ` Ludovic Courtès 2020-02-20 16:54 ` Martin Becze 0 siblings, 1 reply; 107+ messages in thread From: Ludovic Courtès @ 2020-02-20 9:40 UTC (permalink / raw) To: Martin Becze; +Cc: 38408, Efraim Flashner, jsoo1 Hi, Martin Becze <mjbecze@riseup.net> skribis: > I'm looking at guile-charting now, and i don't understand how it is > being used as a soft dependency. in guix/scripts/size.scm line 195 it > is getting used with "(module-autoload!"... is that it? Yes, exactly. The thing is, Guile-Charting is not used at all unless one passes the ‘--map-file’ option to ‘guix size’. Ludo’. ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-02-20 9:40 ` Ludovic Courtès @ 2020-02-20 16:54 ` Martin Becze 2020-02-21 9:01 ` Ludovic Courtès 0 siblings, 1 reply; 107+ messages in thread From: Martin Becze @ 2020-02-20 16:54 UTC (permalink / raw) To: Ludovic Courtès; +Cc: 38408, Efraim Flashner, jsoo1 [-- Attachment #1: Type: text/plain, Size: 262 bytes --] Ok cool! I have tested it now. Attached is a patch that adds that behavior. Please drop the first patch and apply this one at the end. On 2/20/20 4:40 AM, Ludovic Courtès wrote: > exactly. The thing is, Guile-Charting is not used at all unless > one passes [-- Attachment #2: v9-0009-guix-import-crate-Added-guile-semver-as-a-soft-de.patch --] [-- Type: text/x-patch, Size: 1218 bytes --] From ef8f1a6365c321662248885d4c97c949c5c0a167 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Thu, 20 Feb 2020 11:49:11 -0500 Subject: [PATCH v9] guix: import: crate: Added guile-semver as a soft dep * guix/import/crate.scm Added guile-semver as a soft dep --- guix/import/crate.scm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index a370fddffe..91e38839bd 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -36,8 +36,6 @@ #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (json) - #:use-module (semver) - #:use-module (semver ranges) #:use-module (srfi srfi-1) #:use-module (srfi srfi-2) #:use-module (srfi srfi-26) @@ -94,6 +92,11 @@ 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 <crate> record or #f if it was not found." -- 2.25.1 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-02-20 16:54 ` Martin Becze @ 2020-02-21 9:01 ` Ludovic Courtès 2020-02-21 16:25 ` Martin Becze 0 siblings, 1 reply; 107+ messages in thread From: Ludovic Courtès @ 2020-02-21 9:01 UTC (permalink / raw) To: Martin Becze; +Cc: 38408, Efraim Flashner, jsoo1 Hi Martin, Martin Becze <mjbecze@riseup.net> skribis: > +(module-autoload! (current-module) > + '(semver) '(string->semver)) > +(module-autoload! (current-module) > + '(semver ranges) '(string->semver-range semver-range-contains?)) Sounds good. Could you please squash it with the commit that adds support for semver? Also, we may want to add guile-semver to ‘dependencies’ in ‘compiled-guix’ in (guix self). That way, a pulled guix will have guile-semver available, and thus ‘guix import crate’ will work out of the box. Thanks, Ludo’. ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-02-21 9:01 ` Ludovic Courtès @ 2020-02-21 16:25 ` Martin Becze 2020-02-21 16:27 ` Leo Famulari 2020-02-23 21:05 ` Martin Becze 0 siblings, 2 replies; 107+ messages in thread From: Martin Becze @ 2020-02-21 16:25 UTC (permalink / raw) To: Ludovic Courtès; +Cc: 38408, Efraim Flashner, jsoo1 [-- Attachment #1: Type: text/plain, Size: 650 bytes --] On 2/21/20 4:01 AM, Ludovic Courtès wrote: > Hi Martin, > Sounds good. Could you please squash it with the commit that adds > support for semver? Squashed and attached as v10-0002-guix-import-crate-Use-semver-to-resovle-module-v.patch > Also, we may want to add guile-semver to ‘dependencies’ in > ‘compiled-guix’ in (guix self). That way, a pulled guix will have > guile-semver available, and thus ‘guix import crate’ will work out of > the box. I added that it is attached as v10-0008-guix-self-added-guile-semver-as-a-depenedency.patch But I'm not sure how to test guix pull to see if it correctly brought in guile-semver! [-- Attachment #2: v10-0008-guix-self-added-guile-semver-as-a-depenedency.patch --] [-- Type: text/x-patch, Size: 1895 bytes --] From ee19656f5e63955e43922301f1abf32cfc629779 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Fri, 21 Feb 2020 10:41:44 -0500 Subject: [PATCH v10 8/8] guix: self: added guile-semver as a depenedency * guix/self.scm (compliled-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..c0506a0a60 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 <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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) 'guile-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 [-- Attachment #3: v10-0007-guix-import-parametrized-importing-of-dev-depend.patch --] [-- Type: text/x-patch, Size: 6471 bytes --] From 3f1d5662f75abda64fb042f2d12dd8afc5523e17 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Mon, 3 Feb 2020 16:19:49 -0500 Subject: [PATCH v10 7/8] guix: import: parametrized importing of dev dependencies This changes the behavoir of the recusive crate importer so that it will include the 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 (crate->guix-package, make-crate-sexp) <guix import crate>: added new parameter --- 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 [-- Attachment #4: v10-0006-guix-import-utils-trim-patch-version-from-names.patch --] [-- Type: text/x-patch, Size: 6656 bytes --] From 58f6c611aa4d49e9fef0ea6a0ed7125cd3942bef Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Thu, 30 Jan 2020 11:19:13 -0500 Subject: [PATCH v10 6/8] guix: import: utils: trim patch version from names * guix/import/utils.scm (package->definition): trim patch version from names * tests/crate.scm: updated the tests --- 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 c60a164271..649b9f9b85 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -273,9 +273,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 [-- Attachment #5: v10-0005-guix-import-crate-memorize-crate-guix-package.patch --] [-- Type: text/x-patch, Size: 2670 bytes --] From 6a4e13a7b16c7647fd47f3412bb27252dbd054a1 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Thu, 30 Jan 2020 11:17:00 -0500 Subject: [PATCH v10 5/8] guix: 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 dependencies. * guix/import/crate.scm (mem-crate->guix-package, mem-lookup-crate) --- 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 <crate-dependency> records of VERSION, a <crate-version>." @@ -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 [-- Attachment #6: v10-0004-guix-import-crate-deduplicate-dependencies.patch --] [-- Type: text/x-patch, Size: 917 bytes --] From f93800713be11754aba4572009c859d30256adac Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Thu, 30 Jan 2020 10:52:28 -0500 Subject: [PATCH v10 4/8] guix: import: crate: deduplicate dependencies * guix/import/crate.scm (crate-version-dependencies): deduplicate 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 [-- Attachment #7: v10-0003-guix-import-utils-allow-generation-of-inputs-to-.patch --] [-- Type: text/x-patch, Size: 3302 bytes --] From ee5d7412e0cad9bad9be3b26195cd298ed37ca30 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Mon, 27 Jan 2020 06:45:10 -0500 Subject: [PATCH v10 3/8] guix: import: utils: allow generation of inputs to be version aware * guix/import/utils.scm (package-names->package-inputs): Added the ability to handle (name version) pairs * guix/import/crate.scm (make-crate-sexp): cleaned up input field generation --- guix/import/crate.scm | 17 +++++++++-------- guix/import/utils.scm | 21 ++++++++++++++------- 2 files changed, 23 insertions(+), 15 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index d711820b81..7e61bc21b6 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -154,16 +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 - (lambda (name-version) - (apply crate-name->package-name name-version)) cargo-inputs)) - (cargo-development-inputs - (map - (lambda (name-version) - (apply crate-name->package-name name-version)) cargo-development-inputs)) + (cargo-inputs (format-inputs cargo-inputs)) + (cargo-development-inputs (format-inputs cargo-development-inputs)) (pkg `(package (name ,guix-name) (version ,version) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 8c434a3eea..c60a164271 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -233,13 +233,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)) -- 2.25.1 [-- Attachment #8: v10-0002-guix-import-crate-Use-semver-to-resovle-module-v.patch --] [-- Type: text/x-patch, Size: 24786 bytes --] From ed3365f11107556d45b189da6588e353b2ef5e46 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Tue, 4 Feb 2020 03:50:48 -0500 Subject: [PATCH v10 2/8] guix: import: crate: Use semver to resovle module versions * guix/import/crate.scm (make-crate-sexp): formatting, added '#:skip-build?' to build system args; added package definition geneation * guix/import/crate.scm (crate->guix-package): Use semver to resolve the correct module versions * guix/import/crate.scm Added guile-semver as a soft dep * tests/crate.scm: added version data to (recursuve-import) test --- guix/import/crate.scm | 90 +++++++---- guix/scripts/import/crate.scm | 11 +- tests/crate.scm | 290 +++++++++++++++++++--------------- 3 files changed, 228 insertions(+), 163 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 57823c3639..d711820b81 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 <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <crate> record or #f if it was not found." @@ -150,9 +156,14 @@ 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 - cargo-development-inputs)) + (cargo-inputs + (map + (lambda (name-version) + (apply crate-name->package-name name-version)) cargo-inputs)) + (cargo-development-inputs + (map + (lambda (name-version) + (apply crate-name->package-name name-version)) cargo-development-inputs)) (pkg `(package (name ,guix-name) (version ,version) @@ -164,9 +175,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 +189,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 +200,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 +221,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 <range>" (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<? name))))) + (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<?))) + (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 '())) (values (make-crate-sexp #:name crate-name #:version (crate-version-number version*) @@ -230,15 +262,12 @@ latest version of CRATE-NAME." #:description (crate-description crate) #:license (and=> (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 +282,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)) \f ;;; @@ -288,4 +317,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 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 <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 [-- Attachment #9: v10-0001-guix-import-recursive-import-Allow-for-version-n.patch --] [-- Type: text/x-patch, Size: 17041 bytes --] From a7b88911a9ef1348a65145027c689bae63d9a41f Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Tue, 4 Feb 2020 07:18:18 -0500 Subject: [PATCH v10 1/8] guix: import: (recursive-import) Allow for version numbers 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 (package->definition): added optional `append-version?` * guix/import/utils.scm (recursive-import): added key `version` and moved `repo` to be a key * guix/import/cran.scm (cran->guix-package): change `repo` to a key * guix/import/cran.scm (cran-recursive-import): change `repo` to a key * guix/scripts/import/cran.scm: change `repo` to a key * guix/import/elpa.scm (elpa->guix-pakcage): change `repo` to a key * guix/import/elpa.scm (elpa-recursive-import): change `repo` to a key * guix/scripts/import/elpa.scm: change `repo` to a key * guix/import/gem.scm (gem->guix-package): change `repo` to a key * guix/import/gem.scm (recursive-import): change `repo` to a key * guix/import/opam.scm (opam-recurive-import): change `repo` to a key * guix/import/pypi.scm (pypi-recursive-import): change `repo` to a key * guix/import/stackage.scm (stackage-recursive-import): change `repo` to a key --- guix/import/cran.scm | 8 +++-- guix/import/elpa.scm | 6 ++-- guix/import/gem.scm | 4 ++- 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, 71 insertions(+), 41 deletions(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index bcb37ed250..9e05dfcba8 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -506,7 +507,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))) @@ -521,8 +522,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 <beffa@fbengineering.ch> ;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -245,7 +246,7 @@ type '<elpa-package>'." (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 '<elpa-package>'." (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..54f158fa65 100644 --- a/guix/import/gem.scm +++ b/guix/import/gem.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -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 394415fdd4..87c823a98c 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 <julien@lepiller.eu> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 6897f42be3..abd933e2e1 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -6,6 +6,7 @@ ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -429,8 +430,8 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." description license)))))))) (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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 d17d400ddf..8c434a3eea 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 @@ -258,13 +260,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) @@ -399,32 +403,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 <node> - (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 <bavier@member.fsf.org> ;;; Copyright © 2015, 2017, 2019 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-02-21 16:25 ` Martin Becze @ 2020-02-21 16:27 ` Leo Famulari 2020-02-23 20:34 ` Martin Becze 2020-02-23 21:05 ` Martin Becze 1 sibling, 1 reply; 107+ messages in thread From: Leo Famulari @ 2020-02-21 16:27 UTC (permalink / raw) To: Martin Becze; +Cc: 38408, Ludovic Courtès, Efraim Flashner, jsoo1 On Fri, Feb 21, 2020 at 11:25:30AM -0500, Martin Becze wrote: > I added that it is attached as > v10-0008-guix-self-added-guile-semver-as-a-depenedency.patch > But I'm not sure how to test guix pull to see if it correctly brought in > guile-semver! You can do `guix pull --url=/home/martin/guix` with whatever your source code path is. ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-02-21 16:27 ` Leo Famulari @ 2020-02-23 20:34 ` Martin Becze 0 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2020-02-23 20:34 UTC (permalink / raw) To: Leo Famulari; +Cc: 38408, Ludovic Courtès, Efraim Flashner, jsoo1 ah thanks Leo! There is needed a probably here, ill update the patch soon. On 2/21/20 11:27 AM, Leo Famulari wrote: > On Fri, Feb 21, 2020 at 11:25:30AM -0500, Martin Becze wrote: >> I added that it is attached as >> v10-0008-guix-self-added-guile-semver-as-a-depenedency.patch >> But I'm not sure how to test guix pull to see if it correctly brought in >> guile-semver! > > You can do `guix pull --url=/home/martin/guix` with whatever your source > code path is. > ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-02-21 16:25 ` Martin Becze 2020-02-21 16:27 ` Leo Famulari @ 2020-02-23 21:05 ` Martin Becze 2020-03-11 20:20 ` Martin Becze 1 sibling, 1 reply; 107+ messages in thread From: Martin Becze @ 2020-02-23 21:05 UTC (permalink / raw) To: Ludovic Courtès; +Cc: 38408, Efraim Flashner, jsoo1 [-- Attachment #1: Type: text/plain, Size: 872 bytes --] Ok here is a correct version, I addded guile3.0-semver and used that in (guix self) instead of guile-semver. Let me know if this works! Cheers! On 2/21/20 11:25 AM, Martin Becze wrote: > > > On 2/21/20 4:01 AM, Ludovic Courtès wrote: >> Hi Martin, > >> Sounds good. Could you please squash it with the commit that adds >> support for semver? > > Squashed and attached as > v10-0002-guix-import-crate-Use-semver-to-resovle-module-v.patch > >> Also, we may want to add guile-semver to ‘dependencies’ in >> ‘compiled-guix’ in (guix self). That way, a pulled guix will have >> guile-semver available, and thus ‘guix import crate’ will work out of >> the box. > > I added that it is attached as > v10-0008-guix-self-added-guile-semver-as-a-depenedency.patch > But I'm not sure how to test guix pull to see if it correctly brought in > guile-semver! [-- Attachment #2: 0003-guix-self-added-guile-semver-as-a-depenedency.patch --] [-- Type: text/x-patch, Size: 1894 bytes --] From 7eed4dcafc4635d17e8bc7af520b6293187ef008 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Fri, 21 Feb 2020 10:41:44 -0500 Subject: [PATCH 3/3] guix: self: added guile-semver as a depenedency * guix/self.scm (compliled-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 <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 [-- Attachment #3: 0002-gnu-Add-guile3.0-semver.patch --] [-- Type: text/x-patch, Size: 1170 bytes --] From 07dccc523ff215a58558e5b1549784dc0495192f Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Sun, 23 Feb 2020 04:27:42 -0500 Subject: [PATCH 2/3] gnu: Add guile3.0-semver * gnu/packages/guile-xyz.scm --- 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 8b8a1306de..45efa44e83 100644 --- a/gnu/packages/guile-xyz.scm +++ b/gnu/packages/guile-xyz.scm @@ -23,6 +23,7 @@ ;;; Copyright © 2019 swedebugia <swedebugia@riseup.net> ;;; Copyright © 2019 Amar Singh <nly@disroot.org> ;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -2981,6 +2982,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 [-- Attachment #4: 0001-gnu-guile-semver-updated-to-0.1.1.patch --] [-- Type: text/x-patch, Size: 1203 bytes --] From 5652089496642edb3fea8d09a061bc9fc7353c33 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Sun, 23 Feb 2020 15:07:20 -0500 Subject: [PATCH 1/3] gnu: guile-semver: updated to 0.1.1 * gnu/packages/guile-xyx.scm --- gnu/packages/guile-xyz.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/guile-xyz.scm b/gnu/packages/guile-xyz.scm index 16b408900c..8b8a1306de 100644 --- a/gnu/packages/guile-xyz.scm +++ b/gnu/packages/guile-xyz.scm @@ -2960,14 +2960,14 @@ tests being run, resulting clearer and more specific output.") (define-public guile-semver (package (name "guile-semver") - (version "0.1.0") + (version "0.1.1") (source (origin (method url-fetch) (uri (string-append "https://files.ngyro.com/guile-semver/" "guile-semver-" version ".tar.gz")) (sha256 (base32 - "06b66rj7nyhr6i3dpkwvfw1xb10w2pngrsw2hxfxkznwsbh9byfz")))) + "109p4n39ln44cxvwdccf9kgb96qx54makvd2ir521ssz6wchjyag")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config) -- 2.25.1 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-02-23 21:05 ` Martin Becze @ 2020-03-11 20:20 ` Martin Becze 2020-03-21 18:35 ` Martin Becze 0 siblings, 1 reply; 107+ messages in thread From: Martin Becze @ 2020-03-11 20:20 UTC (permalink / raw) To: Ludovic Courtès; +Cc: 38408, Efraim Flashner, jsoo1 This seems stuck again. Is there anymore to do or discuss with this patch? Thanks! On 2/23/20 4:05 PM, Martin Becze wrote: > Ok here is a correct version, I addded guile3.0-semver and used that in > (guix self) instead of guile-semver. Let me know if this works! Cheers! > > On 2/21/20 11:25 AM, Martin Becze wrote: >> >> >> On 2/21/20 4:01 AM, Ludovic Courtès wrote: >>> Hi Martin, >> >>> Sounds good. Could you please squash it with the commit that adds >>> support for semver? >> >> Squashed and attached as >> v10-0002-guix-import-crate-Use-semver-to-resovle-module-v.patch >> >>> Also, we may want to add guile-semver to ‘dependencies’ in >>> ‘compiled-guix’ in (guix self). That way, a pulled guix will have >>> guile-semver available, and thus ‘guix import crate’ will work out of >>> the box. >> >> I added that it is attached as >> v10-0008-guix-self-added-guile-semver-as-a-depenedency.patch >> But I'm not sure how to test guix pull to see if it correctly brought >> in guile-semver! ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-03-11 20:20 ` Martin Becze @ 2020-03-21 18:35 ` Martin Becze 2020-03-22 19:26 ` Leo Famulari 2020-03-22 20:10 ` Leo Famulari 0 siblings, 2 replies; 107+ messages in thread From: Martin Becze @ 2020-03-21 18:35 UTC (permalink / raw) To: Ludovic Courtès; +Cc: 38408, Efraim Flashner, jsoo1 [-- Attachment #1: Type: text/plain, Size: 1233 bytes --] 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. On 3/11/20 4:20 PM, Martin Becze wrote: > This seems stuck again. Is there anymore to do or discuss with this > patch? Thanks! > > On 2/23/20 4:05 PM, Martin Becze wrote: >> Ok here is a correct version, I addded guile3.0-semver and used that >> in (guix self) instead of guile-semver. Let me know if this works! >> Cheers! >> >> On 2/21/20 11:25 AM, Martin Becze wrote: >>> >>> >>> On 2/21/20 4:01 AM, Ludovic Courtès wrote: >>>> Hi Martin, >>> >>>> Sounds good. Could you please squash it with the commit that adds >>>> support for semver? >>> >>> Squashed and attached as >>> v10-0002-guix-import-crate-Use-semver-to-resovle-module-v.patch >>> >>>> Also, we may want to add guile-semver to ‘dependencies’ in >>>> ‘compiled-guix’ in (guix self). That way, a pulled guix will have >>>> guile-semver available, and thus ‘guix import crate’ will work out of >>>> the box. >>> >>> I added that it is attached as >>> v10-0008-guix-self-added-guile-semver-as-a-depenedency.patch >>> But I'm not sure how to test guix pull to see if it correctly brought >>> in guile-semver! > > > [-- Attachment #2: v11-0009-guix-self-added-guile-semver-as-a-depenedency.patch --] [-- Type: text/x-patch, Size: 1898 bytes --] From 6b04afb3cfcc7cf6cc6a4884932e966e0fb13894 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Fri, 21 Feb 2020 10:41:44 -0500 Subject: [PATCH v11 9/9] guix: self: added guile-semver as a depenedency * guix/self.scm (compliled-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 <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 [-- Attachment #3: v11-0008-gnu-Add-guile3.0-semver.patch --] [-- Type: text/x-patch, Size: 1180 bytes --] From ba6cb8f8e34ac0ce39f14f391c94756aa53a0d10 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Sun, 23 Feb 2020 04:27:42 -0500 Subject: [PATCH v11 8/9] gnu: Add guile3.0-semver * gnu/packages/guile-xyz.scm --- 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 <swedebugia@riseup.net> ;;; Copyright © 2019, 2020 Amar Singh <nly@disroot.org> ;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 [-- Attachment #4: v11-0007-guix-import-parametrized-importing-of-dev-depend.patch --] [-- Type: text/x-patch, Size: 6471 bytes --] From 57d4347e68480f83dbf7dceb5e50fc4b05285e75 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Mon, 3 Feb 2020 16:19:49 -0500 Subject: [PATCH v11 7/9] guix: import: parametrized importing of dev dependencies This changes the behavoir of the recusive crate importer so that it will include the 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 (crate->guix-package, make-crate-sexp) <guix import crate>: added new parameter --- 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 [-- Attachment #5: v11-0006-guix-import-utils-trim-patch-version-from-names.patch --] [-- Type: text/x-patch, Size: 6656 bytes --] From 3aa7e808a243d1a72b69d8ebf0114f51c1fd1f6d Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Thu, 30 Jan 2020 11:19:13 -0500 Subject: [PATCH v11 6/9] guix: import: utils: trim patch version from names * guix/import/utils.scm (package->definition): trim patch version from names * tests/crate.scm: updated the tests --- 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 [-- Attachment #6: v11-0005-guix-import-crate-memorize-crate-guix-package.patch --] [-- Type: text/x-patch, Size: 2670 bytes --] From a1123353f0448408e1dee9008f81cf0188cfcb7f Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Thu, 30 Jan 2020 11:17:00 -0500 Subject: [PATCH v11 5/9] guix: 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 dependencies. * guix/import/crate.scm (mem-crate->guix-package, mem-lookup-crate) --- 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 <crate-dependency> records of VERSION, a <crate-version>." @@ -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 [-- Attachment #7: v11-0004-guix-import-crate-deduplicate-dependencies.patch --] [-- Type: text/x-patch, Size: 917 bytes --] From 98d6988239e447e445715801c1d2d6b97b0426f7 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Thu, 30 Jan 2020 10:52:28 -0500 Subject: [PATCH v11 4/9] guix: import: crate: deduplicate dependencies * guix/import/crate.scm (crate-version-dependencies): deduplicate 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 [-- Attachment #8: v11-0003-guix-import-utils-allow-generation-of-inputs-to-.patch --] [-- Type: text/x-patch, Size: 3302 bytes --] From 01bb6a944f4637a7528207e432aeda40105a2070 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Mon, 27 Jan 2020 06:45:10 -0500 Subject: [PATCH v11 3/9] guix: import: utils: allow generation of inputs to be version aware * guix/import/utils.scm (package-names->package-inputs): Added the ability to handle (name version) pairs * guix/import/crate.scm (make-crate-sexp): cleaned up input field generation --- guix/import/crate.scm | 17 +++++++++-------- guix/import/utils.scm | 21 ++++++++++++++------- 2 files changed, 23 insertions(+), 15 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index d711820b81..7e61bc21b6 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -154,16 +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 - (lambda (name-version) - (apply crate-name->package-name name-version)) cargo-inputs)) - (cargo-development-inputs - (map - (lambda (name-version) - (apply crate-name->package-name name-version)) cargo-development-inputs)) + (cargo-inputs (format-inputs cargo-inputs)) + (cargo-development-inputs (format-inputs cargo-development-inputs)) (pkg `(package (name ,guix-name) (version ,version) 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)) -- 2.25.1 [-- Attachment #9: v11-0002-guix-import-crate-Use-semver-to-resovle-module-v.patch --] [-- Type: text/x-patch, Size: 24786 bytes --] From e240ac375abbd5881f58cb9005122bb48691035e Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Tue, 4 Feb 2020 03:50:48 -0500 Subject: [PATCH v11 2/9] guix: import: crate: Use semver to resovle module versions * guix/import/crate.scm (make-crate-sexp): formatting, added '#:skip-build?' to build system args; added package definition geneation * guix/import/crate.scm (crate->guix-package): Use semver to resolve the correct module versions * guix/import/crate.scm Added guile-semver as a soft dep * tests/crate.scm: added version data to (recursuve-import) test --- guix/import/crate.scm | 90 +++++++---- guix/scripts/import/crate.scm | 11 +- tests/crate.scm | 290 +++++++++++++++++++--------------- 3 files changed, 228 insertions(+), 163 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 57823c3639..d711820b81 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 <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <crate> record or #f if it was not found." @@ -150,9 +156,14 @@ 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 - cargo-development-inputs)) + (cargo-inputs + (map + (lambda (name-version) + (apply crate-name->package-name name-version)) cargo-inputs)) + (cargo-development-inputs + (map + (lambda (name-version) + (apply crate-name->package-name name-version)) cargo-development-inputs)) (pkg `(package (name ,guix-name) (version ,version) @@ -164,9 +175,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 +189,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 +200,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 +221,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 <range>" (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<? name))))) + (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<?))) + (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 '())) (values (make-crate-sexp #:name crate-name #:version (crate-version-number version*) @@ -230,15 +262,12 @@ latest version of CRATE-NAME." #:description (crate-description crate) #:license (and=> (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 +282,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)) \f ;;; @@ -288,4 +317,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 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 <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 [-- Attachment #10: v11-0001-guix-import-recursive-import-Allow-for-version-n.patch --] [-- Type: text/x-patch, Size: 17066 bytes --] From 3d5b2e6671d90e29868eafdcbce4fb40cbd63c0b Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Tue, 4 Feb 2020 07:18:18 -0500 Subject: [PATCH v11 1/9] guix: import: (recursive-import) Allow for version numbers 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 (package->definition): added optional `append-version?` * guix/import/utils.scm (recursive-import): added key `version` and moved `repo` to be a key * guix/import/cran.scm (cran->guix-package): change `repo` to a key * guix/import/cran.scm (cran-recursive-import): change `repo` to a key * guix/scripts/import/cran.scm: change `repo` to a key * guix/import/elpa.scm (elpa->guix-pakcage): change `repo` to a key * guix/import/elpa.scm (elpa-recursive-import): change `repo` to a key * guix/scripts/import/elpa.scm: change `repo` to a key * guix/import/gem.scm (gem->guix-package): change `repo` to a key * guix/import/gem.scm (recursive-import): change `repo` to a key * guix/import/opam.scm (opam-recurive-import): change `repo` to a key * guix/import/pypi.scm (pypi-recursive-import): change `repo` to a key * guix/import/stackage.scm (stackage-recursive-import): change `repo` to a key --- guix/import/cran.scm | 8 +++-- guix/import/elpa.scm | 6 ++-- guix/import/gem.scm | 4 ++- 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, 71 insertions(+), 41 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 <rekado@elephly.net> ;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -245,7 +246,7 @@ type '<elpa-package>'." (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 '<elpa-package>'." (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..54f158fa65 100644 --- a/guix/import/gem.scm +++ b/guix/import/gem.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -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 <julien@lepiller.eu> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <maxim.cournoyer@gmail.com> ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> ;;; Copyright © 2020 Lars-Dominik Braun <ldb@leibniz-psychology.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <rekado@elephly.net> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <node> - (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 <bavier@member.fsf.org> ;;; Copyright © 2015, 2017, 2019 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-03-21 18:35 ` Martin Becze @ 2020-03-22 19:26 ` Leo Famulari 2020-03-22 20:10 ` Leo Famulari 1 sibling, 0 replies; 107+ messages in thread From: Leo Famulari @ 2020-03-22 19:26 UTC (permalink / raw) To: Martin Becze; +Cc: 38408, Ludovic Courtès, Efraim Flashner, jsoo1 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. Thanks, I am taking a look at it now. ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-03-21 18:35 ` Martin Becze 2020-03-22 19:26 ` Leo Famulari @ 2020-03-22 20:10 ` Leo Famulari 2020-03-23 9:50 ` Martin Becze 1 sibling, 1 reply; 107+ messages in thread From: Leo Famulari @ 2020-03-22 20:10 UTC (permalink / raw) To: Martin Becze; +Cc: 38408, Ludovic Courtès, Efraim Flashner, jsoo1 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? ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-03-22 20:10 ` Leo Famulari @ 2020-03-23 9:50 ` Martin Becze 2020-03-23 16:28 ` Martin Becze 0 siblings, 1 reply; 107+ messages in thread From: Martin Becze @ 2020-03-23 9:50 UTC (permalink / raw) To: Leo Famulari; +Cc: 38408, Ludovic Courtès, Efraim Flashner, jsoo1 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? > ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-03-23 9:50 ` Martin Becze @ 2020-03-23 16:28 ` Martin Becze 2020-03-24 10:18 ` Ludovic Courtès 0 siblings, 1 reply; 107+ messages in thread From: Martin Becze @ 2020-03-23 16:28 UTC (permalink / raw) To: Leo Famulari; +Cc: 38408, Ludovic Courtès, Efraim Flashner, jsoo1 [-- Attachment #1: Type: text/plain, Size: 3052 bytes --] 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? >> > > > [-- Attachment #2: v12-0008-guix-self-Adds-guile-semver-as-a-depenedency.patch --] [-- Type: text/x-patch, Size: 1898 bytes --] From 494f7c874781f64b702e31841c95c95c68fb28fc Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> 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 <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 [-- Attachment #3: v12-0007-gnu-Add-guile3.0-semver.patch --] [-- Type: text/x-patch, Size: 1214 bytes --] From 492db2aed32bb68e50eb43660d5ec3811fdb9a80 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> 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 <swedebugia@riseup.net> ;;; Copyright © 2019, 2020 Amar Singh <nly@disroot.org> ;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 [-- Attachment #4: v12-0006-import-crate-Parametrized-importing-of-dev-depen.patch --] [-- Type: text/x-patch, Size: 6639 bytes --] From 2561fbf64e7ea47a0436b3751cbeea0032f8a77b Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> 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 [-- Attachment #5: v12-0005-import-utils-Trim-patch-version-from-names.patch --] [-- Type: text/x-patch, Size: 6843 bytes --] From cb69a7c4844c68f89b783a1026751ab945fcab5d Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> 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 [-- Attachment #6: v12-0004-import-crate-Memorize-crate-guix-package.patch --] [-- Type: text/x-patch, Size: 2696 bytes --] From 3f2dbc2a47a2e5e46871fbdeabe951f55d26b557 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> 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 <crate-dependency> records of VERSION, a <crate-version>." @@ -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 [-- Attachment #7: v12-0003-import-crate-Deduplicate-dependencies.patch --] [-- Type: text/x-patch, Size: 919 bytes --] From 81056961d065e197fe8f1f2096c858776debf485 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> 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 [-- Attachment #8: v12-0002-import-crate-Use-guile-semver-to-resovle-module-.patch --] [-- Type: text/x-patch, Size: 26777 bytes --] From 98129432b4d746fd2a12a005ebe2d36e8ee0f600 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> 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 <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <crate> 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 <range>" (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<? name))))) + (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<?))) + (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 '())) (values (make-crate-sexp #:name crate-name #:version (crate-version-number version*) @@ -230,15 +263,12 @@ latest version of CRATE-NAME." #:description (crate-description crate) #:license (and=> (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)) \f ;;; @@ -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 <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 [-- Attachment #9: v12-0001-import-utils-recursive-import-accepts-an-optiona.patch --] [-- Type: text/x-patch, Size: 17543 bytes --] From 356bf29011097367a6e95dd45e71050db8bfa8e4 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> 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 <rekado@elephly.net> ;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -245,7 +246,7 @@ type '<elpa-package>'." (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 '<elpa-package>'." (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 <donttrustben@gmail.com> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <julien@lepiller.eu> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <maxim.cournoyer@gmail.com> ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> ;;; Copyright © 2020 Lars-Dominik Braun <ldb@leibniz-psychology.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <rekado@elephly.net> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <node> - (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 <bavier@member.fsf.org> ;;; Copyright © 2015, 2017, 2019 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-03-23 16:28 ` Martin Becze @ 2020-03-24 10:18 ` Ludovic Courtès 2020-03-24 14:19 ` Martin Becze 2020-03-24 19:00 ` Martin Becze 0 siblings, 2 replies; 107+ messages in thread From: Ludovic Courtès @ 2020-03-24 10:18 UTC (permalink / raw) To: Martin Becze; +Cc: 38408, Efraim Flashner, jsoo1, Leo Famulari Hi Martin & all, I apologize for taking so long and dropping the ball. Partly that’s because this is non-trivial, thanks for working on it, Martin! Some quick comments: Martin Becze <mjbecze@riseup.net> skribis: > From 494f7c874781f64b702e31841c95c95c68fb28fc Mon Sep 17 00:00:00 2001 > From: Martin Becze <mjbecze@riseup.net> > 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. Good. > From 492db2aed32bb68e50eb43660d5ec3811fdb9a80 Mon Sep 17 00:00:00 2001 > From: Martin Becze <mjbecze@riseup.net> > 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. Applied. > From 2561fbf64e7ea47a0436b3751cbeea0032f8a77b Mon Sep 17 00:00:00 2001 > From: Martin Becze <mjbecze@riseup.net> > 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. LGTM. > From cb69a7c4844c68f89b783a1026751ab945fcab5d Mon Sep 17 00:00:00 2001 > From: Martin Becze <mjbecze@riseup.net> > 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. LGTM. > From 3f2dbc2a47a2e5e46871fbdeabe951f55d26b557 Mon Sep 17 00:00:00 2001 > From: Martin Becze <mjbecze@riseup.net> > 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. This should also mention changes to ‘crate-recursive-import’. Regarding identifiers, please avoid abbreviations (info "(guix) Formatting Code"). > +(define mem-lookup-crate (memoize lookup-crate)) > + > (define (crate-version-dependencies version) > "Return the list of <crate-dependency> records of VERSION, a > <crate-version>." > @@ -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)) I’d suggest calling ‘mem-lookup-crate’ ‘lookup-crate*’ for instance. Can we also make its definition local to ‘crate-version-dependencies’ or would that defeat your caching goals? > (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 Please make ‘mem-crate->guix-package’ local to ‘crate-recursive-import’ and call it ‘crate->guix-package*’ for instance. (Memoization should always be used as a last resort: it’s a neat hack, but it’s a hack. :-) In particular, it has the problem that its cache cannot be easily invalidated. That said, I realize that other importers do this already, so that’s OK.) > From 81056961d065e197fe8f1f2096c858776debf485 Mon Sep 17 00:00:00 2001 > From: Martin Becze <mjbecze@riseup.net> > 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. Applied. > From 98129432b4d746fd2a12a005ebe2d36e8ee0f600 Mon Sep 17 00:00:00 2001 > From: Martin Becze <mjbecze@riseup.net> > Date: Tue, 4 Feb 2020 03:50:48 -0500 > Subject: [PATCH v12 2/8] import: crate: Use guile-semver to resovle module ^^ Typo. :-) > * 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. [...] > + (define (format-inputs inputs) > + (map > + (match-lambda > + ((name version) (list (crate-name->package-name name) > + (version-major+minor version)))) > + inputs)) Nitpick: please format as: (map (match-lambda ((name version) (list …))) inputs) > +(define* (crate->guix-package crate-name #:key version #:allow-other-keys) Please avoid #:allow-other-keys. In general, it’s best to know exactly what parameters a procedure expects and to benefit from compile-time warnings when we make a mistake; thus, #:allow-other-keys should only be used as a last resort. > + (define (find-version crate range) > + "finds the a vesion of a crate that fulfils the semver <range>" ^ ^ Typos. For inner procedures, please write a comment instead of a docstring. > From 356bf29011097367a6e95dd45e71050db8bfa8e4 Mon Sep 17 00:00:00 2001 > From: Martin Becze <mjbecze@riseup.net> > 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. [...] > (define cran->guix-package > (memoize > - (lambda* (package-name #:optional (repo 'cran)) > + (lambda* (package-name #:key (repo 'cran) #:allow-other-keys) I would change #:allow-other-keys to just ‘version’ (a #:version parameter) in all the importers. It does mean that #:version would be ignored by those importers, so perhaps we can add a TODO comment, but eventually someone might implement it. If you want you can resubmit patches #1 and #2 to begin with. Thank you! Ludo’. ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-03-24 10:18 ` Ludovic Courtès @ 2020-03-24 14:19 ` Martin Becze 2020-03-24 19:00 ` Martin Becze 1 sibling, 0 replies; 107+ messages in thread From: Martin Becze @ 2020-03-24 14:19 UTC (permalink / raw) To: Ludovic Courtès; +Cc: 38408, Efraim Flashner, jsoo1, Leo Famulari Thanks for the feedback Ludo! I will try to get this done today. On 3/24/20 6:18 AM, Ludovic Courtès wrote: > Hi Martin & all, > > I apologize for taking so long and dropping the ball. Partly that’s > because this is non-trivial, thanks for working on it, Martin! > > Some quick comments: > > Martin Becze <mjbecze@riseup.net> skribis: > >> From 494f7c874781f64b702e31841c95c95c68fb28fc Mon Sep 17 00:00:00 2001 >> From: Martin Becze <mjbecze@riseup.net> >> 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. > > Good. > >> From 492db2aed32bb68e50eb43660d5ec3811fdb9a80 Mon Sep 17 00:00:00 2001 >> From: Martin Becze <mjbecze@riseup.net> >> 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. > > Applied. > >> From 2561fbf64e7ea47a0436b3751cbeea0032f8a77b Mon Sep 17 00:00:00 2001 >> From: Martin Becze <mjbecze@riseup.net> >> 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. > > LGTM. > >> From cb69a7c4844c68f89b783a1026751ab945fcab5d Mon Sep 17 00:00:00 2001 >> From: Martin Becze <mjbecze@riseup.net> >> 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. > > LGTM. > >> From 3f2dbc2a47a2e5e46871fbdeabe951f55d26b557 Mon Sep 17 00:00:00 2001 >> From: Martin Becze <mjbecze@riseup.net> >> 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. > > This should also mention changes to ‘crate-recursive-import’. > > Regarding identifiers, please avoid abbreviations (info "(guix) > Formatting Code"). > >> +(define mem-lookup-crate (memoize lookup-crate)) >> + >> (define (crate-version-dependencies version) >> "Return the list of <crate-dependency> records of VERSION, a >> <crate-version>." >> @@ -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)) > > I’d suggest calling ‘mem-lookup-crate’ ‘lookup-crate*’ for instance. > Can we also make its definition local to ‘crate-version-dependencies’ or > would that defeat your caching goals? > >> (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 > > Please make ‘mem-crate->guix-package’ local to ‘crate-recursive-import’ > and call it ‘crate->guix-package*’ for instance. > > (Memoization should always be used as a last resort: it’s a neat hack, > but it’s a hack. :-) In particular, it has the problem that its cache > cannot be easily invalidated. That said, I realize that other importers > do this already, so that’s OK.) > >> From 81056961d065e197fe8f1f2096c858776debf485 Mon Sep 17 00:00:00 2001 >> From: Martin Becze <mjbecze@riseup.net> >> 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. > > Applied. > >> From 98129432b4d746fd2a12a005ebe2d36e8ee0f600 Mon Sep 17 00:00:00 2001 >> From: Martin Becze <mjbecze@riseup.net> >> Date: Tue, 4 Feb 2020 03:50:48 -0500 >> Subject: [PATCH v12 2/8] import: crate: Use guile-semver to resovle module > ^^ > Typo. :-) > > >> * 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. > > [...] > >> + (define (format-inputs inputs) >> + (map >> + (match-lambda >> + ((name version) (list (crate-name->package-name name) >> + (version-major+minor version)))) >> + inputs)) > > Nitpick: please format as: > > (map (match-lambda > ((name version) > (list …))) > inputs) > >> +(define* (crate->guix-package crate-name #:key version #:allow-other-keys) > > Please avoid #:allow-other-keys. In general, it’s best to know exactly > what parameters a procedure expects and to benefit from compile-time > warnings when we make a mistake; thus, #:allow-other-keys should only be > used as a last resort. > >> + (define (find-version crate range) >> + "finds the a vesion of a crate that fulfils the semver <range>" > ^ ^ > Typos. > For inner procedures, please write a comment instead of a docstring. > >> From 356bf29011097367a6e95dd45e71050db8bfa8e4 Mon Sep 17 00:00:00 2001 >> From: Martin Becze <mjbecze@riseup.net> >> 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. > > [...] > >> (define cran->guix-package >> (memoize >> - (lambda* (package-name #:optional (repo 'cran)) >> + (lambda* (package-name #:key (repo 'cran) #:allow-other-keys) > > I would change #:allow-other-keys to just ‘version’ (a #:version > parameter) in all the importers. > > It does mean that #:version would be ignored by those importers, so > perhaps we can add a TODO comment, but eventually someone might > implement it. > > If you want you can resubmit patches #1 and #2 to begin with. > > Thank you! > > Ludo’. > ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-03-24 10:18 ` Ludovic Courtès 2020-03-24 14:19 ` Martin Becze @ 2020-03-24 19:00 ` Martin Becze 2020-04-12 15:07 ` Martin Becze 1 sibling, 1 reply; 107+ messages in thread From: Martin Becze @ 2020-03-24 19:00 UTC (permalink / raw) To: Ludovic Courtès; +Cc: 38408, Efraim Flashner, jsoo1, Leo Famulari [-- Attachment #1: Type: text/plain, Size: 2574 bytes --] Ok Ludo, so I think I have worked through everything that you mentioned and attached is a new patch set. On 3/24/20 6:18 AM, Ludovic Courtès wrote: >> +(define mem-lookup-crate (memoize lookup-crate)) >> + >> (define (crate-version-dependencies version) >> "Return the list of <crate-dependency> records of VERSION, a >> <crate-version>." >> @@ -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)) > > I’d suggest calling ‘mem-lookup-crate’ ‘lookup-crate*’ for instance. > Can we also make its definition local to ‘crate-version-dependencies’ or > would that defeat your caching goals? I think it would, 'crate-version-dependencies' only deal with looking up the dependencies. If I made it local 'crate->guix-package' it aslo wouldn't work because we to cache across multiple calls to 'crate->guix-package'. >> (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 > > Please make ‘mem-crate->guix-package’ local to ‘crate-recursive-import’ > and call it ‘crate->guix-package*’ for instance. > > (Memoization should always be used as a last resort: it’s a neat hack, > but it’s a hack. :-) In particular, it has the problem that its cache > cannot be easily invalidated. That said, I realize that other importers > do this already, so that’s OK.) Understood. If its any trouble it is easy to drop this commit. Though on slow networks it can help quite a bit. Let me know if anything else needs changed! Thanks, Martni [-- Attachment #2: v13-0006-guix-self-Adds-guile-semver-as-a-depenedency.patch --] [-- Type: text/x-patch, Size: 1898 bytes --] From 1eefe635b4d0fd42a62bc1b8896f35224416e0f7 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Fri, 21 Feb 2020 10:41:44 -0500 Subject: [PATCH v13 6/6] 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 <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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.2 [-- Attachment #3: v13-0005-import-crate-Parametrized-importing-of-dev-depen.patch --] [-- Type: text/x-patch, Size: 6539 bytes --] From 9a8281e0836a6304db61930490c45a88aea5eb45 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Mon, 3 Feb 2020 16:19:49 -0500 Subject: [PATCH v13 5/6] 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 | 27 +++++++++++++++++++-------- guix/scripts/import/crate.scm | 4 ++-- tests/crate.scm | 3 +-- 3 files changed, 22 insertions(+), 12 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 96cf8d9b55..622b0c1975 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?) "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." @@ -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,12 @@ and LICENSE." 'unknown-license!))) (string-split string (string->char-set " /")))) -(define* (crate->guix-package crate-name #:key version repo) +(define* (crate->guix-package crate-name #:key version include-dev-deps? repo) "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 +257,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-dependencies dep-crates)) - (cargo-development-inputs '())) + (cargo-development-inputs (if include-dev-deps? + (sort-map-dependencies 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,11 +272,16 @@ 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* (crate-recursive-import crate-name #:key version) (recursive-import crate-name - #:repo->guix-package (memoize 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)) + (crate->guix-package* (memoize crate->guix-package))) + (apply 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.2 [-- Attachment #4: v13-0004-import-utils-Trim-patch-version-from-names.patch --] [-- Type: text/x-patch, Size: 6843 bytes --] From 844a1f2009d9267e0b199bd50c086e0d693437aa Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Thu, 30 Jan 2020 11:19:13 -0500 Subject: [PATCH v13 4/6] 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.2 [-- Attachment #5: v13-0003-import-crate-Memorize-crate-guix-package.patch --] [-- Type: text/x-patch, Size: 2643 bytes --] From b5dd33db1f33e44d88aab110dfa373470d73f4ed Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Thu, 30 Jan 2020 11:17:00 -0500 Subject: [PATCH v13 3/6] import: crate: Memorize crate->guix-package. This adds memorization to procedures that involve network lookups. 'lookup-crate*' is used on every dependency of a package to get its version list. It is also used to lookup a packages metadata. 'crate-recursive-import' is also memorized since creating the same package twice will trigger a lookup on in its dependencies. * guix/import/crate.scm (lookup-crate*): New procedure. (crate->guix-package): Memorize package metadata lookups. (crate-recursive-import): Memorize package creation. --- guix/import/crate.scm | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 633893765c..96cf8d9b55 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 lookup-crate* (memoize lookup-crate)) + (define (crate-version-dependencies version) "Return the list of <crate-dependency> records of VERSION, a <crate-version>." @@ -216,7 +219,7 @@ latest version of CRATE-NAME." (eq? (crate-dependency-kind dependency) 'normal))) (define crate - (lookup-crate crate-name)) + (lookup-crate* crate-name)) (define version-number (or version @@ -238,7 +241,7 @@ latest version of CRATE-NAME." (define (sort-map-dependencies deps) (sort (map (lambda (dep) (let* ((name (crate-dependency-id dep)) - (crate (lookup-crate name)) + (crate (lookup-crate* name)) (req (crate-dependency-requirement dep)) (ver (find-version crate req))) (list name @@ -267,7 +270,7 @@ latest version of CRATE-NAME." (define* (crate-recursive-import crate-name #:key version) (recursive-import crate-name - #:repo->guix-package crate->guix-package + #:repo->guix-package (memoize crate->guix-package) #:version version #:guix-name crate-name->package-name)) -- 2.25.2 [-- Attachment #6: v13-0002-import-crate-Use-guile-semver-to-resolve-module-.patch --] [-- Type: text/x-patch, Size: 27099 bytes --] From 950e7888fd73731a54347984755a232bab2068d0 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Tue, 4 Feb 2020 03:50:48 -0500 Subject: [PATCH v13 2/6] import: crate: Use guile-semver to resolve 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 | 95 +++++++---- guix/import/utils.scm | 21 ++- guix/scripts/import/crate.scm | 11 +- tests/crate.scm | 290 +++++++++++++++++++--------------- 4 files changed, 245 insertions(+), 172 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 0b4482e876..633893765c 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 <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <crate> record or #f if it was not found." @@ -143,16 +149,22 @@ 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 - #:allow-other-keys) + home-page synopsis description license) "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 repo) "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* + ;; finds the a version of a crate that fulfills the semver <range> + (define (find-version crate range) (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)) + + ;; sorts the dependencies and maps the dependencies to a list containing + ;; pairs of (name version) + (define (sort-map-dependencies deps) + (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<? name))))) + (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<?))) + (let* ((dependencies (crate-version-dependencies version*)) + (dep-crates dev-dep-crates (partition normal-dependency? dependencies)) + (cargo-inputs (sort-map-dependencies dep-crates)) + (cargo-development-inputs '())) (values (make-crate-sexp #:name crate-name #:version (crate-version-number version*) @@ -230,15 +263,12 @@ latest version of CRATE-NAME." #:description (crate-description crate) #:license (and=> (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)) \f ;;; @@ -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 <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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.2 [-- Attachment #7: v13-0001-import-utils-recursive-import-accepts-an-optiona.patch --] [-- Type: text/x-patch, Size: 18475 bytes --] From e1d599345980b3f0a18eeaced2156c0926b7d926 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Tue, 4 Feb 2020 07:18:18 -0500 Subject: [PATCH v13 1/6] 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 | 8 ++--- guix/import/pypi.scm | 8 ++--- 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, 74 insertions(+), 46 deletions(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index bb8226f714..0651796c60 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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) version) "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..0e32a6508d 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -245,7 +246,7 @@ type '<elpa-package>'." (license ,license)) dependencies-names))) -(define* (elpa->guix-package name #:optional (repo 'gnu)) +(define* (elpa->guix-package name #:key (repo 'gnu) version) "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 '<elpa-package>'." (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 <donttrustben@gmail.com> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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..81f178e6a9 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 <julien@lepiller.eu> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -250,7 +251,7 @@ path to the repository." (substring version 1) version))))) -(define* (opam->guix-package name #:key (repository (get-opam-repository))) +(define* (opam->guix-package name #:key (repository (get-opam-repository)) version) "Import OPAM package NAME from REPOSITORY (a directory name) or, if REPOSITORY is #f, from the official OPAM repository. Return a 'package' sexp or #f on failure." @@ -311,9 +312,8 @@ or #f on failure." dependencies)))))))) (define (opam-recursive-import package-name) - (recursive-import package-name #f - #:repo->guix-package (lambda (name repo) - (opam->guix-package name)) + (recursive-import package-name + #:repo->guix-package opam->guix-package #:guix-name ocaml-name->guix-name)) (define (guix-name->opam-name name) diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index f93fa8831f..3ec984b1f4 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -7,6 +7,7 @@ ;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> ;;; Copyright © 2020 Lars-Dominik Braun <ldb@leibniz-psychology.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -468,7 +469,7 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." (define pypi->guix-package (memoize - (lambda* (package-name) + (lambda* (package-name #:key repo version) "Fetch the metadata for PACKAGE-NAME from pypi.org, and return the `package' s-expression corresponding to that package, or #f on failure." (let* ((project (pypi-fetch package-name)) @@ -492,9 +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) - (pypi->guix-package name)) + (recursive-import package-name + #:repo->guix-package pypi->guix-package #:guix-name python->package-name)) (define (string->license str) diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm index 14150201b5..767fc491bf 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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 #:key repo version) (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 <rekado@elephly.net> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <node> - (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 <bavier@member.fsf.org> ;;; Copyright © 2015, 2017, 2019 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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.2 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-03-24 19:00 ` Martin Becze @ 2020-04-12 15:07 ` Martin Becze 2020-04-12 16:59 ` Ludovic Courtès 0 siblings, 1 reply; 107+ messages in thread From: Martin Becze @ 2020-04-12 15:07 UTC (permalink / raw) To: Ludovic Courtès; +Cc: 38408, Efraim Flashner, jsoo1, Leo Famulari Its time to bump this again! Ok so here is where we left off. Ludo suggested name changes > This should also mention changes to ‘crate-recursive-import’. > > Regarding identifiers, please avoid abbreviations (info "(guix) > Formatting Code"). Which should be done (But I didn't change identifiers that I don't introduce) > I would change #:allow-other-keys to just ‘version’ (a #:version > parameter) in all the importers. Did that thingy! And also Fixed some typos. The previous email had the attached set (v13). Let me know if it got lost and I need to send it again. Thanks! -Martin ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-04-12 15:07 ` Martin Becze @ 2020-04-12 16:59 ` Ludovic Courtès 2020-04-17 14:57 ` Martin Becze 0 siblings, 1 reply; 107+ messages in thread From: Ludovic Courtès @ 2020-04-12 16:59 UTC (permalink / raw) To: Martin Becze; +Cc: 38408, Efraim Flashner, jsoo1, Leo Famulari Hi Martin, Martin Becze <mjbecze@riseup.net> skribis: > The previous email had the attached set (v13). Let me know if it got > lost and I need to send it again. I think it just needs some more review time, everything is good on your side! I’m sorry it takes this long. As far as I’m concerned, I’m focusing on getting the release out of the door currently… almost there! Thank you, Ludo’. ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-04-12 16:59 ` Ludovic Courtès @ 2020-04-17 14:57 ` Martin Becze 2020-04-29 19:50 ` Martin Becze 2020-04-29 19:51 ` Martin Becze 0 siblings, 2 replies; 107+ messages in thread From: Martin Becze @ 2020-04-17 14:57 UTC (permalink / raw) To: Ludovic Courtès; +Cc: 38408, Efraim Flashner, jsoo1, Leo Famulari Sounds good! There seems to be a regression now. guix pull fails to build extra-modules, it can't find the guile-semver module. Any clues on what to look for to fix this? On 4/12/20 11:59 AM, Ludovic Courtès wrote: > Hi Martin, > > Martin Becze <mjbecze@riseup.net> skribis: > >> The previous email had the attached set (v13). Let me know if it got >> lost and I need to send it again. > > I think it just needs some more review time, everything is good on your > side! > > I’m sorry it takes this long. As far as I’m concerned, I’m focusing on > getting the release out of the door currently… almost there! > > Thank you, > Ludo’. > ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-04-17 14:57 ` Martin Becze @ 2020-04-29 19:50 ` Martin Becze 2020-04-29 19:51 ` Martin Becze 1 sibling, 0 replies; 107+ messages in thread From: Martin Becze @ 2020-04-29 19:50 UTC (permalink / raw) To: 38408 [-- Attachment #1: Type: text/plain, Size: 1048 bytes --] This patch has gotten stall again, with commits 5fbc753ab524809cd81e3e5c54b3d0acbe33792d and 5dfe02c60767a633c67f7f6fc9557b54b3c99b63\ here is an updated patch set. Also git pull work on this agian! not sure why, but prob something on my end. as always let me know if there is anything that needs to be fixed. thanks! On 4/17/20 9:57 AM, Martin Becze wrote: > Sounds good! > There seems to be a regression now. guix pull fails to build > extra-modules, it can't find the guile-semver module. Any clues on what > to look for to fix this? > > On 4/12/20 11:59 AM, Ludovic Courtès wrote: >> Hi Martin, >> >> Martin Becze <mjbecze@riseup.net> skribis: >> >>> The previous email had the attached set (v13). Let me know if it got >>> lost and I need to send it again. >> >> I think it just needs some more review time, everything is good on your >> side! >> >> I’m sorry it takes this long. As far as I’m concerned, I’m focusing on >> getting the release out of the door currently… almost there! >> >> Thank you, >> Ludo’. >> > > > [-- Attachment #2: v14-0006-guix-self-Adds-guile-semver-as-a-depenedency.patch --] [-- Type: text/x-patch, Size: 1898 bytes --] From 03cb901b537222121caf87eb62fefc1e066e4ef9 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Fri, 21 Feb 2020 10:41:44 -0500 Subject: [PATCH v14 6/6] 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 4682cd221c..37fc59c410 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 <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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)) @@ -711,6 +713,9 @@ Info manual." (define guile-gcrypt (specification->package "guile-gcrypt")) + (define guile-semver + (specification->package "guile-semver")) + (define gnutls (specification->package "gnutls")) @@ -719,7 +724,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.26.2 [-- Attachment #3: v14-0005-import-crate-Parametrized-importing-of-dev-depen.patch --] [-- Type: text/x-patch, Size: 6539 bytes --] From efce0190880ae04df2ba767b4709cfc4c71dadbc Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Mon, 3 Feb 2020 16:19:49 -0500 Subject: [PATCH v14 5/6] 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 | 27 +++++++++++++++++++-------- guix/scripts/import/crate.scm | 4 ++-- tests/crate.scm | 3 +-- 3 files changed, 22 insertions(+), 12 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index ffb74bd8cc..42a18faff3 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?) "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." @@ -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,12 @@ and LICENSE." 'unknown-license!))) (string-split string (string->char-set " /")))) -(define* (crate->guix-package crate-name #:key version repo) +(define* (crate->guix-package crate-name #:key version include-dev-deps? repo) "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) @@ -256,9 +259,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-dependencies dep-crates)) - (cargo-development-inputs '())) + (cargo-development-inputs (if include-dev-deps? + (sort-map-dependencies 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 @@ -268,11 +274,16 @@ 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* (crate-recursive-import crate-name #:key version) (recursive-import crate-name - #:repo->guix-package (memoize 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)) + (crate->guix-package* (memoize crate->guix-package))) + (apply 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 65d5ac3389..76bd3707df 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -462,8 +462,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.26.2 [-- Attachment #4: v14-0004-import-utils-Trim-patch-version-from-names.patch --] [-- Type: text/x-patch, Size: 6843 bytes --] From 6e9b04821dce30be6ae4b76c8ff36b2ae80c01c2 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Thu, 30 Jan 2020 11:19:13 -0500 Subject: [PATCH v14 4/6] 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 a147d0d693..a97cfb1185 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 beaa696be0..65d5ac3389 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -280,7 +280,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 @@ -296,7 +296,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") @@ -359,7 +359,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)) @@ -378,7 +378,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)) @@ -397,7 +397,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)) @@ -414,13 +414,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)) @@ -437,17 +437,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)) @@ -464,14 +464,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.26.2 [-- Attachment #5: v14-0003-import-crate-Memorize-crate-guix-package.patch --] [-- Type: text/x-patch, Size: 2642 bytes --] From ce235399e2e1f47eb8e76387de2b88850304f284 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Thu, 30 Jan 2020 11:17:00 -0500 Subject: [PATCH v14 3/6] import: crate: Memorize crate->guix-package. This adds memorization to procedures that involve network lookups. 'lookup-crate*' is used on every dependency of a package to get its version list. It is also used to lookup a packages metadata. 'crate-recursive-import' is also memorized since creating the same package twice will trigger a lookup on in its dependencies. * guix/import/crate.scm (lookup-crate*): New procedure. (crate->guix-package): Memorize package metadata lookups. (crate-recursive-import): Memorize package creation. --- guix/import/crate.scm | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 6054246fa3..ffb74bd8cc 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 lookup-crate* (memoize lookup-crate)) + (define (crate-version-dependencies version) "Return the list of <crate-dependency> records of VERSION, a <crate-version>." @@ -216,7 +219,7 @@ latest version of CRATE-NAME." (eq? (crate-dependency-kind dependency) 'normal))) (define crate - (lookup-crate crate-name)) + (lookup-crate* crate-name)) (define version-number (and crate @@ -240,7 +243,7 @@ latest version of CRATE-NAME." (define (sort-map-dependencies deps) (sort (map (lambda (dep) (let* ((name (crate-dependency-id dep)) - (crate (lookup-crate name)) + (crate (lookup-crate* name)) (req (crate-dependency-requirement dep)) (ver (find-version crate req))) (list name @@ -269,7 +272,7 @@ latest version of CRATE-NAME." (define* (crate-recursive-import crate-name #:key version) (recursive-import crate-name - #:repo->guix-package crate->guix-package + #:repo->guix-package (memoize crate->guix-package) #:version version #:guix-name crate-name->package-name)) -- 2.26.2 [-- Attachment #6: v14-0002-import-crate-Use-guile-semver-to-resolve-module-.patch --] [-- Type: text/x-patch, Size: 29728 bytes --] From 8d59f45d5a819b4da31706180ca7c84b5ce0512d Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Tue, 4 Feb 2020 03:50:48 -0500 Subject: [PATCH v14 2/6] import: crate: Use guile-semver to resolve 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 | 97 ++++++---- guix/import/utils.scm | 21 ++- guix/scripts/import/crate.scm | 11 +- tests/crate.scm | 330 +++++++++++++++++++--------------- 4 files changed, 266 insertions(+), 193 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index e3ec11d7f8..6054246fa3 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 <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <crate> record or #f if it was not found." @@ -143,16 +149,22 @@ 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 - #:allow-other-keys) + home-page synopsis description license) "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 repo) "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)) @@ -205,22 +223,37 @@ latest version of CRATE-NAME." (or version (crate-latest-version crate)))) + ;; finds the a version of a crate that fulfills the semver <range> + (define (find-version crate range) + (find (lambda (version) + (semver-range-contains-string? + range + (crate-version-number version))) + (crate-versions crate))) + (define version* (and crate - (find (lambda (version) - (string=? (crate-version-number version) - version-number)) - (crate-versions crate)))) + (find-version crate version-number))) + + ;; sorts the dependencies and maps the dependencies to a list containing + ;; pairs of (name version) + (define (sort-map-dependencies deps) + (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<? name))))) (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<?))) + (let* ((dependencies (crate-version-dependencies version*)) + (dep-crates dev-dep-crates (partition normal-dependency? dependencies)) + (cargo-inputs (sort-map-dependencies dep-crates)) + (cargo-development-inputs '())) (values (make-crate-sexp #:name crate-name #:version (crate-version-number version*) @@ -232,15 +265,12 @@ latest version of CRATE-NAME." #:description (crate-description crate) #:license (and=> (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) @@ -255,7 +285,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)) \f ;;; @@ -290,4 +320,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 3f559a9f31..a147d0d693 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 <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 61a04f986b..beaa696be0 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,8 +37,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"foo\", \"num\": \"1.0.0\", @@ -54,8 +55,9 @@ "{ \"dependencies\": [ { - \"crate_id\": \"bar\", - \"kind\": \"normal\" + \"crate_id\": \"leaf-alice\", + \"kind\": \"normal\", + \"req\": \"1.0.0\" } ] }") @@ -68,8 +70,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"foo\", \"num\": \"1.0.0\", @@ -87,19 +89,23 @@ \"dependencies\": [ { \"crate_id\": \"intermediate-1\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" }, { \"crate_id\": \"intermediate-2\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" } { \"crate_id\": \"leaf-alice\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" }, { \"crate_id\": \"leaf-bob\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" } ] }") @@ -112,8 +118,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"intermediate-1\", \"num\": \"1.0.0\", @@ -131,15 +137,18 @@ \"dependencies\": [ { \"crate_id\": \"intermediate-2\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" }, { \"crate_id\": \"leaf-alice\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" }, { \"crate_id\": \"leaf-bob\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" } ] }") @@ -152,8 +161,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"intermediate-2\", \"num\": \"1.0.0\", @@ -171,7 +180,8 @@ \"dependencies\": [ { \"crate_id\": \"leaf-bob\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" } ] }") @@ -184,8 +194,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"leaf-alice\", \"num\": \"1.0.0\", @@ -211,7 +221,7 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], + \"keywords\": [\"dummy\", \"test\"], \"categories\": [\"test\"] \"actual_versions\": [ { \"id\": \"leaf-bob\", @@ -253,34 +263,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. @@ -335,105 +359,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.26.2 [-- Attachment #7: v14-0001-import-utils-recursive-import-accepts-an-optiona.patch --] [-- Type: text/x-patch, Size: 18481 bytes --] From d0caf07961ae15799475d176705bd4adc81ab306 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Tue, 4 Feb 2020 07:18:18 -0500 Subject: [PATCH v14 1/6] 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 | 8 ++--- guix/import/pypi.scm | 8 ++--- 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, 74 insertions(+), 46 deletions(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 53b930acd0..0c2a388c68 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -567,7 +568,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) version) "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))) @@ -585,8 +586,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..0e32a6508d 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -245,7 +246,7 @@ type '<elpa-package>'." (license ,license)) dependencies-names))) -(define* (elpa->guix-package name #:optional (repo 'gnu)) +(define* (elpa->guix-package name #:key (repo 'gnu) version) "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 '<elpa-package>'." (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 <donttrustben@gmail.com> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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..81f178e6a9 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 <julien@lepiller.eu> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -250,7 +251,7 @@ path to the repository." (substring version 1) version))))) -(define* (opam->guix-package name #:key (repository (get-opam-repository))) +(define* (opam->guix-package name #:key (repository (get-opam-repository)) version) "Import OPAM package NAME from REPOSITORY (a directory name) or, if REPOSITORY is #f, from the official OPAM repository. Return a 'package' sexp or #f on failure." @@ -311,9 +312,8 @@ or #f on failure." dependencies)))))))) (define (opam-recursive-import package-name) - (recursive-import package-name #f - #:repo->guix-package (lambda (name repo) - (opam->guix-package name)) + (recursive-import package-name + #:repo->guix-package opam->guix-package #:guix-name ocaml-name->guix-name)) (define (guix-name->opam-name name) diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index f93fa8831f..3ec984b1f4 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -7,6 +7,7 @@ ;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> ;;; Copyright © 2020 Lars-Dominik Braun <ldb@leibniz-psychology.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -468,7 +469,7 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." (define pypi->guix-package (memoize - (lambda* (package-name) + (lambda* (package-name #:key repo version) "Fetch the metadata for PACKAGE-NAME from pypi.org, and return the `package' s-expression corresponding to that package, or #f on failure." (let* ((project (pypi-fetch package-name)) @@ -492,9 +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) - (pypi->guix-package name)) + (recursive-import package-name + #:repo->guix-package pypi->guix-package #:guix-name python->package-name)) (define (string->license str) diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm index 14150201b5..767fc491bf 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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 #:key repo version) (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 3809c3d074..3f559a9f31 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017, 2019, 2020 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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) @@ -405,32 +409,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 <node> - (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 <bavier@member.fsf.org> ;;; Copyright © 2015, 2017, 2019 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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.26.2 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-04-17 14:57 ` Martin Becze 2020-04-29 19:50 ` Martin Becze @ 2020-04-29 19:51 ` Martin Becze 2020-05-08 19:57 ` Martin Becze 2020-07-05 0:23 ` Jakub Kądziołka 1 sibling, 2 replies; 107+ messages in thread From: Martin Becze @ 2020-04-29 19:51 UTC (permalink / raw) To: Ludovic Courtès; +Cc: 38408, Efraim Flashner, jsoo1, Leo Famulari [-- Attachment #1: Type: text/plain, Size: 1048 bytes --] This patch has gotten stall again, with commits 5fbc753ab524809cd81e3e5c54b3d0acbe33792d and 5dfe02c60767a633c67f7f6fc9557b54b3c99b63\ here is an updated patch set. Also git pull work on this agian! not sure why, but prob something on my end. as always let me know if there is anything that needs to be fixed. thanks! On 4/17/20 9:57 AM, Martin Becze wrote: > Sounds good! > There seems to be a regression now. guix pull fails to build > extra-modules, it can't find the guile-semver module. Any clues on what > to look for to fix this? > > On 4/12/20 11:59 AM, Ludovic Courtès wrote: >> Hi Martin, >> >> Martin Becze <mjbecze@riseup.net> skribis: >> >>> The previous email had the attached set (v13). Let me know if it got >>> lost and I need to send it again. >> >> I think it just needs some more review time, everything is good on your >> side! >> >> I’m sorry it takes this long. As far as I’m concerned, I’m focusing on >> getting the release out of the door currently… almost there! >> >> Thank you, >> Ludo’. >> > > > [-- Attachment #2: v14-0006-guix-self-Adds-guile-semver-as-a-depenedency.patch --] [-- Type: text/x-patch, Size: 1898 bytes --] From 03cb901b537222121caf87eb62fefc1e066e4ef9 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Fri, 21 Feb 2020 10:41:44 -0500 Subject: [PATCH v14 6/6] 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 4682cd221c..37fc59c410 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 <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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)) @@ -711,6 +713,9 @@ Info manual." (define guile-gcrypt (specification->package "guile-gcrypt")) + (define guile-semver + (specification->package "guile-semver")) + (define gnutls (specification->package "gnutls")) @@ -719,7 +724,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.26.2 [-- Attachment #3: v14-0005-import-crate-Parametrized-importing-of-dev-depen.patch --] [-- Type: text/x-patch, Size: 6539 bytes --] From efce0190880ae04df2ba767b4709cfc4c71dadbc Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Mon, 3 Feb 2020 16:19:49 -0500 Subject: [PATCH v14 5/6] 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 | 27 +++++++++++++++++++-------- guix/scripts/import/crate.scm | 4 ++-- tests/crate.scm | 3 +-- 3 files changed, 22 insertions(+), 12 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index ffb74bd8cc..42a18faff3 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?) "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." @@ -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,12 @@ and LICENSE." 'unknown-license!))) (string-split string (string->char-set " /")))) -(define* (crate->guix-package crate-name #:key version repo) +(define* (crate->guix-package crate-name #:key version include-dev-deps? repo) "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) @@ -256,9 +259,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-dependencies dep-crates)) - (cargo-development-inputs '())) + (cargo-development-inputs (if include-dev-deps? + (sort-map-dependencies 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 @@ -268,11 +274,16 @@ 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* (crate-recursive-import crate-name #:key version) (recursive-import crate-name - #:repo->guix-package (memoize 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)) + (crate->guix-package* (memoize crate->guix-package))) + (apply 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 65d5ac3389..76bd3707df 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -462,8 +462,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.26.2 [-- Attachment #4: v14-0004-import-utils-Trim-patch-version-from-names.patch --] [-- Type: text/x-patch, Size: 6843 bytes --] From 6e9b04821dce30be6ae4b76c8ff36b2ae80c01c2 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Thu, 30 Jan 2020 11:19:13 -0500 Subject: [PATCH v14 4/6] 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 a147d0d693..a97cfb1185 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 beaa696be0..65d5ac3389 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -280,7 +280,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 @@ -296,7 +296,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") @@ -359,7 +359,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)) @@ -378,7 +378,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)) @@ -397,7 +397,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)) @@ -414,13 +414,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)) @@ -437,17 +437,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)) @@ -464,14 +464,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.26.2 [-- Attachment #5: v14-0003-import-crate-Memorize-crate-guix-package.patch --] [-- Type: text/x-patch, Size: 2642 bytes --] From ce235399e2e1f47eb8e76387de2b88850304f284 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Thu, 30 Jan 2020 11:17:00 -0500 Subject: [PATCH v14 3/6] import: crate: Memorize crate->guix-package. This adds memorization to procedures that involve network lookups. 'lookup-crate*' is used on every dependency of a package to get its version list. It is also used to lookup a packages metadata. 'crate-recursive-import' is also memorized since creating the same package twice will trigger a lookup on in its dependencies. * guix/import/crate.scm (lookup-crate*): New procedure. (crate->guix-package): Memorize package metadata lookups. (crate-recursive-import): Memorize package creation. --- guix/import/crate.scm | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 6054246fa3..ffb74bd8cc 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 lookup-crate* (memoize lookup-crate)) + (define (crate-version-dependencies version) "Return the list of <crate-dependency> records of VERSION, a <crate-version>." @@ -216,7 +219,7 @@ latest version of CRATE-NAME." (eq? (crate-dependency-kind dependency) 'normal))) (define crate - (lookup-crate crate-name)) + (lookup-crate* crate-name)) (define version-number (and crate @@ -240,7 +243,7 @@ latest version of CRATE-NAME." (define (sort-map-dependencies deps) (sort (map (lambda (dep) (let* ((name (crate-dependency-id dep)) - (crate (lookup-crate name)) + (crate (lookup-crate* name)) (req (crate-dependency-requirement dep)) (ver (find-version crate req))) (list name @@ -269,7 +272,7 @@ latest version of CRATE-NAME." (define* (crate-recursive-import crate-name #:key version) (recursive-import crate-name - #:repo->guix-package crate->guix-package + #:repo->guix-package (memoize crate->guix-package) #:version version #:guix-name crate-name->package-name)) -- 2.26.2 [-- Attachment #6: v14-0002-import-crate-Use-guile-semver-to-resolve-module-.patch --] [-- Type: text/x-patch, Size: 29728 bytes --] From 8d59f45d5a819b4da31706180ca7c84b5ce0512d Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Tue, 4 Feb 2020 03:50:48 -0500 Subject: [PATCH v14 2/6] import: crate: Use guile-semver to resolve 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 | 97 ++++++---- guix/import/utils.scm | 21 ++- guix/scripts/import/crate.scm | 11 +- tests/crate.scm | 330 +++++++++++++++++++--------------- 4 files changed, 266 insertions(+), 193 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index e3ec11d7f8..6054246fa3 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 <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <crate> record or #f if it was not found." @@ -143,16 +149,22 @@ 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 - #:allow-other-keys) + home-page synopsis description license) "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 repo) "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)) @@ -205,22 +223,37 @@ latest version of CRATE-NAME." (or version (crate-latest-version crate)))) + ;; finds the a version of a crate that fulfills the semver <range> + (define (find-version crate range) + (find (lambda (version) + (semver-range-contains-string? + range + (crate-version-number version))) + (crate-versions crate))) + (define version* (and crate - (find (lambda (version) - (string=? (crate-version-number version) - version-number)) - (crate-versions crate)))) + (find-version crate version-number))) + + ;; sorts the dependencies and maps the dependencies to a list containing + ;; pairs of (name version) + (define (sort-map-dependencies deps) + (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<? name))))) (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<?))) + (let* ((dependencies (crate-version-dependencies version*)) + (dep-crates dev-dep-crates (partition normal-dependency? dependencies)) + (cargo-inputs (sort-map-dependencies dep-crates)) + (cargo-development-inputs '())) (values (make-crate-sexp #:name crate-name #:version (crate-version-number version*) @@ -232,15 +265,12 @@ latest version of CRATE-NAME." #:description (crate-description crate) #:license (and=> (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) @@ -255,7 +285,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)) \f ;;; @@ -290,4 +320,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 3f559a9f31..a147d0d693 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 <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 61a04f986b..beaa696be0 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,8 +37,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"foo\", \"num\": \"1.0.0\", @@ -54,8 +55,9 @@ "{ \"dependencies\": [ { - \"crate_id\": \"bar\", - \"kind\": \"normal\" + \"crate_id\": \"leaf-alice\", + \"kind\": \"normal\", + \"req\": \"1.0.0\" } ] }") @@ -68,8 +70,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"foo\", \"num\": \"1.0.0\", @@ -87,19 +89,23 @@ \"dependencies\": [ { \"crate_id\": \"intermediate-1\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" }, { \"crate_id\": \"intermediate-2\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" } { \"crate_id\": \"leaf-alice\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" }, { \"crate_id\": \"leaf-bob\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" } ] }") @@ -112,8 +118,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"intermediate-1\", \"num\": \"1.0.0\", @@ -131,15 +137,18 @@ \"dependencies\": [ { \"crate_id\": \"intermediate-2\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" }, { \"crate_id\": \"leaf-alice\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" }, { \"crate_id\": \"leaf-bob\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" } ] }") @@ -152,8 +161,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"intermediate-2\", \"num\": \"1.0.0\", @@ -171,7 +180,8 @@ \"dependencies\": [ { \"crate_id\": \"leaf-bob\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" } ] }") @@ -184,8 +194,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"leaf-alice\", \"num\": \"1.0.0\", @@ -211,7 +221,7 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], + \"keywords\": [\"dummy\", \"test\"], \"categories\": [\"test\"] \"actual_versions\": [ { \"id\": \"leaf-bob\", @@ -253,34 +263,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. @@ -335,105 +359,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.26.2 [-- Attachment #7: v14-0001-import-utils-recursive-import-accepts-an-optiona.patch --] [-- Type: text/x-patch, Size: 18481 bytes --] From d0caf07961ae15799475d176705bd4adc81ab306 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Tue, 4 Feb 2020 07:18:18 -0500 Subject: [PATCH v14 1/6] 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 | 8 ++--- guix/import/pypi.scm | 8 ++--- 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, 74 insertions(+), 46 deletions(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 53b930acd0..0c2a388c68 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -567,7 +568,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) version) "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))) @@ -585,8 +586,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..0e32a6508d 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -245,7 +246,7 @@ type '<elpa-package>'." (license ,license)) dependencies-names))) -(define* (elpa->guix-package name #:optional (repo 'gnu)) +(define* (elpa->guix-package name #:key (repo 'gnu) version) "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 '<elpa-package>'." (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 <donttrustben@gmail.com> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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..81f178e6a9 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 <julien@lepiller.eu> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -250,7 +251,7 @@ path to the repository." (substring version 1) version))))) -(define* (opam->guix-package name #:key (repository (get-opam-repository))) +(define* (opam->guix-package name #:key (repository (get-opam-repository)) version) "Import OPAM package NAME from REPOSITORY (a directory name) or, if REPOSITORY is #f, from the official OPAM repository. Return a 'package' sexp or #f on failure." @@ -311,9 +312,8 @@ or #f on failure." dependencies)))))))) (define (opam-recursive-import package-name) - (recursive-import package-name #f - #:repo->guix-package (lambda (name repo) - (opam->guix-package name)) + (recursive-import package-name + #:repo->guix-package opam->guix-package #:guix-name ocaml-name->guix-name)) (define (guix-name->opam-name name) diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index f93fa8831f..3ec984b1f4 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -7,6 +7,7 @@ ;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> ;;; Copyright © 2020 Lars-Dominik Braun <ldb@leibniz-psychology.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -468,7 +469,7 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." (define pypi->guix-package (memoize - (lambda* (package-name) + (lambda* (package-name #:key repo version) "Fetch the metadata for PACKAGE-NAME from pypi.org, and return the `package' s-expression corresponding to that package, or #f on failure." (let* ((project (pypi-fetch package-name)) @@ -492,9 +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) - (pypi->guix-package name)) + (recursive-import package-name + #:repo->guix-package pypi->guix-package #:guix-name python->package-name)) (define (string->license str) diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm index 14150201b5..767fc491bf 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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 #:key repo version) (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 3809c3d074..3f559a9f31 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017, 2019, 2020 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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) @@ -405,32 +409,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 <node> - (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 <bavier@member.fsf.org> ;;; Copyright © 2015, 2017, 2019 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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.26.2 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-04-29 19:51 ` Martin Becze @ 2020-05-08 19:57 ` Martin Becze 2020-08-18 9:44 ` Martin Becze 2020-07-05 0:23 ` Jakub Kądziołka 1 sibling, 1 reply; 107+ messages in thread From: Martin Becze @ 2020-05-08 19:57 UTC (permalink / raw) To: Ludovic Courtès; +Cc: 38408, Efraim Flashner, jsoo1, Leo Famulari [-- Attachment #1: Type: text/plain, Size: 1224 bytes --] Hi guix, this patch set is stale again. here is an update patch for the stale part. On 4/29/20 2:51 PM, Martin Becze wrote: > This patch has gotten stall again, with commits > 5fbc753ab524809cd81e3e5c54b3d0acbe33792d and > 5dfe02c60767a633c67f7f6fc9557b54b3c99b63\ > > here is an updated patch set. > > Also git pull work on this agian! not sure why, but prob something on my > end. > > as always let me know if there is anything that needs to be fixed. > > thanks! > > > On 4/17/20 9:57 AM, Martin Becze wrote: >> Sounds good! >> There seems to be a regression now. guix pull fails to build >> extra-modules, it can't find the guile-semver module. Any clues on what >> to look for to fix this? >> >> On 4/12/20 11:59 AM, Ludovic Courtès wrote: >>> Hi Martin, >>> >>> Martin Becze <mjbecze@riseup.net> skribis: >>> >>>> The previous email had the attached set (v13). Let me know if it got >>>> lost and I need to send it again. >>> >>> I think it just needs some more review time, everything is good on your >>> side! >>> >>> I’m sorry it takes this long. As far as I’m concerned, I’m focusing on >>> getting the release out of the door currently… almost there! >>> >>> Thank you, >>> Ludo’. >>> >> >> >> [-- Attachment #2: 0001-guix-self-Adds-guile-semver-as-a-depenedency.patch --] [-- Type: text/x-patch, Size: 1881 bytes --] From 07c90c4046923eb77eb8942337fa677f34bb4d0c Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Fri, 21 Feb 2020 10:41:44 -0500 Subject: [PATCH] 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 a9568049b2..e93c164623 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 <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -54,6 +55,7 @@ ("guile-git" (ref '(gnu packages guile) 'guile-git)) ("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3)) ("guile-gcrypt" (ref '(gnu packages gnupg) 'guile-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)) @@ -711,6 +713,9 @@ Info manual." (define guile-gcrypt (specification->package "guile-gcrypt")) + (define guile-semver + (specification->package "guile-semver")) + (define gnutls (specification->package "gnutls")) @@ -719,7 +724,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.26.2 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-05-08 19:57 ` Martin Becze @ 2020-08-18 9:44 ` Martin Becze 0 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2020-08-18 9:44 UTC (permalink / raw) To: 38408 [-- Attachment #1.1.1: Type: text/plain, Size: 1392 bytes --] Stale again! here is an updated patch. On 5/8/20 2:57 PM, Martin Becze wrote: > Hi guix, > this patch set is stale again. here is an update patch for the stale part. > > On 4/29/20 2:51 PM, Martin Becze wrote: >> This patch has gotten stall again, with commits >> 5fbc753ab524809cd81e3e5c54b3d0acbe33792d and >> 5dfe02c60767a633c67f7f6fc9557b54b3c99b63\ >> >> here is an updated patch set. >> >> Also git pull work on this agian! not sure why, but prob something on my >> end. >> >> as always let me know if there is anything that needs to be fixed. >> >> thanks! >> >> >> On 4/17/20 9:57 AM, Martin Becze wrote: >>> Sounds good! >>> There seems to be a regression now. guix pull fails to build >>> extra-modules, it can't find the guile-semver module. Any clues on what >>> to look for to fix this? >>> >>> On 4/12/20 11:59 AM, Ludovic Courtès wrote: >>>> Hi Martin, >>>> >>>> Martin Becze <mjbecze@riseup.net> skribis: >>>> >>>>> The previous email had the attached set (v13). Let me know if it got >>>>> lost and I need to send it again. >>>> >>>> I think it just needs some more review time, everything is good on your >>>> side! >>>> >>>> I’m sorry it takes this long. As far as I’m concerned, I’m focusing on >>>> getting the release out of the door currently… almost there! >>>> >>>> Thank you, >>>> Ludo’. >>>> >>> >>> >>> [-- Attachment #1.1.2: 0001-import-utils-recursive-import-accepts-an-optional-ve.patch --] [-- Type: text/x-patch, Size: 18899 bytes --] From 178f37685340758c2abb488cd78fd5291e419010 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Tue, 4 Feb 2020 07:18:18 -0500 Subject: [PATCH 1/6] 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 | 8 ++--- guix/import/pypi.scm | 8 ++--- 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, 74 insertions(+), 46 deletions(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index a1275b4822..d8240a6b2f 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -568,7 +569,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) version) "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))) @@ -586,8 +587,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 871b918f88..c4e8e84aba 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -245,7 +246,7 @@ type '<elpa-package>'." (license ,license)) dependencies-names))) -(define* (elpa->guix-package name #:optional (repo 'gnu)) +(define* (elpa->guix-package name #:key (repo 'gnu) version) "Fetch the package NAME from REPO and produce a Guix package S-expression." (match (fetch-elpa-package name repo) (#f #f) @@ -299,7 +300,8 @@ type '<elpa-package>'." (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 a2d99ddbca..a48b2f86d9 100644 --- a/guix/import/gem.scm +++ b/guix/import/gem.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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))) @@ -188,6 +189,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 9cda3da006..33d310392b 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 <julien@lepiller.eu> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -250,7 +251,7 @@ path to the repository." (substring version 1) version))))) -(define* (opam->guix-package name #:key (repository (get-opam-repository))) +(define* (opam->guix-package name #:key (repository (get-opam-repository)) version) "Import OPAM package NAME from REPOSITORY (a directory name) or, if REPOSITORY is #f, from the official OPAM repository. Return a 'package' sexp or #f on failure." @@ -311,9 +312,8 @@ or #f on failure." dependencies)))))))) (define (opam-recursive-import package-name) - (recursive-import package-name #f - #:repo->guix-package (lambda (name repo) - (opam->guix-package name)) + (recursive-import package-name + #:repo->guix-package opam->guix-package #:guix-name ocaml-name->guix-name)) (define (guix-name->opam-name name) diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index a4a2489688..2a38b54f53 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -8,6 +8,7 @@ ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> ;;; Copyright © 2020 Lars-Dominik Braun <ldb@leibniz-psychology.org> ;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -471,7 +472,7 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." (define pypi->guix-package (memoize - (lambda* (package-name) + (lambda* (package-name #:key repo version) "Fetch the metadata for PACKAGE-NAME from pypi.org, and return the `package' s-expression corresponding to that package, or #f on failure." (let* ((project (pypi-fetch package-name)) @@ -495,9 +496,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) - (pypi->guix-package name)) + (recursive-import package-name + #:repo->guix-package pypi->guix-package #:guix-name python->package-name)) (define (string->license str) diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm index e04073d193..e98c37d2a3 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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 #:key repo version) (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 0cfa1f8321..c66e7ca6bd 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017, 2019, 2020 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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) @@ -405,32 +409,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 <node> - (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 <bavier@member.fsf.org> ;;; Copyright © 2015, 2017, 2019 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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.28.0 [-- Attachment #2: OpenPGP digital signature --] [-- Type: application/pgp-signature, Size: 488 bytes --] ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix 2020-04-29 19:51 ` Martin Becze 2020-05-08 19:57 ` Martin Becze @ 2020-07-05 0:23 ` Jakub Kądziołka 1 sibling, 0 replies; 107+ messages in thread From: Jakub Kądziołka @ 2020-07-05 0:23 UTC (permalink / raw) To: Martin Becze Cc: 38408, Ludovic Courtès, Efraim Flashner, jsoo1, Leo Famulari [-- Attachment #1: Type: text/plain, Size: 850 bytes --] Hi Martin, On Wed, Apr 29, 2020 at 02:51:33PM -0500, Martin Becze wrote: > diff --git a/tests/crate.scm b/tests/crate.scm > index beaa696be0..65d5ac3389 100644 > --- a/tests/crate.scm > +++ b/tests/crate.scm > @@ -280,7 +280,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 I was under the impression that, ideally, we'd only include the minor version when it's necessary for disambugating semver-incompatible packages, i. e. rust-foo@1.0.0 would be called rust-foo-1, but rust-bar@0.3.7 would be called rust-bar-0.3. Thoughts? Regards, Jakub Kądziołka [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 833 bytes --] ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 4/8] guix: import: utils: allow generation of inputs to be version aware 2020-02-04 12:18 ` [bug#38408] [PATCH v9 0/8] recursive semver crate importer! Martin Becze ` (2 preceding siblings ...) 2020-02-04 12:18 ` [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix Martin Becze @ 2020-02-04 12:18 ` Martin Becze 2020-02-04 12:18 ` [bug#38408] [PATCH v9 5/8] guix: import: crate: deduplicate dependencies Martin Becze ` (4 subsequent siblings) 8 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2020-02-04 12:18 UTC (permalink / raw) To: 38408; +Cc: ludo, efraim, jsoo1, Martin Becze * guix/import/utils.scm (package-names->package-inputs): Added the ability to handle (name version) pairs * guix/import/crate.scm (make-crate-sexp): cleaned up input field generation --- guix/import/crate.scm | 17 +++++++++-------- guix/import/utils.scm | 21 ++++++++++++++------- 2 files changed, 23 insertions(+), 15 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 84b152620c..9128314370 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -151,16 +151,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 - (lambda (name-version) - (apply crate-name->package-name name-version)) cargo-inputs)) - (cargo-development-inputs - (map - (lambda (name-version) - (apply crate-name->package-name name-version)) cargo-development-inputs)) + (cargo-inputs (format-inputs cargo-inputs)) + (cargo-development-inputs (format-inputs cargo-development-inputs)) (pkg `(package (name ,guix-name) (version ,version) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 59430d3e66..518877d476 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -233,13 +233,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)) -- 2.25.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 5/8] guix: import: crate: deduplicate dependencies 2020-02-04 12:18 ` [bug#38408] [PATCH v9 0/8] recursive semver crate importer! Martin Becze ` (3 preceding siblings ...) 2020-02-04 12:18 ` [bug#38408] [PATCH v9 4/8] guix: import: utils: allow generation of inputs to be version aware Martin Becze @ 2020-02-04 12:18 ` Martin Becze 2020-02-04 12:18 ` [bug#38408] [PATCH v9 6/8] guix: import: crate: memorize crate->guix-package Martin Becze ` (3 subsequent siblings) 8 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2020-02-04 12:18 UTC (permalink / raw) To: 38408; +Cc: ludo, efraim, jsoo1, Martin Becze * guix/import/crate.scm (crate-version-dependencies): deduplicate 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 9128314370..a82e5e877a 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -115,7 +115,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.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 6/8] guix: import: crate: memorize crate->guix-package 2020-02-04 12:18 ` [bug#38408] [PATCH v9 0/8] recursive semver crate importer! Martin Becze ` (4 preceding siblings ...) 2020-02-04 12:18 ` [bug#38408] [PATCH v9 5/8] guix: import: crate: deduplicate dependencies Martin Becze @ 2020-02-04 12:18 ` Martin Becze 2020-02-04 12:18 ` [bug#38408] [PATCH v9 7/8] guix: import: utils: trim patch version from names Martin Becze ` (2 subsequent siblings) 8 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2020-02-04 12:18 UTC (permalink / raw) To: 38408; +Cc: ludo, efraim, jsoo1, Martin Becze 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 dependencies. * guix/import/crate.scm (mem-crate->guix-package, mem-lookup-crate) --- 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 a82e5e877a..630f4d3749 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) @@ -108,6 +109,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 <crate-dependency> records of VERSION, a <crate-version>." @@ -213,7 +216,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 @@ -235,7 +238,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 @@ -262,9 +265,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.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 7/8] guix: import: utils: trim patch version from names 2020-02-04 12:18 ` [bug#38408] [PATCH v9 0/8] recursive semver crate importer! Martin Becze ` (5 preceding siblings ...) 2020-02-04 12:18 ` [bug#38408] [PATCH v9 6/8] guix: import: crate: memorize crate->guix-package Martin Becze @ 2020-02-04 12:18 ` Martin Becze 2020-02-04 12:18 ` [bug#38408] [PATCH v9 8/8] guix: import: parametrized importing of dev dependencies Martin Becze 2020-02-20 18:53 ` [bug#38408] [PATCH v9 0/8] recursive semver crate importer! Leo Famulari 8 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2020-02-04 12:18 UTC (permalink / raw) To: 38408; +Cc: ludo, efraim, jsoo1, Martin Becze * guix/import/utils.scm (package->definition): trim patch version from names * tests/crate.scm: updated the tests --- 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 518877d476..b902f008fd 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -273,9 +273,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.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 8/8] guix: import: parametrized importing of dev dependencies 2020-02-04 12:18 ` [bug#38408] [PATCH v9 0/8] recursive semver crate importer! Martin Becze ` (6 preceding siblings ...) 2020-02-04 12:18 ` [bug#38408] [PATCH v9 7/8] guix: import: utils: trim patch version from names Martin Becze @ 2020-02-04 12:18 ` Martin Becze 2020-02-20 18:53 ` [bug#38408] [PATCH v9 0/8] recursive semver crate importer! Leo Famulari 8 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2020-02-04 12:18 UTC (permalink / raw) To: 38408; +Cc: ludo, efraim, jsoo1, Martin Becze This changes the behavoir of the recusive crate importer so that it will include the 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 (crate->guix-package, make-crate-sexp) <guix import crate>: added new parameter --- 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 630f4d3749..a370fddffe 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -149,7 +149,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, @@ -176,7 +176,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))) @@ -201,11 +203,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) @@ -251,9 +255,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 @@ -263,13 +270,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.0 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 0/8] recursive semver crate importer! 2020-02-04 12:18 ` [bug#38408] [PATCH v9 0/8] recursive semver crate importer! Martin Becze ` (7 preceding siblings ...) 2020-02-04 12:18 ` [bug#38408] [PATCH v9 8/8] guix: import: parametrized importing of dev dependencies Martin Becze @ 2020-02-20 18:53 ` Leo Famulari 2020-02-21 8:35 ` Martin Becze 8 siblings, 1 reply; 107+ messages in thread From: Leo Famulari @ 2020-02-20 18:53 UTC (permalink / raw) To: Martin Becze; +Cc: 38408, ludo, efraim, jsoo1 On Tue, Feb 04, 2020 at 07:18:17AM -0500, Martin Becze wrote: > Here is the another version of the recursive semver crate importer! And hopefully the best one so far. The first 3 commits actully implement the and add semver support. The rest are mainly ergonomics such as > * triming version numbers from package name > * better deduplication of dependencies > * top level importing of development dependenies Wow, this is great! It makes it possible to get a (very close to) working rav1e package. The only things really missing are non-Rust dependencies of rav1e but I think that is not in scope for your importer. > I think it has incorpated the feedback i got from everyone so far, but if i forgot something or if there is more to add let me know! A minor bug: Sometimes if a dependency is already existing, the importer will construct its variable name incorrectly. For example, some of the packages I imported require version 2.33 of rust-clap. We already have this package, and the variable is named 'rust-clap-2', but the importer makes the packages depend on 'rust-clap-2.33'. It has to be adjusted by hand. You should be able to reproduce the bug with the following command. It doesn't matter if guile-semver is a hard dependency or autoloaded. `guix environment guix --ad-hoc guile-json guile-semver -- ./pre-inst-env guix import crate --recursive rav1e` Also, it prints the skip-build? argument on multiple lines, like this... #:skip-build? #t ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 0/8] recursive semver crate importer! 2020-02-20 18:53 ` [bug#38408] [PATCH v9 0/8] recursive semver crate importer! Leo Famulari @ 2020-02-21 8:35 ` Martin Becze 2020-02-21 12:15 ` Efraim Flashner 0 siblings, 1 reply; 107+ messages in thread From: Martin Becze @ 2020-02-21 8:35 UTC (permalink / raw) To: Leo Famulari; +Cc: 38408, ludo, efraim, jsoo1 On 2/20/20 1:53 PM, Leo Famulari wrote: > 'rust-clap-2', but the importer makes the packages depend on > 'rust-clap-2.33'. It has to be adjusted by hand. Thats actually not a bug, I think we probably should change rust-clap-2 -> rust-clap-2.33. > > Also, it prints the skip-build? argument on multiple lines, like this... > > #:skip-build? > #t Yeah that is annoying, its a problem with (ice-9 pretty-print). Would be nice to fix. ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 0/8] recursive semver crate importer! 2020-02-21 8:35 ` Martin Becze @ 2020-02-21 12:15 ` Efraim Flashner 2020-02-21 16:29 ` Martin Becze 0 siblings, 1 reply; 107+ messages in thread From: Efraim Flashner @ 2020-02-21 12:15 UTC (permalink / raw) To: Martin Becze, Leo Famulari; +Cc: 38408, ludo, jsoo1 On February 21, 2020 8:35:31 AM UTC, Martin Becze <mjbecze@riseup.net> wrote: > > >On 2/20/20 1:53 PM, Leo Famulari wrote: >> 'rust-clap-2', but the importer makes the packages depend on >> 'rust-clap-2.33'. It has to be adjusted by hand. > >Thats actually not a bug, I think we probably should change rust-clap-2 >-> rust-clap-2.33. > Talking to others at FOSDEM the other distro maintainers are pretty sure that all of the rust-clap-2 versions should be compatible, and similarly for other packages with a major version other than 0. So I'd personally prefer to change them to just the major version (and keep it as rust-clap-2). >> >> Also, it prints the skip-build? argument on multiple lines, like this... >> >> #:skip-build? >> #t > >Yeah that is annoying, its a problem with (ice-9 pretty-print). Would be >nice to fix. -- Sent from my Android device with K-9 Mail. Please excuse my brevity. ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v9 0/8] recursive semver crate importer! 2020-02-21 12:15 ` Efraim Flashner @ 2020-02-21 16:29 ` Martin Becze 0 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2020-02-21 16:29 UTC (permalink / raw) To: Efraim Flashner, Leo Famulari; +Cc: 38408, ludo, jsoo1 ah good to know. So one option is that we can change the importor to resolve the exported symbols of the package, but I think it add a bit of complexity. Once semver is in, I might give it a shot though. On 2/21/20 7:15 AM, Efraim Flashner wrote: > > > On February 21, 2020 8:35:31 AM UTC, Martin Becze <mjbecze@riseup.net> wrote: >> >> >> On 2/20/20 1:53 PM, Leo Famulari wrote: >>> 'rust-clap-2', but the importer makes the packages depend on >>> 'rust-clap-2.33'. It has to be adjusted by hand. >> >> Thats actually not a bug, I think we probably should change rust-clap-2 >> -> rust-clap-2.33. >> > > Talking to others at FOSDEM the other distro maintainers are pretty sure that all of the rust-clap-2 versions should be compatible, and similarly for other packages with a major version other than 0. So I'd personally prefer to change them to just the major version (and keep it as rust-clap-2). > >>> >>> Also, it prints the skip-build? argument on multiple lines, like this... >>> >>> #:skip-build? >>> #t >> >> Yeah that is annoying, its a problem with (ice-9 pretty-print). Would be >> nice to fix. > ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates 2019-11-28 0:13 ` [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates Martin Becze ` (7 preceding siblings ...) 2020-02-04 12:18 ` [bug#38408] [PATCH v9 0/8] recursive semver crate importer! Martin Becze @ 2020-11-07 22:19 ` Hartmut Goebel 2020-11-07 22:35 ` Marius Bakke 2020-11-11 15:06 ` [bug#38408] [PATCH v16 3/6] import: crate: Use guile-semver to resolve module versions Timothy Sample 2020-11-16 19:07 ` [bug#44694] [PATCH v17 0/8] New take continued: Semantic version aware recursive Hartmut Goebel 10 siblings, 1 reply; 107+ messages in thread From: Hartmut Goebel @ 2020-11-07 22:19 UTC (permalink / raw) To: 38408 Hi Ludo, this patch is awaiting your review since April. Maybe you could find some time to finish it, since it would ease importing and updating rust creates *a lot*. See https://lists.gnu.org/archive/html/guix-devel/2020-11/msg00168.html Many thanks. -- Regards Hartmut Goebel | Hartmut Goebel | h.goebel@crazy-compilers.com | | www.crazy-compilers.com | compilers which you thought are impossible | ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates 2020-11-07 22:19 ` [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates Hartmut Goebel @ 2020-11-07 22:35 ` Marius Bakke 2020-11-09 17:15 ` Hartmut Goebel 0 siblings, 1 reply; 107+ messages in thread From: Marius Bakke @ 2020-11-07 22:35 UTC (permalink / raw) To: Hartmut Goebel, 38408 [-- Attachment #1: Type: text/plain, Size: 516 bytes --] Hartmut Goebel <h.goebel@crazy-compilers.com> writes: > Hi Ludo, > > this patch is awaiting your review since April. Maybe you could find > some time to finish it, since it would ease importing and updating rust > creates *a lot*. See > https://lists.gnu.org/archive/html/guix-devel/2020-11/msg00168.html I don't think Ludovic has exclusive review rights on this issue. That is, anyone is free to review and merge. If you need this feature, perhaps you could try it and report whether it works (or not) for you? [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 507 bytes --] ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates 2020-11-07 22:35 ` Marius Bakke @ 2020-11-09 17:15 ` Hartmut Goebel 2020-11-09 17:27 ` Nicolas Goaziou 0 siblings, 1 reply; 107+ messages in thread From: Hartmut Goebel @ 2020-11-09 17:15 UTC (permalink / raw) To: Marius Bakke, 38408 Am 07.11.20 um 23:35 schrieb Marius Bakke: > I don't think Ludovic has exclusive review rights on this issue. That > is, anyone is free to review and merge. > > If you need this feature, perhaps you could try it and report whether it > works (or not) for you? This is a huge pile of comments and versions, patches by others, some already applied patches, etc. This is very hard to follow, one has to check 20 mails/article whether they contain a patch, same the path (giving it a filename), etc. This is why I'm asking those who already worked on this to finish the review. IMHO this shows the limitations of a mail-based patch workflow. Anyhow, I'll give it a try (steadying my optinion against mail-based software development) -- Regards Hartmut Goebel | Hartmut Goebel | h.goebel@crazy-compilers.com | | www.crazy-compilers.com | compilers which you thought are impossible | ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates 2020-11-09 17:15 ` Hartmut Goebel @ 2020-11-09 17:27 ` Nicolas Goaziou 0 siblings, 0 replies; 107+ messages in thread From: Nicolas Goaziou @ 2020-11-09 17:27 UTC (permalink / raw) To: Hartmut Goebel; +Cc: 38408, Marius Bakke Hello, Hartmut Goebel <h.goebel@crazy-compilers.com> writes: > Am 07.11.20 um 23:35 schrieb Marius Bakke: >> I don't think Ludovic has exclusive review rights on this issue. That >> is, anyone is free to review and merge. >> >> If you need this feature, perhaps you could try it and report whether it >> works (or not) for you? > > This is a huge pile of comments and versions, patches by others, some > already applied patches, etc. This is very hard to follow, one has to > check 20 mails/article whether they contain a patch, same the path > (giving it a filename), etc. This is why I'm asking those who already > worked on this to finish the review. IIUC, the base set is there: https://lists.gnu.org/archive/html/guix-patches/2020-04/msg01442.html then, two patches (the first and sixth) need to be replaced with the following ones: https://lists.gnu.org/archive/html/guix-patches/2020-05/msg00408.html and https://lists.gnu.org/archive/html/guix-patches/2020-08/msg00432.html HTH, -- Nicolas Goaziou ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v16 3/6] import: crate: Use guile-semver to resolve module versions. 2019-11-28 0:13 ` [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates Martin Becze ` (8 preceding siblings ...) 2020-11-07 22:19 ` [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates Hartmut Goebel @ 2020-11-11 15:06 ` Timothy Sample 2020-11-16 19:07 ` [bug#44694] [PATCH v17 0/8] New take continued: Semantic version aware recursive Hartmut Goebel 10 siblings, 0 replies; 107+ messages in thread From: Timothy Sample @ 2020-11-11 15:06 UTC (permalink / raw) To: Hartmut Goebel; +Cc: 38408, Martin Becze Hi Hartmut, Thanks for working on this series! Hartmut Goebel <h.goebel@crazy-compilers.com> writes: > Please also make sure, there is a test-case with some 0.x version, since > crates.io documentations says [1]: "This compatibility convention is > different from SemVer in the way it treats versions before 1.0.0. …" > > [1] > https://doc.rust-lang.org/cargo/reference/specifying-dependencies.html#caret-requirements As the author of Guile-SemVer, I just wanted to mention that its support for caret ranges is well-tested and should work well for both NPM and Cargo. Caret ranges support the convention that version 0.x.z is compatible with 0.x.y, where y < z. The Semantic Versioning document does not require that compatibility, but I think it’s expected anywhere Semantic Versioning is used. For the tests, I suggest having one test that demonstrates that the importer is relying on Semantic Versioning to resolve packages. After that, we can rely on the Guile-SemVer tests to make sure that the Semantic Versioning resolution will work even for weird edge cases. To be clear, I think the all-1.0.0 test is too simplistic. Maybe the test should provide packages A@1.2.5 and A@1.3.2, and have the requirement for package A be “>=1.2.0 <1.3.0”. It would then make sure that A@1.2.5 is selected. That way, the test shows that the importer is actually doing some kind of resolution. You could use any range syntax, but I personally find the tildes and carets hard to understand without looking at the definition. -- Tim ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#44694] [PATCH v17 0/8] New take continued: Semantic version aware recursive @ 2020-11-16 19:07 ` Hartmut Goebel 2020-11-16 19:07 ` [bug#38408] [PATCH v17 1/8] guix: self: Add guile-semver as a depenedency Hartmut Goebel ` (9 more replies) 0 siblings, 10 replies; 107+ messages in thread From: Hartmut Goebel @ 2020-11-16 19:07 UTC (permalink / raw) To: 44694, 38408 This is another revision of the patch set. Major changes compared to v16 are: * When searching dependencies, prefer an existing package satisfying semver requirement over importing the highest version create. This saves adding a lot of new packages. As an example: When importing sequoia-openpgp@0.20.0 this only imports 19 crates now, compared to 96 using the former method. * Package names are not trimmed to the first no-zero part. * Test cases have been improved so packages have different versions. THis actually showed some bubs I solved (details see below). Notable bug-fixes: * Change selection of package version: use the highest version matching the required range instead of first one. * Sort dependencies by name (was version) Some details about the improved test cases * Change crate names to avoid possible confusion * Use different version (not 1.0.0 for all) * Add some versions to some of the crates to test selecting the version. * ids of create version entries are numbers. * Document crate versions and dependencies used in tests * Actually define some dependencies using caret semver. Hartmut Goebel (3): import: utils: Trim patch version from names. import: crate: Trim version for names after left-most non-zero part. import: crate: Use existing package satisfying semver requirement. Martin Becze (5): guix: self: Add guile-semver as a depenedency. import: utils: 'recursive-import' accepts an optional version parameter. import: crate: Use guile-semver to resolve module versions. import: crate: Memorize crate->guix-package. import: crate: Parameterized importing of dev dependencies. guix/import/cran.scm | 8 +- guix/import/crate.scm | 150 +++++++-- guix/import/elpa.scm | 6 +- guix/import/gem.scm | 6 +- guix/import/opam.scm | 8 +- guix/import/pypi.scm | 8 +- guix/import/stackage.scm | 5 +- guix/import/utils.scm | 84 +++-- guix/scripts/import/cran.scm | 5 +- guix/scripts/import/crate.scm | 13 +- guix/scripts/import/elpa.scm | 4 +- guix/self.scm | 8 +- tests/crate.scm | 581 +++++++++++++++++++++++----------- tests/elpa.scm | 3 +- tests/import-utils.scm | 8 +- 15 files changed, 608 insertions(+), 289 deletions(-) -- 2.21.3 ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v17 1/8] guix: self: Add guile-semver as a depenedency. 2020-11-16 19:07 ` [bug#44694] [PATCH v17 0/8] New take continued: Semantic version aware recursive Hartmut Goebel @ 2020-11-16 19:07 ` Hartmut Goebel 2020-11-16 19:07 ` [bug#38408] [PATCH v17 2/8] import: utils: 'recursive-import' accepts an optional version parameter Hartmut Goebel ` (8 subsequent siblings) 9 siblings, 0 replies; 107+ messages in thread From: Hartmut Goebel @ 2020-11-16 19:07 UTC (permalink / raw) To: 38408; +Cc: Martin Becze From: Martin Becze <mjbecze@riseup.net> * guix/self.scm (compiled-guix): Add guile-semver as a depenedency. --- guix/self.scm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/guix/self.scm b/guix/self.scm index bbfd2f1b95..1a3f748bea 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 <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -53,6 +54,7 @@ ("guile-json" (ref '(gnu packages guile) 'guile-json-4)) ("guile-ssh" (ref '(gnu packages ssh) 'guile-ssh)) ("guile-git" (ref '(gnu packages guile) 'guile-git)) + ("guile-semver" (ref '(gnu packages guile-xyz) 'guile3.0-semver)) ("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3)) ("guile-zlib" (ref '(gnu packages guile) 'guile-zlib)) ("guile-lzlib" (ref '(gnu packages guile) 'guile-lzlib)) @@ -799,6 +801,9 @@ Info manual." (define guile-gcrypt (specification->package "guile-gcrypt")) + (define guile-semver + (specification->package "guile-semver")) + (define gnutls (specification->package "gnutls")) @@ -807,7 +812,8 @@ Info manual." (cons (list "x" package) (package-transitive-propagated-inputs package))) (list guile-gcrypt gnutls guile-git guile-json - guile-ssh guile-sqlite3 guile-zlib guile-lzlib)) + guile-ssh guile-sqlite3 guile-zlib guile-lzlib + guile-semver)) (((labels packages _ ...) ...) packages))) -- 2.21.3 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v17 2/8] import: utils: 'recursive-import' accepts an optional version parameter. 2020-11-16 19:07 ` [bug#44694] [PATCH v17 0/8] New take continued: Semantic version aware recursive Hartmut Goebel 2020-11-16 19:07 ` [bug#38408] [PATCH v17 1/8] guix: self: Add guile-semver as a depenedency Hartmut Goebel @ 2020-11-16 19:07 ` Hartmut Goebel 2020-11-16 19:07 ` [bug#38408] [PATCH v17 3/8] import: crate: Use guile-semver to resolve module versions Hartmut Goebel ` (7 subsequent siblings) 9 siblings, 0 replies; 107+ messages in thread From: Hartmut Goebel @ 2020-11-16 19:07 UTC (permalink / raw) To: 38408; +Cc: Martin Becze From: Martin Becze <mjbecze@riseup.net> This adds a key VERSION to 'recursive-import' and moves the parameter REPO to a key. This also changes all the places that rely on 'recursive-import'. * guix/import/utils.scm (recursive-import): Add the VERSION key. Make REPO a key. (package->definition): Add optional 'append-version?'. * guix/scripts/import/crate.scm (guix-import-crate): Add the VERSION key. * guix/import/crate.scm (crate->guix-package): Add the VERSION key. (crate-recursive-import): Pass VERSION to recursive-import, remove now unnecessary code. * guix/import/cran.scm (cran->guix-package, cran-recursive-import): Change the REPO parameter to a key. * guix/import/elpa.scm (elpa->guix-package, elpa-recursive-import): Likewise. * guix/import/gem.scm (gem->guix-package, 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 (recursive-import): Likewise. Co-authored-by: Hartmut Goebel <h.goebel@crazy-compilers.com> --- guix/import/cran.scm | 8 +++-- guix/import/crate.scm | 13 +++----- guix/import/elpa.scm | 6 ++-- guix/import/gem.scm | 6 ++-- guix/import/opam.scm | 8 ++--- guix/import/pypi.scm | 8 ++--- guix/import/stackage.scm | 5 +-- guix/import/utils.scm | 57 ++++++++++++++++++++++------------- guix/scripts/import/cran.scm | 5 +-- guix/scripts/import/crate.scm | 4 +-- guix/scripts/import/elpa.scm | 4 ++- tests/elpa.scm | 3 +- tests/import-utils.scm | 8 +++-- 13 files changed, 80 insertions(+), 55 deletions(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index a1275b4822..d8240a6b2f 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -568,7 +569,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) version) "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))) @@ -586,8 +587,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/crate.scm b/guix/import/crate.scm index 8c2b76cab4..47bfc16105 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -187,7 +187,7 @@ 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 repo) "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 @@ -233,13 +233,10 @@ latest version of CRATE-NAME." string->license)) (append cargo-inputs cargo-development-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) diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm index 871b918f88..c4e8e84aba 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -245,7 +246,7 @@ type '<elpa-package>'." (license ,license)) dependencies-names))) -(define* (elpa->guix-package name #:optional (repo 'gnu)) +(define* (elpa->guix-package name #:key (repo 'gnu) version) "Fetch the package NAME from REPO and produce a Guix package S-expression." (match (fetch-elpa-package name repo) (#f #f) @@ -299,7 +300,8 @@ type '<elpa-package>'." (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 3fe240f36a..1f6f94532e 100644 --- a/guix/import/gem.scm +++ b/guix/import/gem.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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))) @@ -188,6 +189,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 6d9eb0a092..867812124d 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 <julien@lepiller.eu> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -260,7 +261,7 @@ path to the repository." (substring version 1) version))))) -(define* (opam->guix-package name #:key (repository (get-opam-repository))) +(define* (opam->guix-package name #:key (repository (get-opam-repository)) version) "Import OPAM package NAME from REPOSITORY (a directory name) or, if REPOSITORY is #f, from the official OPAM repository. Return a 'package' sexp or #f on failure." @@ -322,9 +323,8 @@ or #f on failure." dependencies)))))))) (define (opam-recursive-import package-name) - (recursive-import package-name #f - #:repo->guix-package (lambda (name repo) - (opam->guix-package name)) + (recursive-import package-name + #:repo->guix-package opam->guix-package #:guix-name ocaml-name->guix-name)) (define (guix-name->opam-name name) diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index 15116e349d..bf4dc50138 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -8,6 +8,7 @@ ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> ;;; Copyright © 2020 Lars-Dominik Braun <ldb@leibniz-psychology.org> ;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -471,7 +472,7 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." (define pypi->guix-package (memoize - (lambda* (package-name) + (lambda* (package-name #:key repo version) "Fetch the metadata for PACKAGE-NAME from pypi.org, and return the `package' s-expression corresponding to that package, or #f on failure." (let* ((project (pypi-fetch package-name)) @@ -495,9 +496,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) - (pypi->guix-package name)) + (recursive-import package-name + #:repo->guix-package pypi->guix-package #:guix-name python->package-name)) (define (string->license str) diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm index 93cf214127..0a60adffc8 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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -107,8 +108,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 #:key repo version) (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 145515c489..895fbb11a8 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -6,6 +6,7 @@ ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> ;;; Copyright © 2020 Helio Machado <0x2b3bfa0+guix@googlemail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -45,6 +46,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 @@ -254,13 +256,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) @@ -409,32 +413,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 <node> - (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)) + (normalizied-deps (map (match-lambda + ((name version) (list name version)) + (name (list name #f))) dependencies))) + (make-node name version package normalizied-deps))) (map node-package - (topological-sort (list (lookup-node package-name)) + (topological-sort (list (lookup-node package-name version)) (lambda (node) - (map lookup-node - (remove exists? + (map (lambda (name-version) + (apply lookup-node name-version)) + (remove (lambda (name-version) + (apply exists? name-version)) (node-dependencies node)))) - node-name))) + (lambda (node) + (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 <bavier@member.fsf.org> ;;; Copyright © 2015, 2017, 2019 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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/crate.scm b/guix/scripts/import/crate.scm index d834518c18..9c4286f8bd 100644 --- a/guix/scripts/import/crate.scm +++ b/guix/scripts/import/crate.scm @@ -100,8 +100,8 @@ Import and convert the crate.io package for PACKAGE-NAME.\n")) `(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/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 <beffa@fbengineering.ch> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <beffa@fbengineering.ch> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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.21.3 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v17 3/8] import: crate: Use guile-semver to resolve module versions. 2020-11-16 19:07 ` [bug#44694] [PATCH v17 0/8] New take continued: Semantic version aware recursive Hartmut Goebel 2020-11-16 19:07 ` [bug#38408] [PATCH v17 1/8] guix: self: Add guile-semver as a depenedency Hartmut Goebel 2020-11-16 19:07 ` [bug#38408] [PATCH v17 2/8] import: utils: 'recursive-import' accepts an optional version parameter Hartmut Goebel @ 2020-11-16 19:07 ` Hartmut Goebel 2020-11-16 19:07 ` [bug#38408] [PATCH v17 4/8] import: crate: Memorize crate->guix-package Hartmut Goebel ` (6 subsequent siblings) 9 siblings, 0 replies; 107+ messages in thread From: Hartmut Goebel @ 2020-11-16 19:07 UTC (permalink / raw) To: 38408; +Cc: Martin Becze From: Martin Becze <mjbecze@riseup.net> * guix/import/crate.scm: Add guile-semver as a soft dependency. (make-crate-sexp): Don't allow other keys. Add '#:skip-build?' to build system args. Pass a VERSION argument to 'cargo-inputs'. (crate->guix-package): Use guile-semver to resolve the correct module versions. Treat "build" dependencies as normal dependencies. (crate-name->package-name): Reuse the procedure 'guix-name' instead of duplicating its logic. * guix/import/utils.scm (package-names->package-inputs): Implement handling of (name version) pairs. * guix/scripts/import/crate.scm (guix-import-crate): Use crate-recursive-import instead of duplicate code. * tests/crate.scm (recursive-import): Change test packages versions to be distinguishable. Add version data to the test. Check created symbols, too. Co-authored-by: Hartmut Goebel <h.goebel@crazy-compilers.com> --- guix/import/crate.scm | 91 +++++-- guix/import/utils.scm | 21 +- guix/scripts/import/crate.scm | 11 +- tests/crate.scm | 500 +++++++++++++++++++++------------- 4 files changed, 391 insertions(+), 232 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 47bfc16105..5498d1f0ff 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 <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -37,6 +37,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 @@ -85,10 +86,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 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 <crate> record or #f if it was not found." @@ -142,16 +148,21 @@ 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 - #:allow-other-keys) + home-page synopsis description license) "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))) + 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) @@ -163,7 +174,8 @@ 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))) (home-page ,(match home-page @@ -176,7 +188,7 @@ and LICENSE." ((license) license) (_ `(list ,@license))))))) (close-port port) - pkg)) + (package->definition pkg #t))) (define (string->license string) (filter-map (lambda (license) @@ -190,11 +202,17 @@ and LICENSE." (define* (crate->guix-package crate-name #:key version repo) "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." +When VERSION is specified, convert it into a semver range and attempt to fetch +the latest version matching this semver range; 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,22 +222,45 @@ latest version of CRATE-NAME." (or version (crate-latest-version crate)))) + ;; find the highest version of a crate that fulfills the semver <range> + (define (find-crate-version crate range) + (let* ((semver-range (string->semver-range range)) + (versions + (sort + (filter (lambda (entry) + (semver-range-contains? semver-range (first entry))) + (map (lambda (ver) + (list (string->semver (crate-version-number ver)) + ver)) + (crate-versions crate))) + (match-lambda* (((semver _) ...) + (apply semver<? semver)))))) + (and (not (null-list? versions)) + (second (last versions))))) + (define version* (and crate - (find (lambda (version) - (string=? (crate-version-number version) - version-number)) - (crate-versions crate)))) + (find-crate-version crate version-number))) + + ;; sort and map the dependencies to a list containing + ;; pairs of (name version) + (define (sort-map-dependencies deps) + (sort (map (lambda (dep) + (let* ((name (crate-dependency-id dep)) + (crate (lookup-crate name)) + (req (crate-dependency-requirement dep)) + (ver (find-crate-version crate req))) + (list name + (crate-version-number ver)))) + deps) + (match-lambda* (((name _) ...) + (apply string-ci<? name))))) (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<?))) + (let* ((dependencies (crate-version-dependencies version*)) + (dep-crates dev-dep-crates (partition normal-dependency? dependencies)) + (cargo-inputs (sort-map-dependencies dep-crates)) + (cargo-development-inputs '())) (values (make-crate-sexp #:name crate-name #:version (crate-version-number version*) @@ -251,7 +292,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)) \f ;;; diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 895fbb11a8..10eb030188 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -229,13 +229,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 9c4286f8bd..33dae56561 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 <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -95,19 +95,14 @@ 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 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 (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 61a04f986b..4465e12767 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -28,23 +29,67 @@ #:use-module (ice-9 match) #:use-module (srfi srfi-64)) + +;; crate versions and dependencies used here +;; foo-0.8.1 +;; foo-1.0.0 +;; foo-1.0.3 +;; leaf-alice 0.7.5 +;; +;; root-1.0.0 +;; root-1.0.4 +;; intermediate-a 1.0.42 +;; intermeidate-b ^1.0.0 +;; leaf-alice ^0.7 +;; leaf-bob ^3 +;; +;; intermediate-a-1.0.40 +;; intermediate-a-1.0.42 +;; intermediate-a-1.1.0-alpha.1 +;; intermediate-a 1.2.3 +;; leaf-alice 0.7.5 +;; leaf-bob ^3 +;; +;; intermediate-b-1.2.3 +;; leaf-bob 3.0.1 +;; +;; leaf-alice-0.7.3 +;; leaf-alice-0.7.5 +;; +;; leaf-bob-3.0.1 + + (define test-foo-crate "{ \"crate\": { - \"max_version\": \"1.0.0\", + \"max_version\": \"1.0.3\", \"name\": \"foo\", \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ - { \"id\": \"foo\", + { \"id\": 234210, + \"num\": \"0.8.1\", + \"license\": \"MIT OR Apache-2.0\", + \"links\": { + \"dependencies\": \"/api/v1/crates/foo/0.8.1/dependencies\" + } + }, + { \"id\": 234212, \"num\": \"1.0.0\", \"license\": \"MIT OR Apache-2.0\", \"links\": { \"dependencies\": \"/api/v1/crates/foo/1.0.0/dependencies\" } + }, + { \"id\": 234214, + \"num\": \"1.0.3\", + \"license\": \"MIT OR Apache-2.0\", + \"links\": { + \"dependencies\": \"/api/v1/crates/foo/1.0.3/dependencies\" + } } ] } @@ -54,8 +99,9 @@ "{ \"dependencies\": [ { - \"crate_id\": \"bar\", - \"kind\": \"normal\" + \"crate_id\": \"leaf-alice\", + \"kind\": \"normal\", + \"req\": \"0.7.5\" } ] }") @@ -63,20 +109,27 @@ (define test-root-crate "{ \"crate\": { - \"max_version\": \"1.0.0\", + \"max_version\": \"1.0.4\", \"name\": \"root\", \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ - { \"id\": \"foo\", + { \"id\": 234240, \"num\": \"1.0.0\", \"license\": \"MIT OR Apache-2.0\", \"links\": { \"dependencies\": \"/api/v1/crates/root/1.0.0/dependencies\" } + }, + { \"id\": 234242, + \"num\": \"1.0.4\", + \"license\": \"MIT OR Apache-2.0\", + \"links\": { + \"dependencies\": \"/api/v1/crates/root/1.0.4/dependencies\" + } } ] } @@ -86,92 +139,114 @@ "{ \"dependencies\": [ { - \"crate_id\": \"intermediate-1\", - \"kind\": \"normal\" + \"crate_id\": \"intermediate-a\", + \"kind\": \"normal\", + \"req\": \"1.0.42\" }, { - \"crate_id\": \"intermediate-2\", - \"kind\": \"normal\" + \"crate_id\": \"intermediate-b\", + \"kind\": \"normal\", + \"req\": \"^1.0.0\" } { \"crate_id\": \"leaf-alice\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"^0.7\" }, { \"crate_id\": \"leaf-bob\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"^3\" } ] }") -(define test-intermediate-1-crate +(define test-intermediate-a-crate "{ \"crate\": { - \"max_version\": \"1.0.0\", - \"name\": \"intermediate-1\", + \"max_version\": \"1.1.0-alpha.1\", + \"name\": \"intermediate-a\", \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ - { \"id\": \"intermediate-1\", - \"num\": \"1.0.0\", + { \"id\": 234251, + \"num\": \"1.0.40\", + \"license\": \"MIT OR Apache-2.0\", + \"links\": { + \"dependencies\": \"/api/v1/crates/intermediate-a/1.0.40/dependencies\" + } + }, + { \"id\": 234250, + \"num\": \"1.0.42\", + \"license\": \"MIT OR Apache-2.0\", + \"links\": { + \"dependencies\": \"/api/v1/crates/intermediate-a/1.0.42/dependencies\" + } + }, + { \"id\": 234252, + \"num\": \"1.1.0-alpha.1\", \"license\": \"MIT OR Apache-2.0\", \"links\": { - \"dependencies\": \"/api/v1/crates/intermediate-1/1.0.0/dependencies\" + \"dependencies\": \"/api/v1/crates/intermediate-a/1.1.0-alpha.1/dependencies\" } } ] } }") -(define test-intermediate-1-dependencies +(define test-intermediate-a-dependencies "{ \"dependencies\": [ { - \"crate_id\": \"intermediate-2\", - \"kind\": \"normal\" + \"crate_id\": \"intermediate-b\", + \"kind\": \"normal\", + \"req\": \"1.2.3\" }, { \"crate_id\": \"leaf-alice\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"0.7.5\" }, { \"crate_id\": \"leaf-bob\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"^3\" } ] }") -(define test-intermediate-2-crate +(define test-intermediate-b-crate "{ \"crate\": { - \"max_version\": \"1.0.0\", - \"name\": \"intermediate-2\", + \"max_version\": \"1.2.3\", + \"name\": \"intermediate-b\", \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ - { \"id\": \"intermediate-2\", - \"num\": \"1.0.0\", + { \"id\": 234260, + \"num\": \"1.2.3\", \"license\": \"MIT OR Apache-2.0\", \"links\": { - \"dependencies\": \"/api/v1/crates/intermediate-2/1.0.0/dependencies\" + \"dependencies\": \"/api/v1/crates/intermediate-b/1.2.3/dependencies\" } } ] } }") -(define test-intermediate-2-dependencies +(define test-intermediate-b-dependencies "{ \"dependencies\": [ { \"crate_id\": \"leaf-bob\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"3.0.1\" } ] }") @@ -179,19 +254,26 @@ (define test-leaf-alice-crate "{ \"crate\": { - \"max_version\": \"1.0.0\", + \"max_version\": \"0.7.5\", \"name\": \"leaf-alice\", \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ - { \"id\": \"leaf-alice\", - \"num\": \"1.0.0\", + { \"id\": 234270, + \"num\": \"0.7.3\", \"license\": \"MIT OR Apache-2.0\", \"links\": { - \"dependencies\": \"/api/v1/crates/leaf-alice/1.0.0/dependencies\" + \"dependencies\": \"/api/v1/crates/leaf-alice/0.7.3/dependencies\" + } + }, + { \"id\": 234272, + \"num\": \"0.7.5\", + \"license\": \"MIT OR Apache-2.0\", + \"links\": { + \"dependencies\": \"/api/v1/crates/leaf-alice/0.7.5/dependencies\" } } ] @@ -206,19 +288,19 @@ (define test-leaf-bob-crate "{ \"crate\": { - \"max_version\": \"1.0.0\", + \"max_version\": \"3.0.1\", \"name\": \"leaf-bob\", \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], + \"keywords\": [\"dummy\", \"test\"], \"categories\": [\"test\"] \"actual_versions\": [ - { \"id\": \"leaf-bob\", - \"num\": \"1.0.0\", + { \"id\": 234280, + \"num\": \"3.0.1\", \"license\": \"MIT OR Apache-2.0\", \"links\": { - \"dependencies\": \"/api/v1/crates/leaf-bob/1.0.0/dependencies\" + \"dependencies\": \"/api/v1/crates/leaf-bob/3.0.1/dependencies\" } } ] @@ -251,36 +333,51 @@ (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" + ("https://crates.io/api/v1/crates/foo/1.0.3/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" + ("https://crates.io/api/v1/crates/foo/1.0.3/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/0.7.5/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/0.7.5/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.3 + (package (name "rust-foo") + (version "1.0.3") + (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" + ('unquote 'rust-leaf-alice-0.7.5)))))) + (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. @@ -289,151 +386,170 @@ (match url ("https://crates.io/api/v1/crates/root" (open-input-string test-root-crate)) - ("https://crates.io/api/v1/crates/root/1.0.0/download" + ("https://crates.io/api/v1/crates/root/1.0.4/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/root/1.0.0/dependencies" + ("https://crates.io/api/v1/crates/root/1.0.4/dependencies" (open-input-string test-root-dependencies)) - ("https://crates.io/api/v1/crates/intermediate-1" - (open-input-string test-intermediate-1-crate)) - ("https://crates.io/api/v1/crates/intermediate-1/1.0.0/download" + ("https://crates.io/api/v1/crates/intermediate-a" + (open-input-string test-intermediate-a-crate)) + ("https://crates.io/api/v1/crates/intermediate-a/1.0.42/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/intermediate-1/1.0.0/dependencies" - (open-input-string test-intermediate-1-dependencies)) - ("https://crates.io/api/v1/crates/intermediate-2" - (open-input-string test-intermediate-2-crate)) - ("https://crates.io/api/v1/crates/intermediate-2/1.0.0/download" + ("https://crates.io/api/v1/crates/intermediate-a/1.0.42/dependencies" + (open-input-string test-intermediate-a-dependencies)) + ("https://crates.io/api/v1/crates/intermediate-b" + (open-input-string test-intermediate-b-crate)) + ("https://crates.io/api/v1/crates/intermediate-b/1.2.3/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/intermediate-2/1.0.0/dependencies" - (open-input-string test-intermediate-2-dependencies)) + ("https://crates.io/api/v1/crates/intermediate-b/1.2.3/dependencies" + (open-input-string test-intermediate-b-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" + ("https://crates.io/api/v1/crates/leaf-alice/0.7.5/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" + ("https://crates.io/api/v1/crates/leaf-alice/0.7.5/dependencies" (open-input-string test-leaf-alice-dependencies)) ("https://crates.io/api/v1/crates/leaf-bob" (open-input-string test-leaf-bob-crate)) - ("https://crates.io/api/v1/crates/leaf-bob/1.0.0/download" + ("https://crates.io/api/v1/crates/leaf-bob/3.0.1/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-bob/1.0.0/dependencies" + ("https://crates.io/api/v1/crates/leaf-bob/3.0.1/dependencies" (open-input-string test-leaf-bob-dependencies)) (_ (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)))) + ;; rust-intermediate-b has no dependency on the rust-leaf-alice + ;; package, so this is a valid ordering + (((define-public 'rust-leaf-alice-0.7.5 + (package + (name "rust-leaf-alice") + (version "0.7.5") + (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-3.0.1 + (package + (name "rust-leaf-bob") + (version "3.0.1") + (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-b-1.2.3 + (package + (name "rust-intermediate-b") + (version "1.2.3") + (source + (origin + (method url-fetch) + (uri (crate-uri "intermediate-b" 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" + ('unquote 'rust-leaf-bob-3.0.1)))))) + (home-page "http://example.com") + (synopsis "summary") + (description "summary") + (license (list license:expat license:asl2.0)))) + (define-public 'rust-intermediate-a-1.0.42 + (package + (name "rust-intermediate-a") + (version "1.0.42") + (source + (origin + (method url-fetch) + (uri (crate-uri "intermediate-a" 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-b" + ('unquote 'rust-intermediate-b-1.2.3)) + ("rust-leaf-alice" + ('unquote 'rust-leaf-alice-0.7.5)) + ("rust-leaf-bob" + ('unquote 'rust-leaf-bob-3.0.1)))))) + (home-page "http://example.com") + (synopsis "summary") + (description "summary") + (license (list license:expat license:asl2.0)))) + (define-public 'rust-root-1.0.4 + (package + (name "rust-root") + (version "1.0.4") + (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-a" + ('unquote 'rust-intermediate-a-1.0.42)) + ("rust-intermediate-b" + ('unquote 'rust-intermediate-b-1.2.3)) + ("rust-leaf-alice" + ('unquote 'rust-leaf-alice-0.7.5)) + ("rust-leaf-bob" + ('unquote 'rust-leaf-bob-3.0.1)))))) + (home-page "http://example.com") + (synopsis "summary") + (description "summary") + (license (list license:expat license:asl2.0))))) #t) (x (pk 'fail x #f))))) -- 2.21.3 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v17 4/8] import: crate: Memorize crate->guix-package. 2020-11-16 19:07 ` [bug#44694] [PATCH v17 0/8] New take continued: Semantic version aware recursive Hartmut Goebel ` (2 preceding siblings ...) 2020-11-16 19:07 ` [bug#38408] [PATCH v17 3/8] import: crate: Use guile-semver to resolve module versions Hartmut Goebel @ 2020-11-16 19:07 ` Hartmut Goebel 2020-11-16 19:07 ` [bug#38408] [PATCH v17 5/8] import: crate: Parameterized importing of dev dependencies Hartmut Goebel ` (5 subsequent siblings) 9 siblings, 0 replies; 107+ messages in thread From: Hartmut Goebel @ 2020-11-16 19:07 UTC (permalink / raw) To: 38408; +Cc: Martin Becze From: Martin Becze <mjbecze@riseup.net> This adds memorization to procedures that involve network lookups. 'lookup-crate*' is used on every dependency of a package to get its version list. It is also used to lookup a package's metadata. 'crate-recursive-import' is also memorized since creating the same package twice will trigger a lookup on its dependencies. * guix/import/crate.scm (lookup-crate*): New procedure. (crate->guix-package): Memorize package metadata lookups. (crate-recursive-import): Memorize package creation. --- guix/import/crate.scm | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 5498d1f0ff..c830449555 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -27,6 +27,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) @@ -110,6 +111,8 @@ record or #f if it was not found." (json->crate `(,@alist ("actual_versions" . ,versions)))))))) +(define lookup-crate* (memoize lookup-crate)) + (define (crate-version-dependencies version) "Return the list of <crate-dependency> records of VERSION, a <crate-version>." @@ -215,7 +218,7 @@ version of CRATE-NAME." (eq? (crate-dependency-kind dependency) 'normal))) (define crate - (lookup-crate crate-name)) + (lookup-crate* crate-name)) (define version-number (and crate @@ -247,7 +250,7 @@ version of CRATE-NAME." (define (sort-map-dependencies deps) (sort (map (lambda (dep) (let* ((name (crate-dependency-id dep)) - (crate (lookup-crate name)) + (crate (lookup-crate* name)) (req (crate-dependency-requirement dep)) (ver (find-crate-version crate req))) (list name @@ -276,7 +279,7 @@ version of CRATE-NAME." (define* (crate-recursive-import crate-name #:key version) (recursive-import crate-name - #:repo->guix-package crate->guix-package + #:repo->guix-package (memoize crate->guix-package) #:version version #:guix-name crate-name->package-name)) -- 2.21.3 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v17 5/8] import: crate: Parameterized importing of dev dependencies. 2020-11-16 19:07 ` [bug#44694] [PATCH v17 0/8] New take continued: Semantic version aware recursive Hartmut Goebel ` (3 preceding siblings ...) 2020-11-16 19:07 ` [bug#38408] [PATCH v17 4/8] import: crate: Memorize crate->guix-package Hartmut Goebel @ 2020-11-16 19:07 ` Hartmut Goebel 2020-11-16 19:07 ` [bug#38408] [PATCH v17 6/8] import: utils: Trim patch version from names Hartmut Goebel ` (4 subsequent siblings) 9 siblings, 0 replies; 107+ messages in thread From: Hartmut Goebel @ 2020-11-16 19:07 UTC (permalink / raw) To: 38408; +Cc: Martin Becze From: Martin Becze <mjbecze@riseup.net> The recursive crate importer will now include development dependencies only for the top level package, but not for any of the recursively imported packages. Also #:skip-build will be false for the top-most 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 | 25 ++++++++++++++++++------- guix/scripts/import/crate.scm | 2 +- tests/crate.scm | 3 +-- 3 files changed, 20 insertions(+), 10 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index c830449555..9704b3087b 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -151,7 +151,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?) "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." @@ -177,7 +177,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))) @@ -202,12 +204,13 @@ and LICENSE." 'unknown-license!))) (string-split string (string->char-set " /")))) -(define* (crate->guix-package crate-name #:key version repo) +(define* (crate->guix-package crate-name #:key version include-dev-deps? repo) "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, convert it into a semver range and attempt to fetch the latest version matching this semver range; otherwise fetch the latest -version of CRATE-NAME." +version of CRATE-NAME. If INCLUDE-DEV-DEPS is true then this will also +look up the development dependencs for the given crate." (define (semver-range-contains-string? range version) (semver-range-contains? (string->semver-range range) @@ -263,9 +266,12 @@ version of CRATE-NAME." (let* ((dependencies (crate-version-dependencies version*)) (dep-crates dev-dep-crates (partition normal-dependency? dependencies)) (cargo-inputs (sort-map-dependencies dep-crates)) - (cargo-development-inputs '())) + (cargo-development-inputs (if include-dev-deps? + (sort-map-dependencies 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 @@ -279,7 +285,12 @@ version of CRATE-NAME." (define* (crate-recursive-import crate-name #:key version) (recursive-import crate-name - #:repo->guix-package (memoize crate->guix-package) + #:repo->guix-package (lambda* params + ;; download development dependencies only for the top level package + (let ((include-dev-deps? (equal? (car params) crate-name)) + (crate->guix-package* (memoize crate->guix-package))) + (apply 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 33dae56561..9252c52dfa 100644 --- a/guix/scripts/import/crate.scm +++ b/guix/scripts/import/crate.scm @@ -96,7 +96,7 @@ 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 diff --git a/tests/crate.scm b/tests/crate.scm index 4465e12767..b6cd577552 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -536,8 +536,7 @@ (? string? hash))))) (build-system cargo-build-system) (arguments - ('quasiquote (#:skip-build? #t - #:cargo-inputs + ('quasiquote (#:cargo-inputs (("rust-intermediate-a" ('unquote 'rust-intermediate-a-1.0.42)) ("rust-intermediate-b" -- 2.21.3 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v17 6/8] import: utils: Trim patch version from names. 2020-11-16 19:07 ` [bug#44694] [PATCH v17 0/8] New take continued: Semantic version aware recursive Hartmut Goebel ` (4 preceding siblings ...) 2020-11-16 19:07 ` [bug#38408] [PATCH v17 5/8] import: crate: Parameterized importing of dev dependencies Hartmut Goebel @ 2020-11-16 19:07 ` Hartmut Goebel 2020-11-16 19:07 ` [bug#38408] [PATCH v17 7/8] import: crate: Trim version for names after left-most non-zero part Hartmut Goebel ` (3 subsequent siblings) 9 siblings, 0 replies; 107+ messages in thread From: Hartmut Goebel @ 2020-11-16 19:07 UTC (permalink / raw) To: 38408 This remove the patch version from generated package 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, cargo-recursive-import): Likewise. --- guix/import/crate.scm | 3 ++- guix/import/utils.scm | 7 ++++--- tests/crate.scm | 30 +++++++++++++++--------------- 3 files changed, 21 insertions(+), 19 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 9704b3087b..20efa131d5 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -159,7 +159,8 @@ and LICENSE." (map (match-lambda ((name version) - (list (crate-name->package-name name) version))) + (list (crate-name->package-name name) + (version-major+minor version)))) inputs)) (let* ((port (http-fetch (crate-uri name version))) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 10eb030188..b74393e617 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -269,9 +269,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 b6cd577552..3fbf6762c5 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -352,7 +352,7 @@ (_ (error "Unexpected URL: " url))))) (match (crate->guix-package "foo") - ((define-public 'rust-foo-1.0.3 + ((define-public 'rust-foo-1.0 (package (name "rust-foo") (version "1.0.3") (source @@ -369,7 +369,7 @@ (#:skip-build? #t #:cargo-inputs (("rust-leaf-alice" - ('unquote 'rust-leaf-alice-0.7.5)))))) + ('unquote 'rust-leaf-alice-0.7)))))) (home-page "http://example.com") (synopsis "summary") (description "summary") @@ -433,7 +433,7 @@ (match (crate-recursive-import "root") ;; rust-intermediate-b has no dependency on the rust-leaf-alice ;; package, so this is a valid ordering - (((define-public 'rust-leaf-alice-0.7.5 + (((define-public 'rust-leaf-alice-0.7 (package (name "rust-leaf-alice") (version "0.7.5") @@ -452,7 +452,7 @@ (synopsis "summary") (description "summary") (license (list license:expat license:asl2.0)))) - (define-public 'rust-leaf-bob-3.0.1 + (define-public 'rust-leaf-bob-3.0 (package (name "rust-leaf-bob") (version "3.0.1") @@ -471,7 +471,7 @@ (synopsis "summary") (description "summary") (license (list license:expat license:asl2.0)))) - (define-public 'rust-intermediate-b-1.2.3 + (define-public 'rust-intermediate-b-1.2 (package (name "rust-intermediate-b") (version "1.2.3") @@ -489,12 +489,12 @@ ('quasiquote (#:skip-build? #t #:cargo-inputs (("rust-leaf-bob" - ('unquote 'rust-leaf-bob-3.0.1)))))) + ('unquote 'rust-leaf-bob-3.0)))))) (home-page "http://example.com") (synopsis "summary") (description "summary") (license (list license:expat license:asl2.0)))) - (define-public 'rust-intermediate-a-1.0.42 + (define-public 'rust-intermediate-a-1.0 (package (name "rust-intermediate-a") (version "1.0.42") @@ -512,16 +512,16 @@ ('quasiquote (#:skip-build? #t #:cargo-inputs (("rust-intermediate-b" - ('unquote 'rust-intermediate-b-1.2.3)) + ('unquote 'rust-intermediate-b-1.2)) ("rust-leaf-alice" - ('unquote 'rust-leaf-alice-0.7.5)) + ('unquote 'rust-leaf-alice-0.7)) ("rust-leaf-bob" - ('unquote 'rust-leaf-bob-3.0.1)))))) + ('unquote 'rust-leaf-bob-3.0)))))) (home-page "http://example.com") (synopsis "summary") (description "summary") (license (list license:expat license:asl2.0)))) - (define-public 'rust-root-1.0.4 + (define-public 'rust-root-1.0 (package (name "rust-root") (version "1.0.4") @@ -538,13 +538,13 @@ (arguments ('quasiquote (#:cargo-inputs (("rust-intermediate-a" - ('unquote 'rust-intermediate-a-1.0.42)) + ('unquote 'rust-intermediate-a-1.0)) ("rust-intermediate-b" - ('unquote 'rust-intermediate-b-1.2.3)) + ('unquote 'rust-intermediate-b-1.2)) ("rust-leaf-alice" - ('unquote 'rust-leaf-alice-0.7.5)) + ('unquote 'rust-leaf-alice-0.7)) ("rust-leaf-bob" - ('unquote 'rust-leaf-bob-3.0.1)))))) + ('unquote 'rust-leaf-bob-3.0)))))) (home-page "http://example.com") (synopsis "summary") (description "summary") -- 2.21.3 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v17 7/8] import: crate: Trim version for names after left-most non-zero part. 2020-11-16 19:07 ` [bug#44694] [PATCH v17 0/8] New take continued: Semantic version aware recursive Hartmut Goebel ` (5 preceding siblings ...) 2020-11-16 19:07 ` [bug#38408] [PATCH v17 6/8] import: utils: Trim patch version from names Hartmut Goebel @ 2020-11-16 19:07 ` Hartmut Goebel 2020-11-16 19:07 ` [bug#38408] [PATCH v17 8/8] import: crate: Use existing package satisfying semver requirement Hartmut Goebel ` (2 subsequent siblings) 9 siblings, 0 replies; 107+ messages in thread From: Hartmut Goebel @ 2020-11-16 19:07 UTC (permalink / raw) To: 38408 This complies to how versions are matched for caret requirements in crates: An update is allowed if the new version number does not modify the left-most non-zero digit in the major, minor, patch grouping. * guix/import/crate.scm (version->semver-prefix): New function. (make-crate-sexp)[format-inputs]: Use it. (make-crate-sexp): Use it to pass shorter version to package->definition. * guix/import/utils.scm (package->definition): Change optional parameter APPEND-VERSION? into APPEND-VERSION?/STRING. If it is a string, append its value to name. * tests/crate.scm: Adjust tests accordingly. --- guix/import/crate.scm | 10 ++++++++-- guix/import/utils.scm | 13 +++++++++---- tests/crate.scm | 25 ++++++++++++------------- 3 files changed, 29 insertions(+), 19 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 20efa131d5..b133529ba7 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -150,6 +150,12 @@ record or #f if it was not found." ((args ...) `((arguments (,'quasiquote ,args)))))) +(define (version->semver-prefix version) + "Return the version up to and including the first non-zero part" + (first + (map match:substring + (list-matches "^(0+\\.){,2}[0-9]+" version)))) + (define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inputs home-page synopsis description license build?) "Return the `package' s-expression for a rust package with the given NAME, @@ -160,7 +166,7 @@ and LICENSE." (match-lambda ((name version) (list (crate-name->package-name name) - (version-major+minor version)))) + (version->semver-prefix version)))) inputs)) (let* ((port (http-fetch (crate-uri name version))) @@ -194,7 +200,7 @@ and LICENSE." ((license) license) (_ `(list ,@license))))))) (close-port port) - (package->definition pkg #t))) + (package->definition pkg (version->semver-prefix version)))) (define (string->license string) (filter-map (lambda (license) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index b74393e617..7de95349cd 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -263,16 +263,21 @@ package definition." ((package-inputs ...) `((native-inputs (,'quasiquote ,package-inputs)))))) -(define* (package->definition guix-package #:optional append-version?) +(define* (package->definition guix-package #:optional append-version?/string) + "If APPEND-VERSION?/STRING is #t, append the package's major+minor +version. If APPEND-VERSION?/string is a string, append this string." (match guix-package ((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-major+minor version)) - version)) + (cond + ((string? append-version?/string) + (string-append name "-" append-version?/string)) + ((= append-version?/string #t) + (string-append name "-" (version-major+minor version))) + ((#t) version))) ,guix-package)))) (define (build-system-modules) diff --git a/tests/crate.scm b/tests/crate.scm index 3fbf6762c5..1506daeadd 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -352,7 +352,7 @@ (_ (error "Unexpected URL: " url))))) (match (crate->guix-package "foo") - ((define-public 'rust-foo-1.0 + ((define-public 'rust-foo-1 (package (name "rust-foo") (version "1.0.3") (source @@ -368,8 +368,7 @@ ('quasiquote (#:skip-build? #t #:cargo-inputs - (("rust-leaf-alice" - ('unquote 'rust-leaf-alice-0.7)))))) + (("rust-leaf-alice" ('unquote 'rust-leaf-alice-0.7)))))) (home-page "http://example.com") (synopsis "summary") (description "summary") @@ -452,7 +451,7 @@ (synopsis "summary") (description "summary") (license (list license:expat license:asl2.0)))) - (define-public 'rust-leaf-bob-3.0 + (define-public 'rust-leaf-bob-3 (package (name "rust-leaf-bob") (version "3.0.1") @@ -471,7 +470,7 @@ (synopsis "summary") (description "summary") (license (list license:expat license:asl2.0)))) - (define-public 'rust-intermediate-b-1.2 + (define-public 'rust-intermediate-b-1 (package (name "rust-intermediate-b") (version "1.2.3") @@ -489,12 +488,12 @@ ('quasiquote (#:skip-build? #t #:cargo-inputs (("rust-leaf-bob" - ('unquote 'rust-leaf-bob-3.0)))))) + ('unquote rust-leaf-bob-3)))))) (home-page "http://example.com") (synopsis "summary") (description "summary") (license (list license:expat license:asl2.0)))) - (define-public 'rust-intermediate-a-1.0 + (define-public 'rust-intermediate-a-1 (package (name "rust-intermediate-a") (version "1.0.42") @@ -512,16 +511,16 @@ ('quasiquote (#:skip-build? #t #:cargo-inputs (("rust-intermediate-b" - ('unquote 'rust-intermediate-b-1.2)) + ('unquote rust-intermediate-b-1)) ("rust-leaf-alice" ('unquote 'rust-leaf-alice-0.7)) ("rust-leaf-bob" - ('unquote 'rust-leaf-bob-3.0)))))) + ('unquote rust-leaf-bob-3)))))) (home-page "http://example.com") (synopsis "summary") (description "summary") (license (list license:expat license:asl2.0)))) - (define-public 'rust-root-1.0 + (define-public 'rust-root-1 (package (name "rust-root") (version "1.0.4") @@ -538,13 +537,13 @@ (arguments ('quasiquote (#:cargo-inputs (("rust-intermediate-a" - ('unquote 'rust-intermediate-a-1.0)) + ('unquote rust-intermediate-a-1)) ("rust-intermediate-b" - ('unquote 'rust-intermediate-b-1.2)) + ('unquote rust-intermediate-b-1)) ("rust-leaf-alice" ('unquote 'rust-leaf-alice-0.7)) ("rust-leaf-bob" - ('unquote 'rust-leaf-bob-3.0)))))) + ('unquote rust-leaf-bob-3)))))) (home-page "http://example.com") (synopsis "summary") (description "summary") -- 2.21.3 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v17 8/8] import: crate: Use existing package satisfying semver requirement. 2020-11-16 19:07 ` [bug#44694] [PATCH v17 0/8] New take continued: Semantic version aware recursive Hartmut Goebel ` (6 preceding siblings ...) 2020-11-16 19:07 ` [bug#38408] [PATCH v17 7/8] import: crate: Trim version for names after left-most non-zero part Hartmut Goebel @ 2020-11-16 19:07 ` Hartmut Goebel 2020-11-17 21:54 ` [bug#38408] [PATCH v17 0/8] New take continued: Semantic version aware recursive Martin Becze 2020-12-02 21:13 ` bug#38408: " Hartmut Goebel 9 siblings, 0 replies; 107+ messages in thread From: Hartmut Goebel @ 2020-11-16 19:07 UTC (permalink / raw) To: 38408 If a package satisfying the dependency's semver requirement already exists, use it. Prior to this change the highest version matching the semver requirement was used (and imported in case it was not defined as package already). When resolving a dependency (now done in `sort-map-dependencies`), first search for a package matching the semver requirement and only if this fails reach out for a crate. * guix/import/crate.scm (crate->guix-package)[find-package-version]: New function. [dependency-name+version]: New function. [sort-map-dependencies]: Use it instead of lambda function. * tests/crate.scm (test-doctool-crate, test-doctool-dependencies): New variables. ("self-test …", "cargo-recursive-import-hoors-existing-packages"): New tests. --- guix/import/crate.scm | 37 ++++++++++++++----- tests/crate.scm | 83 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 112 insertions(+), 8 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index b133529ba7..3bc261b04e 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -32,6 +32,7 @@ #:use-module (guix packages) #:use-module (guix upstream) #:use-module (guix utils) + #:use-module (gnu packages) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (json) @@ -92,7 +93,7 @@ (requirement crate-dependency-requirement "req")) ;string (module-autoload! (current-module) - '(semver) '(string->semver semver<?)) + '(semver) '(string->semver semver->string semver<?)) (module-autoload! (current-module) '(semver ranges) '(string->semver-range semver-range-contains?)) @@ -235,6 +236,21 @@ look up the development dependencs for the given crate." (or version (crate-latest-version crate)))) + ;; find the highest existing package that fulfills the semver <range> + (define (find-package-version name range) + (let* ((semver-range (string->semver-range range)) + (versions + (sort + (filter (lambda (version) + (semver-range-contains? semver-range version)) + (map (lambda (pkg) + (string->semver (package-version pkg))) + (find-packages-by-name + (crate-name->package-name name)))) + semver<?))) + (and (not (null-list? versions)) + (semver->string (last versions))))) + ;; find the highest version of a crate that fulfills the semver <range> (define (find-crate-version crate range) (let* ((semver-range (string->semver-range range)) @@ -251,6 +267,17 @@ look up the development dependencs for the given crate." (and (not (null-list? versions)) (second (last versions))))) + (define (dependency-name+version dep) + (let* ((name (crate-dependency-id dep)) + (req (crate-dependency-requirement dep)) + (existing-version (find-package-version name req))) + (if existing-version + (list name existing-version) + (let* ((crate (lookup-crate* name)) + (ver (find-crate-version crate req))) + (list name + (crate-version-number ver)))))) + (define version* (and crate (find-crate-version crate version-number))) @@ -258,13 +285,7 @@ look up the development dependencs for the given crate." ;; sort and map the dependencies to a list containing ;; pairs of (name version) (define (sort-map-dependencies deps) - (sort (map (lambda (dep) - (let* ((name (crate-dependency-id dep)) - (crate (lookup-crate* name)) - (req (crate-dependency-requirement dep)) - (ver (find-crate-version crate req))) - (list name - (crate-version-number ver)))) + (sort (map dependency-name+version deps) (match-lambda* (((name _) ...) (apply string-ci<? name))))) diff --git a/tests/crate.scm b/tests/crate.scm index 1506daeadd..a24f734093 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -25,6 +25,7 @@ #:use-module (guix build-system cargo) #:use-module (gcrypt hash) #:use-module (guix tests) + #:use-module (gnu packages) #:use-module (ice-9 iconv) #:use-module (ice-9 match) #:use-module (srfi srfi-64)) @@ -312,6 +313,7 @@ \"dependencies\": [] }") + (define test-source-hash "") @@ -572,4 +574,85 @@ '(license:expat license:asl2.0) (string->license "MIT/Apache-2.0")) + +\f +(define test-doctool-crate + "{ + \"crate\": { + \"max_version\": \"2.2.2\", + \"name\": \"leaf-bob\", + \"description\": \"summary\", + \"homepage\": \"http://example.com\", + \"repository\": \"http://example.com\", + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"] + \"actual_versions\": [ + { \"id\": 234280, + \"num\": \"2.2.2\", + \"license\": \"MIT OR Apache-2.0\", + \"links\": { + \"dependencies\": \"/api/v1/crates/doctool/2.2.2/dependencies\" + } + } + ] + } +}") + +;; FIXME: This test depends on some existing packages +(define test-doctool-dependencies + "{ + \"dependencies\": [ + { + \"crate_id\": \"docopt\", + \"kind\": \"normal\", + \"req\": \"^0.8.1\" + } + ] +}") + + +(test-assert "self-test: rust-docopt 0.8.x is gone, please adjust the test case" + (not (null? (find-packages-by-name "rust-docopt" "0.8")))) + +(test-assert "cargo-recursive-import-hoors-existing-packages" + (mock ((guix http-client) http-fetch + (lambda (url . rest) + (match url + ("https://crates.io/api/v1/crates/doctool" + (open-input-string test-doctool-crate)) + ("https://crates.io/api/v1/crates/doctool/2.2.2/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/doctool/2.2.2/dependencies" + (open-input-string test-doctool-dependencies)) + (_ (error "Unexpected URL: " url))))) + (match (crate-recursive-import "doctool") + (((define-public 'rust-doctool-2 + (package + (name "rust-doctool") + (version "2.2.2") + (source + (origin + (method url-fetch) + (uri (crate-uri "doctool" version)) + (file-name + (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + (? string? hash))))) + (build-system cargo-build-system) + (arguments + ('quasiquote (#:cargo-inputs + (("rust-docopt" + ('unquote 'rust-docopt-0.8)))))) + (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.21.3 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v17 0/8] New take continued: Semantic version aware recursive 2020-11-16 19:07 ` [bug#44694] [PATCH v17 0/8] New take continued: Semantic version aware recursive Hartmut Goebel ` (7 preceding siblings ...) 2020-11-16 19:07 ` [bug#38408] [PATCH v17 8/8] import: crate: Use existing package satisfying semver requirement Hartmut Goebel @ 2020-11-17 21:54 ` Martin Becze 2020-12-02 21:13 ` bug#38408: " Hartmut Goebel 9 siblings, 0 replies; 107+ messages in thread From: Martin Becze @ 2020-11-17 21:54 UTC (permalink / raw) To: Hartmut Goebel, 38408 Very impressive savings! On 11/16/20 1:07 PM, Hartmut Goebel wrote: > This saves adding a lot of new packages. As an example: When importing > sequoia-openpgp@0.20.0 this only imports 19 crates now, compared to 96 > using the former method. ^ permalink raw reply [flat|nested] 107+ messages in thread
* bug#38408: [PATCH v17 0/8] New take continued: Semantic version aware recursive 2020-11-16 19:07 ` [bug#44694] [PATCH v17 0/8] New take continued: Semantic version aware recursive Hartmut Goebel ` (8 preceding siblings ...) 2020-11-17 21:54 ` [bug#38408] [PATCH v17 0/8] New take continued: Semantic version aware recursive Martin Becze @ 2020-12-02 21:13 ` Hartmut Goebel 2020-12-02 21:48 ` [bug#38408] " Leo Famulari 9 siblings, 1 reply; 107+ messages in thread From: Hartmut Goebel @ 2020-12-02 21:13 UTC (permalink / raw) To: guix-patches, 38408-close; +Cc: Martin Becze Finally pished as 054e308f5d85ca96327861a577d69c6e18fdc9dc Thanks for everybody contributing. -- Regards Hartmut Goebel | Hartmut Goebel | h.goebel@crazy-compilers.com | | www.crazy-compilers.com | compilers which you thought are impossible | ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v17 0/8] New take continued: Semantic version aware recursive 2020-12-02 21:13 ` bug#38408: " Hartmut Goebel @ 2020-12-02 21:48 ` Leo Famulari 0 siblings, 0 replies; 107+ messages in thread From: Leo Famulari @ 2020-12-02 21:48 UTC (permalink / raw) To: 38408, h.goebel, mjbecze On Wed, Dec 02, 2020 at 10:13:43PM +0100, Hartmut Goebel wrote: > Finally pished as 054e308f5d85ca96327861a577d69c6e18fdc9dc > > Thanks for everybody contributing. Wonderful! Thanks for picking up the work Hartmut, and thank you to Martin for writing the bulk of it. This work will make it possible to bring Rust into Guix in an easy and maintainable way, which is crucial for the future of free software. ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v16 3/6] import: crate: Use guile-semver to resolve module versions. 2020-11-10 22:13 ` Hartmut Goebel 2019-11-28 0:13 ` [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates Martin Becze @ 2020-11-17 21:43 ` Martin Becze 2020-11-17 21:51 ` Martin Becze 1 sibling, 1 reply; 107+ messages in thread From: Martin Becze @ 2020-11-17 21:43 UTC (permalink / raw) To: Hartmut Goebel, 38408 [-- Attachment #1: Type: text/plain, Size: 1001 bytes --] On 11/10/20 4:13 PM, Hartmut Goebel wrote: > Please add a brief change description for crate-recursive-import. Done > > I could not spot this change. has this been reverted in one of the many > version of this series? I added a better description in the attached commit. > Does this still fetch the latest version? Or is it the latest version > matching a semver range, or the latest non-beta version? The latest version including beta versions > Is this change in the last line intended? Another patch of this series > reverts this change. No, nice catch. Changing this creates conflicts so I will update the patch set. > Does this still fetch the latest version? Or is it the latest version > matching a semver range, or the latest non-beta version? I will add more advance tests in a separate commit at the end. Attached is the updated patch set. I believe it address everything brought up but please let me know if there is anything else. Thanks a lot for looking at this. [-- Attachment #2: 0007-test-Update-tests-to-cover-semver.patch --] [-- Type: text/x-patch, Size: 12223 bytes --] From 321779758ffe448217adcae38b700851149f8210 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Mon, 16 Nov 2020 01:13:00 -0600 Subject: [PATCH 7/7] test: Update tests to cover semver. * tests/crate.scm (cargo-recursive-import): Update the tests to so that the recusive import tests cover using semver. --- tests/crate.scm | 147 +++++++++++++++++++++++++++++++++--------------- 1 file changed, 102 insertions(+), 45 deletions(-) diff --git a/tests/crate.scm b/tests/crate.scm index 68481d9932..3c0fb26fcd 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -88,14 +88,14 @@ "{ \"dependencies\": [ { - \"crate_id\": \"intermediate-1\", + \"crate_id\": \"intermediate-a\", \"kind\": \"normal\", - \"req\": \"1.0.0\" + \"req\": \"^1.0.0\" }, { - \"crate_id\": \"intermediate-2\", + \"crate_id\": \"intermediate-b\", \"kind\": \"normal\", - \"req\": \"1.0.0\" + \"req\": \"*.0.0\" } { \"crate_id\": \"leaf-alice\", @@ -110,33 +110,46 @@ ] }") -(define test-intermediate-1-crate +(define test-intermediate-a-crate "{ \"crate\": { - \"max_version\": \"1.0.0\", - \"name\": \"intermediate-1\", + \"max_version\": \"1.0.1\", + \"name\": \"intermediate-a\", \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", \"keywords\": [\"dummy\", \"test\"], \"categories\": [\"test\"], \"actual_versions\": [ - { \"id\": \"intermediate-1\", + { \"id\": \"intermediate-a\", + \"num\": \"2.0.0\", + \"license\": \"MIT OR Apache-2.0\", + \"links\": { + \"dependencies\": \"/api/v1/crates/intermediate-a/1.0.1/dependencies\" + } + } + { \"id\": \"intermediate-a\", + \"num\": \"1.0.1\", + \"license\": \"MIT OR Apache-2.0\", + \"links\": { + \"dependencies\": \"/api/v1/crates/intermediate-a/1.0.1/dependencies\" + } + },{ \"id\": \"intermediate-a\", \"num\": \"1.0.0\", \"license\": \"MIT OR Apache-2.0\", \"links\": { - \"dependencies\": \"/api/v1/crates/intermediate-1/1.0.0/dependencies\" + \"dependencies\": \"/api/v1/crates/intermediate-a/1.0.1/dependencies\" } } ] } }") -(define test-intermediate-1-dependencies +(define test-intermediate-a-dependencies "{ \"dependencies\": [ { - \"crate_id\": \"intermediate-2\", + \"crate_id\": \"intermediate-b\", \"kind\": \"normal\", \"req\": \"1.0.0\" }, @@ -153,29 +166,36 @@ ] }") -(define test-intermediate-2-crate +(define test-intermediate-b-crate "{ \"crate\": { \"max_version\": \"1.0.0\", - \"name\": \"intermediate-2\", + \"name\": \"intermediate-b\", \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", \"keywords\": [\"dummy\", \"test\"], \"categories\": [\"test\"], \"actual_versions\": [ - { \"id\": \"intermediate-2\", + { \"id\": \"intermediate-b\", + \"num\": \"2.0.0\", + \"license\": \"MIT OR Apache-2.0\", + \"links\": { + \"dependencies\": \"/api/v1/crates/intermediate-b/2.0.0/dependencies\" + } + }, + { \"id\": \"intermediate-b\", \"num\": \"1.0.0\", \"license\": \"MIT OR Apache-2.0\", \"links\": { - \"dependencies\": \"/api/v1/crates/intermediate-2/1.0.0/dependencies\" + \"dependencies\": \"/api/v1/crates/intermediate-b/1.0.0/dependencies\" } } ] } }") -(define test-intermediate-2-dependencies +(define test-intermediate-b-dependencies "{ \"dependencies\": [ { @@ -230,6 +250,13 @@ \"links\": { \"dependencies\": \"/api/v1/crates/leaf-bob/1.0.0/dependencies\" } + }, + { \"id\": \"leaf-bob\", + \"num\": \"0.1.0\", + \"license\": \"MIT OR Apache-2.0\", + \"links\": { + \"dependencies\": \"/api/v1/crates/leaf-bob/0.1.0/dependencies\" + } } ] } @@ -320,24 +347,31 @@ (open-input-string "empty file\n")) ("https://crates.io/api/v1/crates/root/1.0.0/dependencies" (open-input-string test-root-dependencies)) - ("https://crates.io/api/v1/crates/intermediate-1" - (open-input-string test-intermediate-1-crate)) - ("https://crates.io/api/v1/crates/intermediate-1/1.0.0/download" + ("https://crates.io/api/v1/crates/intermediate-a" + (open-input-string test-intermediate-a-crate)) + ("https://crates.io/api/v1/crates/intermediate-a/1.0.1/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/intermediate-a/1.0.1/dependencies" + (open-input-string test-intermediate-a-dependencies)) + ("https://crates.io/api/v1/crates/intermediate-b" + (open-input-string test-intermediate-b-crate)) + ("https://crates.io/api/v1/crates/intermediate-b/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/intermediate-1/1.0.0/dependencies" - (open-input-string test-intermediate-1-dependencies)) - ("https://crates.io/api/v1/crates/intermediate-2" - (open-input-string test-intermediate-2-crate)) - ("https://crates.io/api/v1/crates/intermediate-2/1.0.0/download" + ("https://crates.io/api/v1/crates/intermediate-b/2.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/intermediate-2/1.0.0/dependencies" - (open-input-string test-intermediate-2-dependencies)) + ("https://crates.io/api/v1/crates/intermediate-b/1.0.0/dependencies" + (open-input-string test-intermediate-b-dependencies)) + ("https://crates.io/api/v1/crates/intermediate-b/2.0.0/dependencies" + (open-input-string test-intermediate-b-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" @@ -358,11 +392,34 @@ (open-input-string test-leaf-bob-dependencies)) (_ (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 + ;; rust-intermediate-B has no dependency on the rust-leaf-alice package, so this is a valid ordering + (((define-public rust-intermediate-b-2.0 + (package + (name "rust-intermediate-b") + (version "2.0.0") + (source + (origin + (method url-fetch) + (uri (crate-uri "intermediate-b" 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" + ('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-leaf-alice-1.0 (package (name "rust-leaf-alice") - (version (? string? ver)) + (version "1.0.0") (source (origin (method url-fetch) @@ -381,7 +438,7 @@ (define-public rust-leaf-bob-1.0 (package (name "rust-leaf-bob") - (version (? string? ver)) + (version "1.0.0") (source (origin (method url-fetch) @@ -397,14 +454,14 @@ (synopsis "summary") (description "summary") (license (list license:expat license:asl2.0)))) - (define-public rust-intermediate-2-1.0 + (define-public rust-intermediate-b-1.0 (package - (name "rust-intermediate-2") - (version (? string? ver)) + (name "rust-intermediate-b") + (version "1.0.0") (source (origin (method url-fetch) - (uri (crate-uri "intermediate-2" version)) + (uri (crate-uri "intermediate-b" version)) (file-name (string-append name "-" version ".tar.gz")) (sha256 @@ -420,14 +477,14 @@ (synopsis "summary") (description "summary") (license (list license:expat license:asl2.0)))) - (define-public rust-intermediate-1-1.0 + (define-public rust-intermediate-a-1.0 (package - (name "rust-intermediate-1") - (version (? string? ver)) + (name "rust-intermediate-a") + (version "1.0.1") (source (origin (method url-fetch) - (uri (crate-uri "intermediate-1" version)) + (uri (crate-uri "intermediate-a" version)) (file-name (string-append name "-" version ".tar.gz")) (sha256 @@ -437,8 +494,8 @@ (arguments ('quasiquote (#:skip-build? #t #:cargo-inputs - (("rust-intermediate-2" - ,rust-intermediate-2-1.0) + (("rust-intermediate-b" + ,rust-intermediate-b-1.0) ("rust-leaf-alice" ('unquote rust-leaf-alice-1.0)) ("rust-leaf-bob" @@ -450,7 +507,7 @@ (define-public rust-root-1.0 (package (name "rust-root") - (version (? string? ver)) + (version "1.0.0") (source (origin (method url-fetch) @@ -463,10 +520,10 @@ (build-system cargo-build-system) (arguments ('quasiquote (#:cargo-inputs - (("rust-intermediate-1" - ('unquote rust-intermediate-1-1.0)) - ("rust-intermediate-2" - ('unquote rust-intermediate-2-1.0)) + (("rust-intermediate-a" + ('unquote rust-intermediate-a-1.0)) + ("rust-intermediate-b" + ('unquote rust-intermediate-b-2.0)) ("rust-leaf-alice" ('unquote rust-leaf-alice-1.0)) ("rust-leaf-bob" -- 2.29.2 [-- Attachment #3: 0006-import-crate-Parameterized-importing-of-dev-dependen.patch --] [-- Type: text/x-patch, Size: 6179 bytes --] From e0e09fb443cf89f77409271fd9114adfaccaa95b Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Tue, 10 Nov 2020 22:39:33 +0100 Subject: [PATCH 6/7] import: crate: Parameterized importing of dev dependencies. The recursive crate importer will now include development dependencies only for the top level package, but not for any of the recursively imported packages. * 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 | 25 ++++++++++++++++++------- guix/scripts/import/crate.scm | 4 ++-- tests/crate.scm | 3 +-- 3 files changed, 21 insertions(+), 11 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 0a88e30e8f..236420f144 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -151,7 +151,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?) "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." @@ -178,7 +178,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))) @@ -203,11 +205,12 @@ and LICENSE." 'unknown-license!))) (string-split string (string->char-set " /")))) -(define* (crate->guix-package crate-name #:key version repo) +(define* (crate->guix-package crate-name #:key version include-dev-deps? repo) "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) @@ -252,9 +255,12 @@ latest version of CRATE-NAME." (let* ((dependencies (crate-version-dependencies version*)) (dep-crates dev-dep-crates (partition normal-dependency? dependencies)) (cargo-inputs (map-dependencies dep-crates)) - (cargo-development-inputs '())) + (cargo-development-inputs (if include-dev-deps? + (map-dependencies 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 @@ -268,7 +274,12 @@ latest version of CRATE-NAME." (define* (crate-recursive-import crate-name #:key version) (recursive-import crate-name - #:repo->guix-package (memoize 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)) + (crate->guix-package* (memoize crate->guix-package))) + (apply 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 b14e4f8225..68481d9932 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -462,8 +462,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.29.2 [-- Attachment #4: 0005-import-utils-Trim-patch-version-from-names.patch --] [-- Type: text/x-patch, Size: 6902 bytes --] From be381204b46449a7db14d0217f656f86af976fb3 Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Tue, 10 Nov 2020 22:39:32 +0100 Subject: [PATCH 5/7] import: utils: Trim patch version from names. This remove the patch version from generated package 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, cargo-recursive-import): Likewise. --- guix/import/utils.scm | 7 ++++--- tests/crate.scm | 46 +++++++++++++++++++++---------------------- 2 files changed, 27 insertions(+), 26 deletions(-) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 66445f006f..d78a6d3fae 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -269,9 +269,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 beaa696be0..b14e4f8225 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -280,7 +280,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 @@ -296,7 +296,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") @@ -359,7 +359,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)) @@ -378,7 +378,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)) @@ -397,7 +397,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)) @@ -414,13 +414,13 @@ (arguments ('quasiquote (#:skip-build? #t #:cargo-inputs - (("rust-leaf-bob-1.0.0" - ('unquote rust-leaf-bob-1.0.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-intermediate-1-1.0.0 + (define-public rust-intermediate-1-1.0 (package (name "rust-intermediate-1") (version (? string? ver)) @@ -437,17 +437,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)) @@ -464,14 +464,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.29.2 [-- Attachment #5: 0004-import-crate-Memorize-crate-guix-package.patch --] [-- Type: text/x-patch, Size: 2194 bytes --] From 26b97a51cf592a64b10accd4f332dbc8d20844af Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Tue, 10 Nov 2020 22:39:31 +0100 Subject: [PATCH 4/7] import: crate: Memorize crate->guix-package. This adds memorization to procedures that involve network lookups. 'lookup-crate*' is used on every dependency of a package to get its version list. It is also used to lookup a package's metadata. 'crate-recursive-import' is also memorized since creating the same package twice will trigger a lookup on its dependencies. * guix/import/crate.scm (lookup-crate*): New procedure. (crate->guix-package): Memorize package metadata lookups. (crate-recursive-import): Memorize package creation. --- guix/import/crate.scm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 9c93a80fbd..0a88e30e8f 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -27,6 +27,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) @@ -110,6 +111,8 @@ record or #f if it was not found." (json->crate `(,@alist ("actual_versions" . ,versions)))))))) +(define lookup-crate* (memoize lookup-crate)) + (define (crate-version-dependencies version) "Return the list of <crate-dependency> records of VERSION, a <crate-version>." @@ -215,7 +218,7 @@ latest version of CRATE-NAME." (eq? (crate-dependency-kind dependency) 'normal))) (define crate - (lookup-crate crate-name)) + (lookup-crate* crate-name)) (define version-number (and crate @@ -265,7 +268,7 @@ latest version of CRATE-NAME." (define* (crate-recursive-import crate-name #:key version) (recursive-import crate-name - #:repo->guix-package crate->guix-package + #:repo->guix-package (memoize crate->guix-package) #:version version #:guix-name crate-name->package-name)) -- 2.29.2 [-- Attachment #6: 0003-import-crate-Use-guile-semver-to-resolve-module-vers.patch --] [-- Type: text/x-patch, Size: 29234 bytes --] From 10a2c699f28daa29f434fbd4fa0e67fbbac4224b Mon Sep 17 00:00:00 2001 From: Martin Becze <mjbecze@riseup.net> Date: Tue, 10 Nov 2020 22:39:30 +0100 Subject: [PATCH 3/7] import: crate: Use guile-semver to resolve module versions. * guix/import/crate.scm: Add guile-semver as a soft dependency. (make-crate-sexp): Don't allow other keys. Add '#: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. Treat "build" dependencies as normal dependencies. Add key "repo" and make "name" a key. (crate-name->package-name): Reuse the procedure 'guix-name' instead of duplicating its logic. (crate-recursive-import): Use (crate->guix-package) directly since it now takes the correct arguments. * guix/import/utils.scm (package-names->package-inputs): Implement handling of (name version) pairs. * guix/scripts/import/crate.scm (guix-import-crate): Remove the public definitions since the are now returned by (crate-recursive-import). * tests/crate.scm: (recursive-import) Add version data to the test. --- guix/import/crate.scm | 89 +++++---- guix/import/utils.scm | 21 ++- guix/scripts/import/crate.scm | 11 +- tests/crate.scm | 330 +++++++++++++++++++--------------- 4 files changed, 261 insertions(+), 190 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 8c2b76cab4..9c93a80fbd 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 <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -37,6 +37,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 @@ -85,10 +86,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 <crate> record or #f if it was not found." @@ -142,16 +148,22 @@ 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 - #:allow-other-keys) + home-page synopsis description license) "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) @@ -163,7 +175,8 @@ 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))) (home-page ,(match home-page @@ -176,7 +189,7 @@ and LICENSE." ((license) license) (_ `(list ,@license))))))) (close-port port) - pkg)) + (package->definition pkg #t))) (define (string->license string) (filter-map (lambda (license) @@ -187,14 +200,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 repo) "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,22 +222,34 @@ latest version of CRATE-NAME." (or version (crate-latest-version crate)))) + ;; finds the a version of a crate that fulfills the semver <range> + (define (find-version crate range) + (find (lambda (version) + (semver-range-contains-string? + range + (crate-version-number version))) + (crate-versions crate))) + (define version* (and crate - (find (lambda (version) - (string=? (crate-version-number version) - version-number)) - (crate-versions crate)))) + (find-version crate version-number))) + + ;; maps the dependencies to a list containing pairs of (name version) + (define (map-dependencies deps) + (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)) (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<?))) + (let* ((dependencies (crate-version-dependencies version*)) + (dep-crates dev-dep-crates (partition normal-dependency? dependencies)) + (cargo-inputs (map-dependencies dep-crates)) + (cargo-development-inputs '())) (values (make-crate-sexp #:name crate-name #:version (crate-version-number version*) @@ -233,13 +263,10 @@ latest version of CRATE-NAME." string->license)) (append cargo-inputs cargo-development-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) @@ -254,7 +281,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)) \f ;;; diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 9213eca8a0..66445f006f 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -229,13 +229,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 <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; 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 61a04f986b..beaa696be0 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,8 +37,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"foo\", \"num\": \"1.0.0\", @@ -54,8 +55,9 @@ "{ \"dependencies\": [ { - \"crate_id\": \"bar\", - \"kind\": \"normal\" + \"crate_id\": \"leaf-alice\", + \"kind\": \"normal\", + \"req\": \"1.0.0\" } ] }") @@ -68,8 +70,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"foo\", \"num\": \"1.0.0\", @@ -87,19 +89,23 @@ \"dependencies\": [ { \"crate_id\": \"intermediate-1\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" }, { \"crate_id\": \"intermediate-2\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" } { \"crate_id\": \"leaf-alice\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" }, { \"crate_id\": \"leaf-bob\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" } ] }") @@ -112,8 +118,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"intermediate-1\", \"num\": \"1.0.0\", @@ -131,15 +137,18 @@ \"dependencies\": [ { \"crate_id\": \"intermediate-2\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" }, { \"crate_id\": \"leaf-alice\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" }, { \"crate_id\": \"leaf-bob\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" } ] }") @@ -152,8 +161,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"intermediate-2\", \"num\": \"1.0.0\", @@ -171,7 +180,8 @@ \"dependencies\": [ { \"crate_id\": \"leaf-bob\", - \"kind\": \"normal\" + \"kind\": \"normal\", + \"req\": \"1.0.0\" } ] }") @@ -184,8 +194,8 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], - \"categories\": [\"test\"] + \"keywords\": [\"dummy\", \"test\"], + \"categories\": [\"test\"], \"actual_versions\": [ { \"id\": \"leaf-alice\", \"num\": \"1.0.0\", @@ -211,7 +221,7 @@ \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", - \"keywords\": [\"dummy\" \"test\"], + \"keywords\": [\"dummy\", \"test\"], \"categories\": [\"test\"] \"actual_versions\": [ { \"id\": \"leaf-bob\", @@ -253,34 +263,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. @@ -335,105 +359,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.29.2 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v16 3/6] import: crate: Use guile-semver to resolve module versions. 2020-11-17 21:43 ` [bug#38408] [PATCH v16 3/6] import: crate: Use guile-semver to resolve module versions Martin Becze @ 2020-11-17 21:51 ` Martin Becze 2020-11-18 7:56 ` Hartmut Goebel 0 siblings, 1 reply; 107+ messages in thread From: Martin Becze @ 2020-11-17 21:51 UTC (permalink / raw) To: Hartmut Goebel, 38408 Hartmut, I just saw you v17 I think that is probably better then what I have attached. On 11/17/20 3:43 PM, Martin Becze wrote: > > > On 11/10/20 4:13 PM, Hartmut Goebel wrote: >> Please add a brief change description for crate-recursive-import. > > Done > >> > >> I could not spot this change. has this been reverted in one of the many > >> version of this series? > > > I added a better description in the attached commit. > >> Does this still fetch the latest version? Or is it the latest version > >> matching a semver range, or the latest non-beta version? > > > The latest version including beta versions > >> Is this change in the last line intended? Another patch of this series > >> reverts this change. > > No, nice catch. Changing this creates conflicts so I will update the > patch set. > >> Does this still fetch the latest version? Or is it the latest version > >> matching a semver range, or the latest non-beta version? > > > I will add more advance tests in a separate commit at the end. > > Attached is the updated patch set. I believe it address everything > brought up but please let me know if there is anything else. Thanks a > lot for looking at this. ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v16 3/6] import: crate: Use guile-semver to resolve module versions. 2020-11-17 21:51 ` Martin Becze @ 2020-11-18 7:56 ` Hartmut Goebel 0 siblings, 0 replies; 107+ messages in thread From: Hartmut Goebel @ 2020-11-18 7:56 UTC (permalink / raw) To: Martin Becze, 38408 Hi Martin, looks like we did similar work in parallel. Sorry for that. I'm a bit impatient on this topic so I continued working on this as I did not hear anything from you. > Hartmut, I just saw you v17 I think that is probably better then what > I have attached. Anyhow, I'll check your patches (will take some time) and eventually merge with v17. Anyhow (again): Without your previous work, I would not have been able to make my changes. Standing on the shoulders of a Giant ;-) -- Regards Hartmut Goebel | Hartmut Goebel | h.goebel@crazy-compilers.com | | www.crazy-compilers.com | compilers which you thought are impossible | ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v16 4/6] import: crate: Memorize crate->guix-package. 2020-11-10 21:39 [bug#44560] [PATCH v16 0/6] New take on: Semantic version aware recursive importer for crates Hartmut Goebel ` (2 preceding siblings ...) 2020-11-10 21:39 ` [bug#38408] [PATCH v16 3/6] import: crate: Use guile-semver to resolve module versions Hartmut Goebel @ 2020-11-10 21:39 ` Hartmut Goebel 2020-11-10 21:39 ` [bug#38408] [PATCH v16 5/6] import: utils: Trim patch version from names Hartmut Goebel ` (2 subsequent siblings) 6 siblings, 0 replies; 107+ messages in thread From: Hartmut Goebel @ 2020-11-10 21:39 UTC (permalink / raw) To: 38408; +Cc: Martin Becze From: Martin Becze <mjbecze@riseup.net> This adds memorization to procedures that involve network lookups. 'lookup-crate*' is used on every dependency of a package to get its version list. It is also used to lookup a package's metadata. 'crate-recursive-import' is also memorized since creating the same package twice will trigger a lookup on its dependencies. * guix/import/crate.scm (lookup-crate*): New procedure. (crate->guix-package): Memorize package metadata lookups. (crate-recursive-import): Memorize package creation. --- guix/import/crate.scm | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 0802ecd315..4c36a32442 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -27,6 +27,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) @@ -110,6 +111,8 @@ record or #f if it was not found." (json->crate `(,@alist ("actual_versions" . ,versions)))))))) +(define lookup-crate* (memoize lookup-crate)) + (define (crate-version-dependencies version) "Return the list of <crate-dependency> records of VERSION, a <crate-version>." @@ -215,7 +218,7 @@ latest version of CRATE-NAME." (eq? (crate-dependency-kind dependency) 'normal))) (define crate - (lookup-crate crate-name)) + (lookup-crate* crate-name)) (define version-number (and crate @@ -239,7 +242,7 @@ latest version of CRATE-NAME." (define (sort-map-dependencies deps) (sort (map (lambda (dep) (let* ((name (crate-dependency-id dep)) - (crate (lookup-crate name)) + (crate (lookup-crate* name)) (req (crate-dependency-requirement dep)) (ver (find-version crate req))) (list name @@ -268,7 +271,7 @@ latest version of CRATE-NAME." (define* (crate-recursive-import crate-name #:key version) (recursive-import crate-name - #:repo->guix-package crate->guix-package + #:repo->guix-package (memoize crate->guix-package) #:version version #:guix-name crate-name->package-name)) -- 2.21.3 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v16 5/6] import: utils: Trim patch version from names. 2020-11-10 21:39 [bug#44560] [PATCH v16 0/6] New take on: Semantic version aware recursive importer for crates Hartmut Goebel ` (3 preceding siblings ...) 2020-11-10 21:39 ` [bug#38408] [PATCH v16 4/6] import: crate: Memorize crate->guix-package Hartmut Goebel @ 2020-11-10 21:39 ` Hartmut Goebel 2020-11-10 21:39 ` [bug#38408] [PATCH v16 6/6] import: crate: Parameterized importing of dev dependencies Hartmut Goebel 2020-11-10 22:24 ` [bug#38408] [PATCH v16 0/6] New take on: Semantic version aware recursive importer for crates Hartmut Goebel 6 siblings, 0 replies; 107+ messages in thread From: Hartmut Goebel @ 2020-11-10 21:39 UTC (permalink / raw) To: 38408; +Cc: Martin Becze From: Martin Becze <mjbecze@riseup.net> This remove the patch version from generated package 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, 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 10eb030188..b74393e617 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -269,9 +269,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 beaa696be0..65d5ac3389 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -280,7 +280,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 @@ -296,7 +296,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") @@ -359,7 +359,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)) @@ -378,7 +378,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)) @@ -397,7 +397,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)) @@ -414,13 +414,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)) @@ -437,17 +437,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)) @@ -464,14 +464,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.21.3 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v16 6/6] import: crate: Parameterized importing of dev dependencies. 2020-11-10 21:39 [bug#44560] [PATCH v16 0/6] New take on: Semantic version aware recursive importer for crates Hartmut Goebel ` (4 preceding siblings ...) 2020-11-10 21:39 ` [bug#38408] [PATCH v16 5/6] import: utils: Trim patch version from names Hartmut Goebel @ 2020-11-10 21:39 ` Hartmut Goebel 2020-11-10 22:21 ` Hartmut Goebel 2020-11-10 22:24 ` [bug#38408] [PATCH v16 0/6] New take on: Semantic version aware recursive importer for crates Hartmut Goebel 6 siblings, 1 reply; 107+ messages in thread From: Hartmut Goebel @ 2020-11-10 21:39 UTC (permalink / raw) To: 38408; +Cc: Martin Becze From: Martin Becze <mjbecze@riseup.net> The recursive crate importer will now include development dependencies only for the top level package, but not for any of the recursively imported packages. * 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 | 27 +++++++++++++++++++-------- guix/scripts/import/crate.scm | 4 ++-- tests/crate.scm | 3 +-- 3 files changed, 22 insertions(+), 12 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 4c36a32442..bdfbc6833c 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -151,7 +151,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?) "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." @@ -178,7 +178,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))) @@ -203,11 +205,12 @@ and LICENSE." 'unknown-license!))) (string-split string (string->char-set " /")))) -(define* (crate->guix-package crate-name #:key version repo) +(define* (crate->guix-package crate-name #:key version include-dev-deps? repo) "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) @@ -255,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-dependencies dep-crates)) - (cargo-development-inputs '())) + (cargo-development-inputs (if include-dev-deps? + (sort-map-dependencies 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 @@ -267,11 +273,16 @@ 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* (crate-recursive-import crate-name #:key version) (recursive-import crate-name - #:repo->guix-package (memoize 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)) + (crate->guix-package* (memoize crate->guix-package))) + (apply 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 65d5ac3389..76bd3707df 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -462,8 +462,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.21.3 ^ permalink raw reply related [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v16 6/6] import: crate: Parameterized importing of dev dependencies. 2020-11-10 21:39 ` [bug#38408] [PATCH v16 6/6] import: crate: Parameterized importing of dev dependencies Hartmut Goebel @ 2020-11-10 22:21 ` Hartmut Goebel 0 siblings, 0 replies; 107+ messages in thread From: Hartmut Goebel @ 2020-11-10 22:21 UTC (permalink / raw) To: Martin Becze; +Cc: 38408 Am 10.11.20 um 22:39 schrieb Hartmut Goebel: > @@ -255,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-dependencies dep-crates)) > - (cargo-development-inputs '())) > + (cargo-development-inputs (if include-dev-deps? > + (sort-map-dependencies dev-dep-crates) > + '()))) > (values > - (make-crate-sexp #:name crate-name > + (make-crate-sexp #:build? include-dev-deps? > + #:name crate-name I'm curious about this: The value of "include-dev-deps?" determines whether the the package will be have #:skip-build set #t or #f? If this is intended, it should be described in the doc-string and in the changelog. > --- 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)))) This last line change looks like an error. Is it intended? -- Regards Hartmut Goebel | Hartmut Goebel | h.goebel@crazy-compilers.com | | www.crazy-compilers.com | compilers which you thought are impossible | ^ permalink raw reply [flat|nested] 107+ messages in thread
* [bug#38408] [PATCH v16 0/6] New take on: Semantic version aware recursive importer for crates 2020-11-10 21:39 [bug#44560] [PATCH v16 0/6] New take on: Semantic version aware recursive importer for crates Hartmut Goebel ` (5 preceding siblings ...) 2020-11-10 21:39 ` [bug#38408] [PATCH v16 6/6] import: crate: Parameterized importing of dev dependencies Hartmut Goebel @ 2020-11-10 22:24 ` Hartmut Goebel 6 siblings, 0 replies; 107+ messages in thread From: Hartmut Goebel @ 2020-11-10 22:24 UTC (permalink / raw) To: 38408 Am 10.11.20 um 22:39 schrieb Hartmut Goebel: > * Major design decision open: Shall package variable names have sem semver > version appended instead of major+minor? I propose to only append the semver version, e.g. "rust-aaa-1" instread of "rust-aaa-1.3". To finish this patch series, I suggest putting this change into another patch. -- Regards Hartmut Goebel | Hartmut Goebel | h.goebel@crazy-compilers.com | | www.crazy-compilers.com | compilers which you thought are impossible | ^ permalink raw reply [flat|nested] 107+ messages in thread
end of thread, other threads:[~2020-12-02 21:49 UTC | newest] Thread overview: 107+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2020-11-10 21:39 [bug#44560] [PATCH v16 0/6] New take on: Semantic version aware recursive importer for crates Hartmut Goebel 2020-11-10 21:39 ` [bug#38408] [PATCH v16 1/6] import: utils: 'recursive-import' accepts an optional version parameter Hartmut Goebel 2020-11-10 21:39 ` [bug#38408] [PATCH v16 2/6] guix: self: Add guile-semver as a depenedency Hartmut Goebel 2020-11-10 21:39 ` [bug#38408] [PATCH v16 3/6] import: crate: Use guile-semver to resolve module versions Hartmut Goebel 2020-11-10 22:13 ` Hartmut Goebel 2019-11-28 0:13 ` [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates Martin Becze 2019-11-28 0:16 ` [bug#38408] [PATCH 1/3] gnu: added new function, find-packages-by-name*/direct Martin Becze 2019-11-28 0:16 ` [bug#38408] [PATCH 2/3] gnu: added new procedure, recusive-import-semver Martin Becze 2019-11-28 0:16 ` [bug#38408] [PATCH 3/3] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test Martin Becze 2019-11-30 16:36 ` Martin Becze 2019-12-01 9:00 ` Efraim Flashner 2019-12-05 20:05 ` [bug#38408] [PATCH v2 0/5] Semantic version aware recusive importer for crates Martin Becze 2019-12-05 20:05 ` [bug#38408] [PATCH v2 1/5] gnu: added new function, find-packages-by-name*/direct Martin Becze 2019-12-05 20:05 ` [bug#38408] [PATCH v2 2/5] gnu: added new procedure, recusive-import-semver Martin Becze 2019-12-05 20:05 ` [bug#38408] [PATCH v2 3/5] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test Martin Becze 2019-12-05 20:05 ` [bug#38408] [PATCH v2 4/5] added "#:skip-build? #t" to the output of (make-crate-sexp). Most the the packages imported will be libaries and won't need to build. The top level package will build them though Martin Becze 2019-12-05 20:05 ` [bug#38408] [PATCH v2 5/5] guix: crate: Depublicated build and normal dependencies Martin Becze 2019-12-06 18:21 ` [bug#38408] [PATCH v3 0/5] Semantic version aware recusive importer for crates Martin Becze 2019-12-06 18:21 ` [bug#38408] [PATCH v3 1/5] gnu: added new function, find-packages-by-name*/direct Martin Becze 2019-12-06 18:21 ` [bug#38408] [PATCH v3 2/5] gnu: added new procedure, recusive-import-semver Martin Becze 2019-12-06 18:21 ` [bug#38408] [PATCH v3 3/5] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test Martin Becze 2019-12-06 18:21 ` [bug#38408] [PATCH v3 4/5] added "#:skip-build? #t" to the output of (make-crate-sexp). Most the the packages imported will be libaries and won't need to build. The top level package will build them though Martin Becze 2019-12-06 18:21 ` [bug#38408] [PATCH v3 5/5] guix: crate: Depublicated dependencies Martin Becze 2019-12-10 19:23 ` [bug#38408] [PATCH v4 0/6] Semantic version aware recusive importer for crates Martin Becze 2019-12-10 19:23 ` [bug#38408] [PATCH v4 1/6] gnu: added new function, find-packages-by-name*/direct Martin Becze 2019-12-19 22:00 ` Ludovic Courtès 2019-12-20 18:37 ` Martin Becze 2019-12-27 18:38 ` Ludovic Courtès 2020-01-18 16:40 ` [bug#38408] [PATCH v6] Semantic version aware recusive importer for crates Martin Becze 2019-12-10 19:23 ` [bug#38408] [PATCH v4 2/6] gnu: added new procedure, recusive-import-semver Martin Becze 2019-12-19 22:07 ` Ludovic Courtès 2019-12-20 18:46 ` Martin Becze 2019-12-10 19:23 ` [bug#38408] [PATCH v4 3/6] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test Martin Becze 2019-12-10 19:23 ` [bug#38408] [PATCH v4 4/6] added "#:skip-build? #t" to the output of (make-crate-sexp). Most the the packages imported will be libaries and won't need to build. The top level package will build them though Martin Becze 2019-12-10 19:23 ` [bug#38408] [PATCH v4 5/6] guix: crate: Depublicated dependencies Martin Becze 2019-12-10 19:23 ` [bug#38408] [PATCH v4 6/6] guix: import: recursive-import-semver: allow the range of a package to be specified when begining import Martin Becze 2019-12-16 23:30 ` [bug#38408] Rewrote recursive-import-semver based on topological-sort Martin Becze 2020-02-04 12:18 ` [bug#38408] [PATCH v9 0/8] recursive semver crate importer! Martin Becze 2020-02-04 12:18 ` [bug#38408] [PATCH v9 1/8] guix: import: (recursive-import) Allow for version numbers Martin Becze 2020-02-17 10:03 ` Efraim Flashner 2020-02-04 12:18 ` [bug#38408] [PATCH v9 2/8] guix: import: crate: Use semver to resovle module versions Martin Becze 2020-02-17 14:35 ` Ludovic Courtès 2020-02-17 14:57 ` Efraim Flashner 2020-02-17 15:37 ` Ludovic Courtès 2020-02-18 8:56 ` Martin Becze 2020-02-04 12:18 ` [bug#38408] [PATCH v9 3/8] Added Guile-Semver as a dependency to guix Martin Becze 2020-02-17 10:03 ` Efraim Flashner 2020-02-17 14:36 ` Ludovic Courtès 2020-02-18 9:30 ` Martin Becze 2020-02-20 9:40 ` Ludovic Courtès 2020-02-20 16:54 ` Martin Becze 2020-02-21 9:01 ` Ludovic Courtès 2020-02-21 16:25 ` Martin Becze 2020-02-21 16:27 ` Leo Famulari 2020-02-23 20:34 ` Martin Becze 2020-02-23 21:05 ` Martin Becze 2020-03-11 20:20 ` Martin Becze 2020-03-21 18:35 ` Martin Becze 2020-03-22 19:26 ` Leo Famulari 2020-03-22 20:10 ` Leo Famulari 2020-03-23 9:50 ` Martin Becze 2020-03-23 16:28 ` Martin Becze 2020-03-24 10:18 ` Ludovic Courtès 2020-03-24 14:19 ` Martin Becze 2020-03-24 19:00 ` Martin Becze 2020-04-12 15:07 ` Martin Becze 2020-04-12 16:59 ` Ludovic Courtès 2020-04-17 14:57 ` Martin Becze 2020-04-29 19:50 ` Martin Becze 2020-04-29 19:51 ` Martin Becze 2020-05-08 19:57 ` Martin Becze 2020-08-18 9:44 ` Martin Becze 2020-07-05 0:23 ` Jakub Kądziołka 2020-02-04 12:18 ` [bug#38408] [PATCH v9 4/8] guix: import: utils: allow generation of inputs to be version aware Martin Becze 2020-02-04 12:18 ` [bug#38408] [PATCH v9 5/8] guix: import: crate: deduplicate dependencies Martin Becze 2020-02-04 12:18 ` [bug#38408] [PATCH v9 6/8] guix: import: crate: memorize crate->guix-package Martin Becze 2020-02-04 12:18 ` [bug#38408] [PATCH v9 7/8] guix: import: utils: trim patch version from names Martin Becze 2020-02-04 12:18 ` [bug#38408] [PATCH v9 8/8] guix: import: parametrized importing of dev dependencies Martin Becze 2020-02-20 18:53 ` [bug#38408] [PATCH v9 0/8] recursive semver crate importer! Leo Famulari 2020-02-21 8:35 ` Martin Becze 2020-02-21 12:15 ` Efraim Flashner 2020-02-21 16:29 ` Martin Becze 2020-11-07 22:19 ` [bug#38408] [PATCH 0/3] (WIP) Semantic version aware recusive importer for crates Hartmut Goebel 2020-11-07 22:35 ` Marius Bakke 2020-11-09 17:15 ` Hartmut Goebel 2020-11-09 17:27 ` Nicolas Goaziou 2020-11-11 15:06 ` [bug#38408] [PATCH v16 3/6] import: crate: Use guile-semver to resolve module versions Timothy Sample 2020-11-16 19:07 ` [bug#44694] [PATCH v17 0/8] New take continued: Semantic version aware recursive Hartmut Goebel 2020-11-16 19:07 ` [bug#38408] [PATCH v17 1/8] guix: self: Add guile-semver as a depenedency Hartmut Goebel 2020-11-16 19:07 ` [bug#38408] [PATCH v17 2/8] import: utils: 'recursive-import' accepts an optional version parameter Hartmut Goebel 2020-11-16 19:07 ` [bug#38408] [PATCH v17 3/8] import: crate: Use guile-semver to resolve module versions Hartmut Goebel 2020-11-16 19:07 ` [bug#38408] [PATCH v17 4/8] import: crate: Memorize crate->guix-package Hartmut Goebel 2020-11-16 19:07 ` [bug#38408] [PATCH v17 5/8] import: crate: Parameterized importing of dev dependencies Hartmut Goebel 2020-11-16 19:07 ` [bug#38408] [PATCH v17 6/8] import: utils: Trim patch version from names Hartmut Goebel 2020-11-16 19:07 ` [bug#38408] [PATCH v17 7/8] import: crate: Trim version for names after left-most non-zero part Hartmut Goebel 2020-11-16 19:07 ` [bug#38408] [PATCH v17 8/8] import: crate: Use existing package satisfying semver requirement Hartmut Goebel 2020-11-17 21:54 ` [bug#38408] [PATCH v17 0/8] New take continued: Semantic version aware recursive Martin Becze 2020-12-02 21:13 ` bug#38408: " Hartmut Goebel 2020-12-02 21:48 ` [bug#38408] " Leo Famulari 2020-11-17 21:43 ` [bug#38408] [PATCH v16 3/6] import: crate: Use guile-semver to resolve module versions Martin Becze 2020-11-17 21:51 ` Martin Becze 2020-11-18 7:56 ` Hartmut Goebel 2020-11-10 21:39 ` [bug#38408] [PATCH v16 4/6] import: crate: Memorize crate->guix-package Hartmut Goebel 2020-11-10 21:39 ` [bug#38408] [PATCH v16 5/6] import: utils: Trim patch version from names Hartmut Goebel 2020-11-10 21:39 ` [bug#38408] [PATCH v16 6/6] import: crate: Parameterized importing of dev dependencies Hartmut Goebel 2020-11-10 22:21 ` Hartmut Goebel 2020-11-10 22:24 ` [bug#38408] [PATCH v16 0/6] New take on: Semantic version aware recursive importer for crates Hartmut Goebel
Code repositories for project(s) associated with this public inbox https://git.savannah.gnu.org/cgit/guix.git This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).