Package: guix-patches;
Reported by: Hilton Chain <hako <at> ultrarare.space>
Date: Tue, 18 Mar 2025 07:18:02 UTC
Severity: normal
Tags: patch
Message #335 received at 77093 <at> debbugs.gnu.org (full text, mbox):
From: Hilton Chain <hako <at> ultrarare.space> To: 77093 <at> debbugs.gnu.org Cc: Hilton Chain <hako <at> ultrarare.space> Subject: [PATCH v4 rust-team 22/22] import: crate: Add ‘--lockfile’ option. Date: Tue, 29 Apr 2025 00:23:19 +0800
* guix/import/crate.scm (cargo-inputs-from-lockfile)
find-cargo-inputs-location, extract-cargo-inputs): New procedures.
* guix/scripts/import/crate.scm (%options): Add ‘--lockfile’ option.
(show-help): Add it.
(guix-import-crate): Use it.
* doc/guix.texi (Invoking guix import): Document it.
Change-Id: I291478e04adf9f2df0bf216425a5e8aeba0bedd9
---
doc/guix.texi | 5 +++
guix/import/crate.scm | 47 +++++++++++++++++++++++++++++
guix/scripts/import/crate.scm | 57 +++++++++++++++++++++++++++++------
3 files changed, 99 insertions(+), 10 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 6388f7b28f..7aa36b347a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -14833,6 +14833,11 @@ Invoking guix import
If a crate dependency is not (yet) packaged, make the corresponding
input in @code{#:cargo-inputs} or @code{#:cargo-development-inputs} into
a comment.
+@item --lockfile=@var{file}
+@itemx -f @var{file}
+When @option{--lockfile} is specified, the importer will ignore other options
+and won't output package expressions, instead importing source expressions
+from @var{file}, a @file{Cargo.lock} file.
@end table
@item elm
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 39da867805..d425e07b48 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -52,6 +52,7 @@ (define-module (guix import crate)
#:use-module (json)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-69)
#:use-module (srfi srfi-71)
@@ -60,6 +61,9 @@ (define-module (guix import crate)
string->license
crate-recursive-import
cargo-lock->expressions
+ cargo-inputs-from-lockfile
+ find-cargo-inputs-location
+ extract-cargo-inputs
%crate-updater))
@@ -559,6 +563,49 @@ (define (cargo-lock->expressions lockfile package-name)
(list ,@(map second source-expressions)))))
(values source-expressions cargo-inputs-entry)))
+(define* (cargo-inputs-from-lockfile #:optional (lockfile "Cargo.lock"))
+ "Given LOCKFILE (default to \"Cargo.lock\" in current directory), return a
+source list imported from it, to be used as package inputs. This procedure
+can be used for adding a manifest file within the source tree of a Rust
+application."
+ (let-values
+ (((source-expressions cargo-inputs-entry)
+ (cargo-lock->expressions lockfile "cargo-inputs-temporary")))
+ (eval-string
+ (call-with-output-string
+ (lambda (port)
+ (for-each
+ (cut pretty-print-with-comments port <>)
+ `((use-modules (guix build-system cargo))
+ ,@source-expressions
+ (define-cargo-inputs lookup-cargo-inputs ,cargo-inputs-entry)
+ (lookup-cargo-inputs 'cargo-inputs-temporary))))))))
+
+(define (find-cargo-inputs-location file)
+ "Search in FILE for a top-level definition of Cargo inputs. Return the
+location if found, or #f otherwise."
+ (find-definition-location file 'lookup-cargo-inputs
+ #:define-prefix 'define-cargo-inputs))
+
+(define* (extract-cargo-inputs file #:key exclude)
+ "Search in FILE for a top-level definition of Cargo inputs. If found,
+return its entries excluding EXCLUDE, or an empty list otherwise."
+ (call-with-input-file file
+ (lambda (port)
+ (do ((syntax (read-syntax port)
+ (read-syntax port)))
+ ((match (syntax->datum syntax)
+ (('define-cargo-inputs 'lookup-cargo-inputs _ ...) #t)
+ ((? eof-object?) #t)
+ (_ #f))
+ (or (and (not (eof-object? syntax))
+ (match (syntax->datum syntax)
+ (('define-cargo-inputs 'lookup-cargo-inputs inputs ...)
+ (remove (lambda (cargo-input-entry)
+ (eq? exclude (first cargo-input-entry)))
+ inputs))))
+ '()))))))
+
;;;
;;; Updater
diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm
index 723cbb3665..a251cd9538 100644
--- a/guix/scripts/import/crate.scm
+++ b/guix/scripts/import/crate.scm
@@ -25,11 +25,13 @@
(define-module (guix scripts import crate)
#:use-module (guix ui)
#:use-module (guix utils)
+ #:use-module (guix read-print)
#:use-module (guix scripts)
#:use-module (guix import crate)
#:use-module (guix scripts import)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
@@ -60,6 +62,9 @@ (define (show-help)
sufficient package exists for it"))
(newline)
(display (G_ "
+ -f, --lockfile=FILE import dependencies from FILE, a 'Cargo.lock' file"))
+ (newline)
+ (display (G_ "
-h, --help display this help and exit"))
(display (G_ "
-V, --version display version information and exit"))
@@ -87,6 +92,9 @@ (define %options
(option '("mark-missing") #f #f
(lambda (opt name arg result)
(alist-cons 'mark-missing #t result)))
+ (option '(#\f "lockfile") #f #t
+ (lambda (opt name arg result)
+ (alist-cons 'lockfile arg result)))
%standard-import-options))
@@ -101,6 +109,8 @@ (define (guix-import-crate . args)
#:build-options? #f))
(let* ((opts (parse-options))
+ (lockfile (assoc-ref opts 'lockfile))
+ (file-to-insert (assoc-ref opts 'file-to-insert))
(args (filter-map (match-lambda
(('argument . value)
value)
@@ -111,16 +121,43 @@ (define (guix-import-crate . args)
(define-values (name version)
(package-name->name+version spec))
- (match (if (assoc-ref opts 'recursive)
- (crate-recursive-import
- name #:version version
- #:recursive-dev-dependencies?
- (assoc-ref opts 'recursive-dev-dependencies)
- #:allow-yanked? (assoc-ref opts 'allow-yanked))
- (crate->guix-package
- name #:version version #:include-dev-deps? #t
- #:allow-yanked? (assoc-ref opts 'allow-yanked)
- #:mark-missing? (assoc-ref opts 'mark-missing)))
+ (match (cond
+ ((and=> lockfile
+ (lambda (file)
+ (or (file-exists? file)
+ (leave (G_ "file '~a' does not exist~%") file))))
+ (let-values (((source-expressions cargo-inputs-entry)
+ (cargo-lock->expressions lockfile name)))
+ (when file-to-insert
+ (let* ((term (first cargo-inputs-entry))
+ (cargo-inputs
+ `(define-cargo-inputs lookup-cargo-inputs
+ ,@(sort
+ (cons cargo-inputs-entry
+ (extract-cargo-inputs
+ file-to-insert #:exclude term))
+ (lambda (a b)
+ (string< (symbol->string (first a))
+ (symbol->string (first b)))))))
+ (_
+ (and=> (find-cargo-inputs-location file-to-insert)
+ delete-expression))
+ (port (open-file file-to-insert "a")))
+ (pretty-print-with-comments port cargo-inputs)
+ (newline port)
+ (close-port port)))
+ source-expressions))
+ ((assoc-ref opts 'recursive)
+ (crate-recursive-import
+ name #:version version
+ #:recursive-dev-dependencies?
+ (assoc-ref opts 'recursive-dev-dependencies)
+ #:allow-yanked? (assoc-ref opts 'allow-yanked)))
+ (else
+ (crate->guix-package
+ name #:version version #:include-dev-deps? #t
+ #: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
--
2.49.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.