From 12e0b9e9e4eb47f635d09f6bf3bee674c7b80234 Mon Sep 17 00:00:00 2001 From: Hilton Chain Date: Mon, 28 Apr 2025 23:52:08 +0800 Subject: [PATCH] =?UTF-8?q?import:=20crate:=20Add=20=E2=80=98--lockfile?= =?UTF-8?q?=E2=80=99=20option.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * 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 b2d58af8473..d87b236aa2f 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -14957,6 +14957,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 39da8678057..b7a3250c138 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 723cbb36658..8791d1092b2 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