Thank you Ludo,
I added guile-semver to guix in the attached patch set, and I tested it
by running ./pre-inst-env guix environment guix, which installed the
guile-semver.
and Makefile.am may have to check whether guile-semver is available.)
I didn't see anything in the Makefile.am that looks to check for guile
modules. Let me know if anything needs fixing!
=Martin
>From e4b022ce72582691dadae1b9f31ad6243914a5db Mon Sep 17 00:00:00 2001
From: Martin Becze <mjbe...@riseup.net>
Date: Sat, 18 Jan 2020 05:05:03 -0500
Subject: [PATCH v7 1/3] 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 <rek...@elephly.net>
;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <l...@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othac...@gmail.com>
+;;; Copyright © 2020 Martin Becze <mjbe...@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 <be...@fbengineering.ch>
;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <l...@gnu.org>
;;; Copyright © 2018 Oleg Pykhalov <go.wig...@gmail.com>
+;;; Copyright © 2020 Martin Becze <mjbe...@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 <da...@gnu.org>
;;; Copyright © 2016 Ben Woodcroft <donttrust...@gmail.com>
;;; Copyright © 2018 Oleg Pykhalov <go.wig...@gmail.com>
+;;; Copyright © 2020 Martin Becze <mjbe...@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 <jul...@lepiller.eu>
+;;; Copyright © 2020 Martin Becze <mjbe...@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.othac...@gmail.com>
;;; Copyright © 2018 Ricardo Wurmus <rek...@elephly.net>
;;; Copyright © 2019 Maxim Cournoyer <maxim.courno...@gmail.com>
+;;; Copyright © 2020 Martin Becze <mjbe...@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 <be...@fbengineering.ch>
;;; Copyright © 2018 Ricardo Wurmus <rek...@elephly.net>
+;;; Copyright © 2020 Martin Becze <mjbe...@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 <rek...@elephly.net>
;;; Copyright © 2018 Oleg Pykhalov <go.wig...@gmail.com>
;;; Copyright © 2019 Robert Vollmert <r...@vllmrt.net>
+;;; Copyright © 2020 Martin Becze <mjbe...@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 <bav...@member.fsf.org>
;;; Copyright © 2015, 2017, 2019 Ricardo Wurmus <rek...@elephly.net>
+;;; Copyright © 2020 Martin Becze <mjbe...@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 <be...@fbengineering.ch>
;;; Copyright © 2018 Oleg Pykhalov <go.wig...@gmail.com>
+;;; Copyright © 2020 Martin Becze <mjbe...@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 <rek...@elephly.net>
;;; Copyright © 2016 Ben Woodcroft <donttrust...@gmail.com>
+;;; Copyright © 2020 Martin Becze <mjbe...@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
>From 3ecb0a58a6d2fbb30e36d9fa3648afe932f6e465 Mon Sep 17 00:00:00 2001
From: Martin Becze <mjbe...@riseup.net>
Date: Sat, 18 Jan 2020 10:44:18 -0500
Subject: [PATCH v7 2/3] 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 <da...@craven.ch>
;;; Copyright © 2019, 2020 Ludovic Courtès <l...@gnu.org>
-;;; Copyright © 2019 Martin Becze <mjbe...@riseup.net>
+;;; Copyright © 2019, 2020 Martin Becze <mjbe...@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)))
;;;
@@ -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 <da...@gnu.org>
;;; Copyright © 2016 David Craven <da...@craven.ch>
-;;; Copyright © 2019 Martin Becze <mjbe...@riseup.net>
+;;; Copyright © 2019, 2020 Martin Becze <mjbe...@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 <da...@gnu.org>
;;; Copyright © 2016 David Craven <da...@craven.ch>
;;; Copyright © 2019, 2020 Ludovic Courtès <l...@gnu.org>
+;;; Copyright © 2020 Martin Becze <mjbe...@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 <be...@fbengineering.ch>
;;; Copyright © 2020 Ludovic Courtès <l...@gnu.org>
+;;; Copyright © 2020 Martin Becze <mjbe...@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
>From c68ac6dc2ae5c3e2ffbbccfd05ad14e9eb3fda60 Mon Sep 17 00:00:00 2001
From: Martin Becze <mjbe...@riseup.net>
Date: Sat, 25 Jan 2020 04:57:13 -0500
Subject: [PATCH v7 3/3] 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
---
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 d674b9484f..eb6d980bca 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
@@ -761,6 +762,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 <bav...@member.fsf.org>
;;; Copyright © 2019, 2020 Efraim Flashner <efr...@flashner.co.il>
;;; Copyright © 2019 Jonathan Brielmaier <jonathan.brielma...@web.de>
+;;; Copyright © 2020 Martin Becze <mjbe...@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