import: crate: Comment out missing dependencies.

* 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
Signed-off-by: Ludovic Courtès <[email protected]>

4 files changed, 123 insertions, 41 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index b699ae3c65..6d966ddb99 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -124,7 +124,7 @@ Copyright @copyright{} 2023 Thomas Ieong@*
 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@*
@@ -14687,6 +14687,10 @@ imported as well.
 @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 d790126ef6..cb39f43c4a 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -156,6 +156,7 @@ use in an 'inputs' field of a package definition."
 
   (map (match-lambda
          ((input version) (make-input input version))
+         ((? blank? comment) comment)
          (input (make-input input #f)))
        names))
 
@@ -194,11 +195,16 @@ and LICENSE."
   (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 @@ priority."
 
 (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 @@ look up the development dependencs for the given crate."
   ;; 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 @@ look up the development dependencs for the given crate."
                         (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 @@ look up the development dependencs for the given crate."
                       (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 @@ look up the development dependencs for the given crate."
   ;; 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 @@ look up the development dependencs for the given crate."
                           #: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 ac11dabaa3..723cbb3665 100644
--- a/guix/scripts/import/crate.scm
+++ b/guix/scripts/import/crate.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2021 Sarah Morgensen <[email protected]>
 ;;; Copyright © 2023 Simon Tournier <[email protected]>
 ;;; Copyright © 2023 David Elsing <[email protected]>
+;;; Copyright © 2025 Herman Rimm <[email protected]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -54,6 +55,9 @@ Import and convert the crates.io package for PACKAGE-NAME.\n"))
   (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 @@ Import and convert the crates.io package for PACKAGE-NAME.\n"))
          (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 @@ Import and convert the crates.io package for PACKAGE-NAME.\n"))
                    #: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 02b708f9d9..2f1c37633c 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2020 Martin Becze <[email protected]>
 ;;; Copyright © 2023, 2025 Efraim Flashner <[email protected]>
 ;;; Copyright © 2023 David Elsing <[email protected]>
+;;; Copyright © 2025 Herman Rimm <[email protected]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -446,6 +447,29 @@
 (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")
 
@@ -511,6 +535,66 @@
            (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.
   (mock ((guix http-client) http-fetch
@@ -883,29 +967,6 @@
 
 
 
-(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