guix_mirror_bot pushed a commit to branch gnome-team
in repository guix.
commit cb2d6a87c957b092df3c237d888ac615233edf5a
Author: Hilton Chain <[email protected]>
AuthorDate: Mon Apr 28 23:52:08 2025 +0800
import: crate: Add ‘--lockfile’ option.
* 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 | 46 ++++++++++++++++++++++++++++++++
guix/scripts/import/crate.scm | 61 ++++++++++++++++++++++++++++++++++++-------
3 files changed, 102 insertions(+), 10 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index a219240c9c..9ca95b3456 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -14870,6 +14870,11 @@ version instead instead of aborting.
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..b7a3250c13 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -60,6 +60,9 @@
string->license
crate-recursive-import
cargo-lock->expressions
+ cargo-inputs-from-lockfile
+ find-cargo-inputs-location
+ extract-cargo-inputs
%crate-updater))
@@ -559,6 +562,49 @@ referencing all imported sources."
(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 ((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..8791d1092b 100644
--- a/guix/scripts/import/crate.scm
+++ b/guix/scripts/import/crate.scm
@@ -25,12 +25,15 @@
(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 (srfi srfi-71)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:export (guix-import-crate))
@@ -60,6 +63,9 @@ Import and convert the crates.io package for
PACKAGE-NAME.\n"))
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 +93,11 @@ Import and convert the crates.io package for
PACKAGE-NAME.\n"))
(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)
+ (if (file-exists? arg)
+ (alist-cons 'lockfile arg result)
+ (leave (G_ "file '~a' does not exist~%") arg))))
%standard-import-options))
@@ -101,6 +112,8 @@ Import and convert the crates.io package for
PACKAGE-NAME.\n"))
#: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 +124,44 @@ Import and convert the crates.io package for
PACKAGE-NAME.\n"))
(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
+ (lockfile
+ (let ((source-expressions
+ _
+ (cargo-lock->expressions lockfile name)))
+ (when file-to-insert
+ (let* ((source-expressions
+ cargo-inputs-entry
+ (cargo-lock->expressions lockfile name))
+ (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
