ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix: import: Optionally import necessary yanked crates.

Browse source 
* doc/guix.texi (Invoking guix import): Mention '--allow-yanked'.
* guix/import/crate.scm (make-crate-sexp): Add yanked? argument. For
yanked packages, use the full version suffixed by "-yanked" for
generated variable names and add a comment and package property.
(crate->guix-package): Add allow-yanked? argument and if it is set to #t,
allow importing yanked crates if no other version matching the
requirements exists.
[find-package-version]: Packages previously marked as yanked are only
included if allow-yanked? is #t and then take the lowest priority.
[find-crate-version]: If allow-yanked? is #t, also consider yanked
versions with the lowest priority.
[dependency-name+version]: Rename to ...
[dependency-name+version+yanked] ...this. Honor allow-yanked? and choose
between an existing package and an upstream package.  Exit with an error
message if no version fulfilling the requirement is found.
[version*]: Exit with an error message if the crate version is not found.
(cargo-recursive-import): Add allow-yanked? argument.
* guix/read-print.scm: Export <comment>.
* guix/scripts/import/crate.scm: Add "--allow-yanked".
* tests/crate.scm: Add test 'crate-recursive-import-only-yanked-available'.
[sort-map-dependencies]: Adjust accordingly.
[remove-yanked-info]: New variable.
Adjust test 'crate-recursive-import-honors-existing-packages'.
(test-bar-dependencies): Add yanked dev-dependencies.
(test-leaf-bob-crate): Add yanked versions.
(rust-leaf-bob-3.0.2-yanked): New variable.

Signed-off-by: Efraim Flashner <efraim@flashner.co.il>
Change-Id: I175d89b39774e6b57dcd1f05bf68718d23866bb7
This commit is contained in:
David Elsing 2023-12-21 22:01:52 +00:00 committed by Efraim Flashner
parent 53add91be6
commit b26926189e
No known key found for this signature in database
GPG key ID: 41AAE7DCCA3D8351
5 changed files with 309 additions and 39 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
doc/guix.texi
View file

@ -14589,6 +14589,9 @@ in Guix.
If @option{--recursive-dev-dependencies} is specified, also the recursively If @option{--recursive-dev-dependencies} is specified, also the recursively
imported packages contain their development dependencies, which are recursively imported packages contain their development dependencies, which are recursively
imported as well. imported as well.
@item --allow-yanked
If no non-yanked version of a crate is available, use the latest yanked
version instead instead of aborting.
@end table @end table
@item elm @item elm

137
guix/import/crate.scm
View file

@ -26,12 +26,15 @@
(define-module (guix import crate) (define-module (guix import crate)
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (guix build-system cargo) #:use-module (guix build-system cargo)
#:use-module (guix diagnostics)
#:use-module (gcrypt hash) #:use-module (gcrypt hash)
#:use-module (guix http-client) #:use-module (guix http-client)
#:use-module (guix i18n)
#:use-module (guix import json) #:use-module (guix import json)
#:use-module (guix import utils) #:use-module (guix import utils)
#:use-module (guix memoization) #:use-module (guix memoization)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix read-print)
#:use-module (guix upstream) #:use-module (guix upstream)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (gnu packages) #:use-module (gnu packages)
@ -41,6 +44,7 @@ (define-module (guix import crate)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-2) #:use-module (srfi srfi-2)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-69)
#:use-module (srfi srfi-71) #:use-module (srfi srfi-71)
#:export (crate->guix-package #:export (crate->guix-package
guix-package->crate-name guix-package->crate-name
@ -100,7 +104,7 @@ (define-json-mapping <crate-dependency> make-crate-dependency
;; Autoload Guile-Semver so we only have a soft dependency. ;; Autoload Guile-Semver so we only have a soft dependency.
(module-autoload! (current-module) (module-autoload! (current-module)
'(semver) '(string->semver semver->string semver<?)) '(semver) '(string->semver semver->string semver<? semver=?))
(module-autoload! (current-module) (module-autoload! (current-module)
'(semver ranges) '(string->semver-range semver-range-contains?)) '(semver ranges) '(string->semver-range semver-range-contains?))
@ -165,16 +169,18 @@ (define (version->semver-prefix version)
(list-matches "^(0+\\.){,2}[0-9]+" version)))) (list-matches "^(0+\\.){,2}[0-9]+" version))))
(define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inputs (define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inputs
home-page synopsis description license build?) home-page synopsis description license build? yanked?)
"Return the `package' s-expression for a rust package with the given NAME, "Return the `package' s-expression for a rust package with the given NAME,
VERSION, CARGO-INPUTS, CARGO-DEVELOPMENT-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION, VERSION, CARGO-INPUTS, CARGO-DEVELOPMENT-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION,
and LICENSE." and LICENSE."
(define (format-inputs inputs) (define (format-inputs inputs)
(map (map
(match-lambda (match-lambda
((name version) ((name version yanked)
(list (crate-name->package-name name) (list (crate-name->package-name name)
(version->semver-prefix version)))) (if yanked
(string-append version "-yanked")
(version->semver-prefix version)))))
inputs)) inputs))
(let* ((port (http-fetch (crate-uri name version))) (let* ((port (http-fetch (crate-uri name version)))
@ -184,6 +190,9 @@ (define (format-inputs inputs)
(pkg `(package (pkg `(package
(name ,guix-name) (name ,guix-name)
(version ,version) (version ,version)
,@(if yanked?
`(,(comment "; This version was yanked!\n" #t))
'())
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (crate-uri ,name version)) (uri (crate-uri ,name version))
@ -191,6 +200,9 @@ (define (format-inputs inputs)
(sha256 (sha256
(base32 (base32
,(bytevector->nix-base32-string (port-sha256 port)))))) ,(bytevector->nix-base32-string (port-sha256 port))))))
,@(if yanked?
`((properties '((crate-version-yanked? . #t))))
'())
(build-system cargo-build-system) (build-system cargo-build-system)
,@(maybe-arguments (append (if build? ,@(maybe-arguments (append (if build?
'() '()
@ -207,7 +219,10 @@ (define (format-inputs inputs)
((license) license) ((license) license)
(_ `(list ,@license))))))) (_ `(list ,@license)))))))
(close-port port) (close-port port)
(package->definition pkg (version->semver-prefix version)))) (package->definition pkg
(if yanked?
(string-append version "-yanked")
(version->semver-prefix version)))))
(define (string->license string) (define (string->license string)
(filter-map (lambda (license) (filter-map (lambda (license)
@ -218,13 +233,14 @@ (define (string->license string)
'unknown-license!))) 'unknown-license!)))
(string-split string (string->char-set " /")))) (string-split string (string->char-set " /"))))
(define* (crate->guix-package crate-name #:key version include-dev-deps? (define* (crate->guix-package
#:allow-other-keys) crate-name
#:key version include-dev-deps? allow-yanked? #:allow-other-keys)
"Fetch the metadata for CRATE-NAME from crates.io, and return the "Fetch the metadata for CRATE-NAME from crates.io, and return the
`package' s-expression corresponding to that package, or #f on failure. `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 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 the latest version matching this semver range; otherwise fetch the latest
version of CRATE-NAME. If INCLUDE-DEV-DEPS is true then this will also version of CRATE-NAME. If INCLUDE-DEV-DEPS is true then this will also
look up the development dependencs for the given crate." look up the development dependencs for the given crate."
(define (semver-range-contains-string? range version) (define (semver-range-contains-string? range version)
@ -243,63 +259,112 @@ (define version-number
(or version (or version
(crate-latest-version crate)))) (crate-latest-version crate))))
;; find the highest existing package that fulfills the semver <range> ;; Find the highest existing package that fulfills the semver <range>.
;; Packages previously marked as yanked take lower priority.
(define (find-package-version name range) (define (find-package-version name range)
(let* ((semver-range (string->semver-range range)) (let* ((semver-range (string->semver-range range))
(versions (package-versions
(sort (sort
(filter (lambda (version) (filter (match-lambda ((semver yanked)
(semver-range-contains? semver-range version)) (and
(or allow-yanked? (not yanked))
(semver-range-contains? semver-range semver))))
(map (lambda (pkg) (map (lambda (pkg)
(string->semver (package-version pkg))) (let ((version (package-version pkg)))
(list
(string->semver version)
(assoc-ref (package-properties pkg)
'crate-version-yanked?))))
(find-packages-by-name (find-packages-by-name
(crate-name->package-name name)))) (crate-name->package-name name))))
semver<?))) (match-lambda* (((semver1 yanked1) (semver2 yanked2))
(and (not (null-list? versions)) (or (and yanked1 (not yanked2))
(semver->string (last versions))))) (and (eq? yanked1 yanked2)
(semver<? semver1 semver2))))))))
(and (not (null-list? package-versions))
(match-let (((semver yanked) (last package-versions)))
(list (semver->string semver) yanked)))))
;; Find the highest version of a crate that fulfills the semver <range> ;; Find the highest version of a crate that fulfills the semver <range>.
;; and hasn't been yanked. ;; If no matching non-yanked version has been found and allow-yanked? is #t,
;; also consider yanked packages.
(define (find-crate-version crate range) (define (find-crate-version crate range)
(let* ((semver-range (string->semver-range range)) (let* ((semver-range (string->semver-range range))
(versions (versions
(sort (sort
(filter (lambda (entry) (filter (lambda (entry)
(and (and
(not (crate-version-yanked? (second entry))) (or allow-yanked?
(not (crate-version-yanked? (second entry))))
(semver-range-contains? semver-range (first entry)))) (semver-range-contains? semver-range (first entry))))
(map (lambda (ver) (map (lambda (ver)
(list (string->semver (crate-version-number ver)) (list (string->semver (crate-version-number ver))
ver)) ver))
(crate-versions crate))) (crate-versions crate)))
(match-lambda* (((semver _) ...) (match-lambda* (((semver ver) ...)
(apply semver<? semver)))))) (match-let (((yanked1 yanked2)
(map crate-version-yanked? ver)))
(or (and yanked1 (not yanked2))
(and (eq? yanked1 yanked2)
(apply semver<? semver)))))))))
(and (not (null-list? versions)) (and (not (null-list? versions))
(second (last versions))))) (second (last versions)))))
(define (dependency-name+version dep) ;; If no non-yanked existing package version was found, check the upstream
;; versions. If a non-yanked upsteam version exists, use it instead,
;; otherwise use the existing package version, provided it exists.
(define (dependency-name+version+yanked dep)
(let* ((name (crate-dependency-id dep)) (let* ((name (crate-dependency-id dep))
(req (crate-dependency-requirement dep)) (req (crate-dependency-requirement dep))
(existing-version (find-package-version name req))) (existing-version (find-package-version name req)))
(if existing-version (if (and existing-version (not (second existing-version)))
(list name existing-version) (cons name existing-version)
(let* ((crate (lookup-crate* name)) (let* ((crate (lookup-crate* name))
(ver (find-crate-version crate req))) (ver (find-crate-version crate req)))
(list name (if existing-version
(crate-version-number ver)))))) (if (and ver (not (crate-version-yanked? ver)))
(if (semver=? (string->semver (first existing-version))
(string->semver (crate-version-number ver)))
(begin
(warning (G_ "~A: version ~a is no longer yanked~%")
name (first existing-version))
(cons name existing-version))
(list name
(crate-version-number ver)
(crate-version-yanked? ver)))
(begin
(warning (G_ "~A: using existing version ~a, which was yanked~%")
name (first existing-version))
(cons name existing-version)))
(begin
(unless ver
(leave (G_ "~A: no version found for requirement ~a~%") name req))
(if (crate-version-yanked? ver)
(warning (G_ "~A: imported version ~a was yanked~%")
name (crate-version-number ver)))
(list name
(crate-version-number ver)
(crate-version-yanked? ver))))))))
(define version* (define version*
(and crate (and crate
(find-crate-version crate version-number))) (or (find-crate-version crate version-number)
(leave (G_ "~A: version ~a not found~%") crate-name version-number))))
;; sort and map the dependencies to a list containing ;; sort and map the dependencies to a list containing
;; pairs of (name version) ;; pairs of (name version)
(define (sort-map-dependencies deps) (define (sort-map-dependencies deps)
(sort (map dependency-name+version (sort (map dependency-name+version+yanked
deps) deps)
(match-lambda* (((name _) ...) (match-lambda* (((name _ _) ...)
(apply string-ci<? name))))) (apply string-ci<? name)))))
(define (remove-yanked-info deps)
(map
(match-lambda ((name version yanked)
(list name version)))
deps))
(if (and crate version*) (if (and crate version*)
(let* ((dependencies (crate-version-dependencies version*)) (let* ((dependencies (crate-version-dependencies version*))
(dep-crates dev-dep-crates (partition normal-dependency? dependencies)) (dep-crates dev-dep-crates (partition normal-dependency? dependencies))
@ -309,6 +374,7 @@ (define (sort-map-dependencies deps)
'()))) '())))
(values (values
(make-crate-sexp #:build? include-dev-deps? (make-crate-sexp #:build? include-dev-deps?
#:yanked? (crate-version-yanked? version*)
#:name crate-name #:name crate-name
#:version (crate-version-number version*) #:version (crate-version-number version*)
#:cargo-inputs cargo-inputs #:cargo-inputs cargo-inputs
@ -325,11 +391,13 @@ (define (sort-map-dependencies deps)
#:description (crate-description crate) #:description (crate-description crate)
#:license (and=> (crate-version-license version*) #:license (and=> (crate-version-license version*)
string->license)) string->license))
(append cargo-inputs cargo-development-inputs))) (append
(remove-yanked-info cargo-inputs)
(remove-yanked-info cargo-development-inputs))))
(values #f '()))) (values #f '())))
(define* (crate-recursive-import (define* (crate-recursive-import
crate-name #:key version recursive-dev-dependencies?) crate-name #:key version recursive-dev-dependencies? allow-yanked?)
(recursive-import (recursive-import
crate-name crate-name
#:repo->guix-package #:repo->guix-package
@ -340,7 +408,8 @@ (define* (crate-recursive-import
(or (equal? (car params) crate-name) (or (equal? (car params) crate-name)
recursive-dev-dependencies?))) recursive-dev-dependencies?)))
(apply crate->guix-package* (apply crate->guix-package*
(append params `(#:include-dev-deps? ,include-dev-deps?)))))) (append params `(#:include-dev-deps? ,include-dev-deps?
#:allow-yanked? ,allow-yanked?))))))
#:version version #:version version
#:guix-name crate-name->package-name)) #:guix-name crate-name->package-name))

1
guix/read-print.scm
View file

@ -46,6 +46,7 @@ (define-module (guix read-print)
page-break page-break
page-break? page-break?
<comment>
comment comment
comment? comment?
comment->string comment->string

14
guix/scripts/import/crate.scm
View file

@ -51,6 +51,10 @@ (define (show-help)
(display (G_ " (display (G_ "
--recursive-dev-dependencies --recursive-dev-dependencies
include dev-dependencies recursively")) include dev-dependencies recursively"))
(display (G_ "
--allow-yanked
allow importing yanked crates if no alternative
satisfying the version requirement exists"))
(newline) (newline)
(display (G_ " (display (G_ "
-h, --help display this help and exit")) -h, --help display this help and exit"))
@ -74,6 +78,9 @@ (define %options
(option '("recursive-dev-dependencies") #f #f (option '("recursive-dev-dependencies") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'recursive-dev-dependencies #t result))) (alist-cons 'recursive-dev-dependencies #t result)))
(option '("allow-yanked") #f #f
(lambda (opt name arg result)
(alist-cons 'allow-yanked #t result)))
%standard-import-options)) %standard-import-options))
@ -102,8 +109,11 @@ (define-values (name version)
(crate-recursive-import (crate-recursive-import
name #:version version name #:version version
#:recursive-dev-dependencies? #:recursive-dev-dependencies?
(assoc-ref opts 'recursive-dev-dependencies)) (assoc-ref opts 'recursive-dev-dependencies)
(crate->guix-package name #:version version #:include-dev-deps? #t)) #:allow-yanked? (assoc-ref opts 'allow-yanked))
(crate->guix-package
name #:version version #:include-dev-deps? #t
#:allow-yanked? (assoc-ref opts 'allow-yanked)))
((or #f '()) ((or #f '())
(leave (G_ "failed to download meta-data for package '~a'~%") (leave (G_ "failed to download meta-data for package '~a'~%")
(if version (if version

193
tests/crate.scm
View file

@ -28,6 +28,7 @@ (define-module (test-crate)
#:use-module ((gcrypt hash) #:use-module ((gcrypt hash)
#:select ((sha256 . gcrypt-sha256))) #:select ((sha256 . gcrypt-sha256)))
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix read-print)
#:use-module (guix tests) #:use-module (guix tests)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (ice-9 iconv) #:use-module (ice-9 iconv)
@ -42,6 +43,8 @@ (define-module (test-crate)
;; leaf-alice 0.7.5 ;; leaf-alice 0.7.5
;; bar-1.0.0 ;; bar-1.0.0
;; leaf-bob 3.0.1 ;; leaf-bob 3.0.1
;; leaf-bob 3.0.2 (dev-dependency)
;; leaf-bob 4.0.0 (dev-dependency)
;; ;;
;; root-1.0.0 ;; root-1.0.0
;; root-1.0.4 ;; root-1.0.4
@ -68,6 +71,8 @@ (define-module (test-crate)
;; leaf-alice-0.7.5 ;; leaf-alice-0.7.5
;; ;;
;; leaf-bob-3.0.1 ;; leaf-bob-3.0.1
;; leaf-bob-3.0.2 (yanked)
;; leaf-bob-4.0.0 (yanked)
(define test-foo-crate (define test-foo-crate
@ -150,6 +155,16 @@ (define test-bar-dependencies
\"crate_id\": \"leaf-bob\", \"crate_id\": \"leaf-bob\",
\"kind\": \"normal\", \"kind\": \"normal\",
\"req\": \"3.0.1\" \"req\": \"3.0.1\"
},
{
\"crate_id\": \"leaf-bob\",
\"kind\": \"dev\",
\"req\": \"^3.0.2\"
},
{
\"crate_id\": \"leaf-bob\",
\"kind\": \"dev\",
\"req\": \"^4.0.0\"
} }
] ]
}") }")
@ -398,6 +413,22 @@ (define test-leaf-bob-crate
\"dependencies\": \"/api/v1/crates/leaf-bob/3.0.1/dependencies\" \"dependencies\": \"/api/v1/crates/leaf-bob/3.0.1/dependencies\"
}, },
\"yanked\": false \"yanked\": false
},
{ \"id\": 234281,
\"num\": \"3.0.2\",
\"license\": \"MIT OR Apache-2.0\",
\"links\": {
\"dependencies\": \"/api/v1/crates/leaf-bob/3.0.2/dependencies\"
},
\"yanked\": true
},
{ \"id\": 234282,
\"num\": \"4.0.0\",
\"license\": \"MIT OR Apache-2.0\",
\"links\": {
\"dependencies\": \"/api/v1/crates/leaf-bob/4.0.0/dependencies\"
},
\"yanked\": true
} }
] ]
} }
@ -863,6 +894,18 @@ (define rust-leaf-bob-3
(description #f) (description #f)
(license #f))) (license #f)))
(define rust-leaf-bob-3.0.2-yanked
(package
(name "rust-leaf-bob")
(version "3.0.2")
(source #f)
(properties '((crate-version-yanked? . #t)))
(build-system #f)
(home-page #f)
(synopsis #f)
(description #f)
(license #f)))
(unless have-guile-semver? (test-skip 1)) (unless have-guile-semver? (test-skip 1))
(test-assert "crate-recursive-import-honors-existing-packages" (test-assert "crate-recursive-import-honors-existing-packages"
(mock (mock
@ -870,7 +913,7 @@ (define rust-leaf-bob-3
(lambda* (name #:optional version) (lambda* (name #:optional version)
(match name (match name
("rust-leaf-bob" ("rust-leaf-bob"
(list rust-leaf-bob-3)) (list rust-leaf-bob-3 rust-leaf-bob-3.0.2-yanked))
(_ '())))) (_ '()))))
(mock (mock
((guix http-client) http-fetch ((guix http-client) http-fetch
@ -894,8 +937,16 @@ (define rust-leaf-bob-3
(open-input-string "empty file\n")) (open-input-string "empty file\n"))
("https://crates.io/api/v1/crates/leaf-bob/3.0.2/dependencies" ("https://crates.io/api/v1/crates/leaf-bob/3.0.2/dependencies"
(open-input-string test-leaf-bob-dependencies)) (open-input-string test-leaf-bob-dependencies))
("https://crates.io/api/v1/crates/leaf-bob/4.0.0/download"
(set! test-source-hash
(bytevector->nix-base32-string
(gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
(open-input-string "empty file\n"))
("https://crates.io/api/v1/crates/leaf-bob/4.0.0/dependencies"
(open-input-string test-leaf-bob-dependencies))
(_ (error "Unexpected URL: " url))))) (_ (error "Unexpected URL: " url)))))
(match (crate-recursive-import "bar") (match (crate-recursive-import "bar"
#:allow-yanked? #t)
(((define-public 'rust-bar-1 (((define-public 'rust-bar-1
(package (package
(name "rust-bar") (name "rust-bar")
@ -913,7 +964,12 @@ (define rust-leaf-bob-3
(arguments (arguments
('quasiquote (#:cargo-inputs ('quasiquote (#:cargo-inputs
(("rust-leaf-bob" (("rust-leaf-bob"
('unquote 'rust-leaf-bob-3)))))) ('unquote 'rust-leaf-bob-3)))
#:cargo-development-inputs
(("rust-leaf-bob"
('unquote 'rust-leaf-bob-3.0.2-yanked))
("rust-leaf-bob"
('unquote 'rust-leaf-bob-4.0.0-yanked))))))
(home-page "http://example.com") (home-page "http://example.com")
(synopsis "summary") (synopsis "summary")
(description "summary") (description "summary")
@ -922,4 +978,135 @@ (define rust-leaf-bob-3
(x (x
(pk 'fail x #f)))))) (pk 'fail x #f))))))
(unless have-guile-semver? (test-skip 1))
(test-assert "crate-import-only-yanked-available"
(mock
((guix http-client) http-fetch
(lambda (url . rest)
(match url
("https://crates.io/api/v1/crates/bar"
(open-input-string test-bar-crate))
("https://crates.io/api/v1/crates/bar/1.0.0/download"
(set! test-source-hash
(bytevector->nix-base32-string
(gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
(open-input-string "empty file\n"))
("https://crates.io/api/v1/crates/bar/1.0.0/dependencies"
(open-input-string test-bar-dependencies))
("https://crates.io/api/v1/crates/leaf-bob"
(open-input-string test-leaf-bob-crate))
("https://crates.io/api/v1/crates/leaf-bob/3.0.1/download"
(set! test-source-hash
(bytevector->nix-base32-string
(gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
(open-input-string "empty file\n"))
("https://crates.io/api/v1/crates/leaf-bob/3.0.1/dependencies"
(open-input-string test-leaf-bob-dependencies))
("https://crates.io/api/v1/crates/leaf-bob/3.0.2/download"
(set! test-source-hash
(bytevector->nix-base32-string
(gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
(open-input-string "empty file\n"))
("https://crates.io/api/v1/crates/leaf-bob/3.0.2/dependencies"
(open-input-string test-leaf-bob-dependencies))
("https://crates.io/api/v1/crates/leaf-bob/4.0.0/download"
(set! test-source-hash
(bytevector->nix-base32-string
(gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
(open-input-string "empty file\n"))
("https://crates.io/api/v1/crates/leaf-bob/4.0.0/dependencies"
(open-input-string test-leaf-bob-dependencies))
(_ (error "Unexpected URL: " url)))))
(match (crate-recursive-import "bar"
#:recursive-dev-dependencies? #t
#:allow-yanked? #t)
(((define-public 'rust-leaf-bob-4.0.0-yanked
(package
(name "rust-leaf-bob")
(version "4.0.0")
($ <comment> "; This version was yanked!\n" #t)
(source
(origin
(method url-fetch)
(uri (crate-uri "leaf-bob" version))
(file-name
(string-append name "-" version ".tar.gz"))
(sha256
(base32
(? string? hash)))))
(properties ('quote (('crate-version-yanked? . #t))))
(build-system cargo-build-system)
(home-page "http://example.com")
(synopsis "summary")
(description "summary")
(license (list license:expat license:asl2.0))))
(define-public 'rust-leaf-bob-3.0.2-yanked
(package
(name "rust-leaf-bob")
(version "3.0.2")
($ <comment> "; This version was yanked!\n" #t)
(source
(origin
(method url-fetch)
(uri (crate-uri "leaf-bob" version))
(file-name
(string-append name "-" version ".tar.gz"))
(sha256
(base32
(? string? hash)))))
(properties ('quote (('crate-version-yanked? . #t))))
(build-system cargo-build-system)
(home-page "http://example.com")
(synopsis "summary")
(description "summary")
(license (list license:expat license:asl2.0))))
(define-public 'rust-leaf-bob-3
(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)
(home-page "http://example.com")
(synopsis "summary")
(description "summary")
(license (list license:expat license:asl2.0))))
(define-public 'rust-bar-1
(package
(name "rust-bar")
(version "1.0.0")
(source
(origin
(method url-fetch)
(uri (crate-uri "bar" 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-3)))
#:cargo-development-inputs
(("rust-leaf-bob"
('unquote 'rust-leaf-bob-3.0.2-yanked))
("rust-leaf-bob"
('unquote 'rust-leaf-bob-4.0.0-yanked))))))
(home-page "http://example.com")
(synopsis "summary")
(description "summary")
(license (list license:expat license:asl2.0)))))
#t)
(x
(pk 'fail (pretty-print-with-comments (current-output-port) x) #f)))))
(test-end "crate") (test-end "crate")