Subject: [bug#77093] [PATCH v4 rust-team 22/22] import: crate: Add ‘--lockfile’ option.

From: Hilton Chain <[email-masked]>
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