Package: guix-patches;
Reported by: Herman Rimm <herman <at> rimm.ee>
Date: Sun, 26 Jan 2025 20:41:01 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
Message #8 received at 75878 <at> debbugs.gnu.org (full text, mbox):
From: Herman Rimm <herman <at> rimm.ee> To: 75878 <at> debbugs.gnu.org Subject: [PATCH 2/3] import: crate: Comment out missing dependencies. Date: Sun, 26 Jan 2025 21:41:16 +0100
* 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
---
doc/guix.texi | 6 +-
guix/import/crate.scm | 41 ++++++++-----
guix/scripts/import/crate.scm | 10 +++-
tests/crate.scm | 107 ++++++++++++++++++++++++++--------
4 files changed, 123 insertions(+), 41 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 9a53bdcd374..f7d408a234b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -124,7 +124,7 @@
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@*
@@ -14679,6 +14679,10 @@ Invoking guix import
@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
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index d790126ef6e..cb39f43c4a1 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -156,6 +156,7 @@ (define* (package-names->package-inputs names #:optional (output #f))
(map (match-lambda
((input version) (make-input input version))
+ ((? blank? comment) comment)
(input (make-input input #f)))
names))
@@ -194,11 +195,16 @@ (define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inpu
(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 @@ (define (find-package-version name range allow-yanked?)
(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 @@ (define* (crate->guix-package
;; 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 @@ (define* (crate->guix-package
(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 @@ (define* (crate->guix-package
(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 @@ (define* (crate->guix-package
;; 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 @@ (define* (crate->guix-package
#: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
diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm
index ac11dabaa3b..9d403ce0ec0 100644
--- a/guix/scripts/import/crate.scm
+++ b/guix/scripts/import/crate.scm
@@ -5,6 +5,7 @@
;;; Copyright © 2021 Sarah Morgensen <iskarian <at> mgsn.dev>
;;; Copyright © 2023 Simon Tournier <zimon.toutoune <at> gmail.com>
;;; Copyright © 2023 David Elsing <david.elsing <at> posteo.net>
+;;; Copyright © 2025 Herman Rimm <herman <at> rimm.ee>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -54,6 +55,9 @@ (define (show-help)
(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 @@ (define %options
(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 @@ (define (guix-import-crate . args)
#: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
diff --git a/tests/crate.scm b/tests/crate.scm
index 02b708f9d9a..2f1c37633c9 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -5,6 +5,7 @@
;;; Copyright © 2020 Martin Becze <mjbecze <at> riseup.net>
;;; Copyright © 2023, 2025 Efraim Flashner <efraim <at> flashner.co.il>
;;; Copyright © 2023 David Elsing <david.elsing <at> posteo.net>
+;;; Copyright © 2025 Herman Rimm <herman <at> rimm.ee>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -446,6 +447,29 @@ (define test-source-hash
(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 @@ (define have-guile-semver?
(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 have-guile-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)))
-
(unless have-guile-semver? (test-skip 1))
(test-assert "crate-recursive-import-honors-existing-packages"
(mock
--
2.47.1
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.