amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

import: crate: Comment out missing dependencies.

Browse source 
* guix/import/crate.scm (package-names->package-inputs): Emit comments.
(make-crate-sexp): Make input into comment if missing.
(crate->guix-package): Take #:mark-missing? argument.
[dependency-name+missing+version+yanked]: Mark as missing.  Rename from
dependency-name+version+yanked.
[sort-map-dependencies]: Adjust.
[remove-missing+yanked-info]: Remove missing info.  Rename from
remove-yanked-info.
* guix/scripts/import/crate.scm (show-help): Explain --mark-missing.
(%options): Add mark-missing option.
(guix-import-crate): Pass mark-missing option as #:mark-missing?.
* doc/guix.texi (Invoking guix import): Document --mark-missing.
* tests/crate.scm ("crate->guix-package-marks-missing-packages"): Add
test.

Change-Id: I065d394e1c04fdc332b8f7f8b9fcbd87c14c6512
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Herman Rimm 2025-01-26 21:41:16 +01:00 • committed by Ludovic Courtès
parent 48c5942a1e
commit 6b55b971c8
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
4 changed files with 123 additions and 41 deletions
Download patch file Download diff file Expand all files Collapse all files

6
doc/guix.texi
View file

@ -124,7 +124,7 @@ Copyright @copyright{} 2023 Thomas Ieong@*
Copyright @copyright{} 2023 Saku Laesvuori@*
Copyright @copyright{} 2023 Graham James Addis@*
Copyright @copyright{} 2023, 2024 Tomas Volf@*
Copyright @copyright{} 2024 Herman Rimm@*
Copyright @copyright{} 2024, 2025 Herman Rimm@*
Copyright @copyright{} 2024 Matthew Trzcinski@*
Copyright @copyright{} 2024 Richard Sent@*
Copyright @copyright{} 2024 Dariqq@*
@ -14687,6 +14687,10 @@ 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.
@item --mark-missing
If a crate dependency is not (yet) packaged, make the corresponding
input in @code{#:cargo-inputs} or @code{#:cargo-development-inputs} into
a comment.
@end table
@item elm

41
guix/import/crate.scm
View file

@ -156,6 +156,7 @@ use in an 'inputs' field of a package definition."
(map (match-lambda
((input version) (make-input input version))
((? blank? comment) comment)
(input (make-input input #f)))
names))
@ -194,11 +195,16 @@ and LICENSE."
(define (format-inputs inputs)
(map
(match-lambda
((name version yanked)
(list (crate-name->package-name name)
(if yanked
(string-append version "-yanked")
(version->semver-prefix version)))))
((name missing version yanked)
(let ((input (list (crate-name->package-name name)
(if yanked
(string-append version "-yanked")
(version->semver-prefix version)))))
(if missing
(comment
(string-append ";; " (string-join input "-") "\n")
#f)
input))))
inputs))
(let* ((port (http-fetch (crate-uri name version)))
@ -318,7 +324,8 @@ priority."
(define* (crate->guix-package
crate-name
#:key version include-dev-deps? allow-yanked? #:allow-other-keys)
#:key version include-dev-deps? allow-yanked? mark-missing?
#: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, convert it into a semver range and attempt to fetch
@ -358,13 +365,13 @@ look up the development dependencs for the given crate."
;; 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)
(define (dependency-name+missing+version+yanked dep)
(let* ((name (crate-dependency-id dep))
(req (crate-dependency-requirement dep))
(existing-version
(find-package-version name req allow-yanked?)))
(if (and existing-version (not (second existing-version)))
(cons name existing-version)
(cons* name #f existing-version)
(let* ((crate (lookup-crate* name))
(ver (find-crate-version crate req)))
(if existing-version
@ -374,14 +381,15 @@ look up the development dependencs for the given crate."
(begin
(warning (G_ "~A: version ~a is no longer yanked~%")
name (first existing-version))
(cons name existing-version))
(cons* name #f existing-version))
(list name
#f
(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)))
(cons* name #f existing-version)))
(begin
(unless ver
(leave (G_ "~A: no version found for requirement ~a~%") name req))
@ -389,6 +397,7 @@ look up the development dependencs for the given crate."
(warning (G_ "~A: imported version ~a was yanked~%")
name (crate-version-number ver)))
(list name
mark-missing?
(crate-version-number ver)
(crate-version-yanked? ver))))))))
@ -400,14 +409,14 @@ 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 dependency-name+version+yanked
(sort (map dependency-name+missing+version+yanked
deps)
(match-lambda* (((name _ _) ...)
(match-lambda* (((name _ _ _) ...)
(apply string-ci<? name)))))
(define (remove-yanked-info deps)
(define (remove-missing+yanked-info deps)
(map
(match-lambda ((name version yanked)
(match-lambda ((name missing version yanked)
(list name version)))
deps))
@ -438,8 +447,8 @@ look up the development dependencs for the given crate."
#:license (and=> (crate-version-license version*)
string->license))
(append
(remove-yanked-info cargo-inputs)
(remove-yanked-info cargo-development-inputs))))
(remove-missing+yanked-info cargo-inputs)
(remove-missing+yanked-info cargo-development-inputs))))
(values #f '())))
(define* (crate-recursive-import

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

@ -5,6 +5,7 @@
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;; Copyright © 2023 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2023 David Elsing <david.elsing@posteo.net>
;;; Copyright © 2025 Herman Rimm <herman@rimm.ee>
;;;
;;; This file is part of GNU Guix.
;;;
@ -54,6 +55,9 @@ Import and convert the crates.io package for PACKAGE-NAME.\n"))
(display (G_ "
--allow-yanked allow importing yanked crates if no alternative
satisfying the version requirement is found"))
(display (G_ "
--mark-missing comment out the desired dependency if no
sufficient package exists for it"))
(newline)
(display (G_ "
-h, --help display this help and exit"))
@ -80,6 +84,9 @@ Import and convert the crates.io package for PACKAGE-NAME.\n"))
(option '("allow-yanked") #f #f
(lambda (opt name arg result)
(alist-cons 'allow-yanked #t result)))
(option '("mark-missing") #f #f
(lambda (opt name arg result)
(alist-cons 'mark-missing #t result)))
%standard-import-options))
@ -112,7 +119,8 @@ Import and convert the crates.io package for PACKAGE-NAME.\n"))
#:allow-yanked? (assoc-ref opts 'allow-yanked))
(crate->guix-package
name #:version version #:include-dev-deps? #t
#:allow-yanked? (assoc-ref opts 'allow-yanked)))
#:allow-yanked? (assoc-ref opts 'allow-yanked)
#:mark-missing? (assoc-ref opts 'mark-missing)))
((or #f '())
(leave (G_ "failed to download meta-data for package '~a'~%")
(if version

107
tests/crate.scm
View file

@ -5,6 +5,7 @@
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;; Copyright © 2023, 2025 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2023 David Elsing <david.elsing@posteo.net>
;;; Copyright © 2025 Herman Rimm <herman@rimm.ee>
;;;
;;; This file is part of GNU Guix.
;;;
@ -446,6 +447,29 @@
(define have-guile-semver?
(false-if-exception (resolve-interface '(semver))))
(define rust-leaf-bob-3
(package
(name "rust-leaf-bob")
(version "3.0.1")
(source #f)
(build-system #f)
(home-page #f)
(synopsis #f)
(description #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)))
(test-begin "crate")
@ -510,6 +534,66 @@
(x
(pk 'fail x #f)))))
(unless have-guile-semver? (test-skip 1))
(test-assert "crate->guix-package-marks-missing-packages"
(mock
((gnu packages) find-packages-by-name
(lambda* (name #:optional version)
(match name
("rust-leaf-bob"
(list rust-leaf-bob-3.0.2-yanked))
(_ '()))))
(mock
((guix http-client) http-fetch
(lambda (url . rest)
(match url
("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
(gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
(open-input-string "empty file\n"))
("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-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"))
(_ (error "Unexpected URL: " url)))))
(match (crate->guix-package "intermediate-b" #:mark-missing? #t)
((define-public 'rust-intermediate-b-1
(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
(($ <comment> ";; rust-leaf-bob-3\n" #f)))))
(home-page "http://example.com")
(synopsis "summary")
(description "This package provides summary.")
(license (list license:expat license:asl2.0))))
#t)
(x
(pk 'fail
(pretty-print-with-comments (current-output-port) x)
#f))))))
(unless have-guile-semver? (test-skip 1))
(test-assert "crate-recursive-import"
;; Replace network resources with sample data.
@ -883,29 +967,6 @@
(define rust-leaf-bob-3
(package
(name "rust-leaf-bob")
(version "3.0.1")
(source #f)
(build-system #f)
(home-page #f)
(synopsis #f)
(description #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))
(test-assert "crate-recursive-import-honors-existing-packages"
(mock