unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
* [bug#67960] [PATCH 0/4] Improve the crate importer.
@ 2023-12-21 21:59 David Elsing
  2023-12-21 22:01 ` [bug#67960] [PATCH 1/4] gnu: import: Fix memoization in crate-recursive-import David Elsing
                   ` (4 more replies)
  0 siblings, 5 replies; 7+ messages in thread
From: David Elsing @ 2023-12-21 21:59 UTC (permalink / raw)
  To: 67960; +Cc: David Elsing

This patch series contains improvements to the crate importer.

The first patch fixes the memoization in crate-recursive-import.

The second patch allows for including the cargo-development-inputs also in
recursively imported crates by specifying --recursive-dev-dependencies, such
that the tests of all imported crates can be run.

The third patch removes the dependency of a test in tests/crate.scm on an
existing crate in gnu/packages/crates.io.

Sometimes, it can happen that a crate requires a dependency for which only a
yanked version exists, which is addressed in the fourth patch. Instead of
simply failing, I changed the behavior to also import yanked versions if no
non-yanked version exists. Then, they can be used anyway or be manually
patched out from the dependent packages. Their packages obtain a different
package name (including the full version) and a package property marking them
as yanked. The logic to decide which version to use naturally became more
complicated as a result.

David Elsing (4):
  gnu: import: Fix memoization in crate-recursive-import.
  import: crate: Optionally import dev-dependencies recursively.
  tests: Mock find-packages-by-name in crate importer test.
  guix: import: Optionally import necessary yanked crates.

 doc/guix.texi                 |   7 +
 guix/import/crate.scm         | 161 +++++++---
 guix/read-print.scm           |   1 +
 guix/scripts/import/crate.scm |  24 +-
 tests/crate.scm               | 576 +++++++++++++++++++++++++++++-----
 5 files changed, 653 insertions(+), 116 deletions(-)

-- 
2.41.0





^ permalink raw reply	[flat|nested] 7+ messages in thread

* [bug#67960] [PATCH 1/4] gnu: import: Fix memoization in crate-recursive-import.
  2023-12-21 21:59 [bug#67960] [PATCH 0/4] Improve the crate importer David Elsing
@ 2023-12-21 22:01 ` David Elsing
  2023-12-21 22:01 ` [bug#67960] [PATCH 2/4] import: crate: Optionally import dev-dependencies recursively David Elsing
                   ` (3 subsequent siblings)
  4 siblings, 0 replies; 7+ messages in thread
From: David Elsing @ 2023-12-21 22:01 UTC (permalink / raw)
  To: 67960; +Cc: David Elsing

* guix/import/crate.scm (crate-recursive-import): Apply memoize outside the
lambda passed to recursive-import in order to actually use the memoization.
---
 guix/import/crate.scm | 21 ++++++++++++---------
 1 file changed, 12 insertions(+), 9 deletions(-)

diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 43823d006e..07874bdb26 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2023 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2023 David Elsing <david.elsing@posteo.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -328,15 +329,17 @@ (define (sort-map-dependencies deps)
       (values #f '())))
 
 (define* (crate-recursive-import crate-name #:key version)
-  (recursive-import crate-name
-                    #:repo->guix-package (lambda* params
-                      ;; download development dependencies only for the top level package
-                      (let ((include-dev-deps? (equal? (car params) crate-name))
-                            (crate->guix-package* (memoize crate->guix-package)))
-                        (apply crate->guix-package*
-                               (append params `(#:include-dev-deps? ,include-dev-deps?)))))
-                    #:version version
-                    #:guix-name crate-name->package-name))
+  (recursive-import
+   crate-name
+   #:repo->guix-package
+   (let ((crate->guix-package* (memoize crate->guix-package)))
+     (lambda* params
+       ;; download development dependencies only for the top level package
+       (let ((include-dev-deps? (equal? (car params) crate-name)))
+         (apply crate->guix-package*
+                (append params `(#:include-dev-deps? ,include-dev-deps?))))))
+   #:version version
+   #:guix-name crate-name->package-name))
 
 (define (guix-package->crate-name package)
   "Return the crate name of PACKAGE."
-- 
2.41.0





^ permalink raw reply related	[flat|nested] 7+ messages in thread

* [bug#67960] [PATCH 2/4] import: crate: Optionally import dev-dependencies recursively.
  2023-12-21 21:59 [bug#67960] [PATCH 0/4] Improve the crate importer David Elsing
  2023-12-21 22:01 ` [bug#67960] [PATCH 1/4] gnu: import: Fix memoization in crate-recursive-import David Elsing
@ 2023-12-21 22:01 ` David Elsing
  2023-12-21 22:01 ` [bug#67960] [PATCH 3/4] tests: Mock find-packages-by-name in crate importer test David Elsing
                   ` (2 subsequent siblings)
  4 siblings, 0 replies; 7+ messages in thread
From: David Elsing @ 2023-12-21 22:01 UTC (permalink / raw)
  To: 67960; +Cc: David Elsing

If --recursive-dev-dependencies is specified, development dependencies are
also included for all recursivly imported packages.

* doc/guix.texi (Invoking guix import): Mention --recursive-dev-dependencies.
* guix/import/crate.scm (crate-recursive-import): Add
recursive-dev-dependencies? argument.
* guix/scripts/import/crate.scm (show-help, guix-import-crate): Add
"--recursive-dev-dependencies".
* tests/crate.scm: Test both #f and #t for #:recursive-dev-dependencies? in
the 'cargo-recursive-import' test.
(test-root-dependencies): Add intermediate-c as dev-dependency.
(test-intermediate-c-crate,test-intermediate-c-dependencies): New variables.
---
 doc/guix.texi                 |   4 +
 guix/import/crate.scm         |   7 +-
 guix/scripts/import/crate.scm |  12 +-
 tests/crate.scm               | 228 +++++++++++++++++++++++++++++++++-
 4 files changed, 244 insertions(+), 7 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index b742a3d5b2..a19671643b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -14512,6 +14512,10 @@ Additional options include:
 Traverse the dependency graph of the given upstream package recursively
 and generate package expressions for all those packages that are not yet
 in Guix.
+@item --recursive-dev-dependencies
+If @option{--recursive} is specified, also the recursively imported
+packages contain their development dependencies, which are recursively
+imported as well.
 @end table
 
 @item elm
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 07874bdb26..db5461312f 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -328,14 +328,17 @@ (define (sort-map-dependencies deps)
          (append cargo-inputs cargo-development-inputs)))
       (values #f '())))
 
-(define* (crate-recursive-import crate-name #:key version)
+(define* (crate-recursive-import
+          crate-name #:key version recursive-dev-dependencies?)
   (recursive-import
    crate-name
    #:repo->guix-package
    (let ((crate->guix-package* (memoize crate->guix-package)))
      (lambda* params
        ;; download development dependencies only for the top level package
-       (let ((include-dev-deps? (equal? (car params) crate-name)))
+       (let ((include-dev-deps?
+              (or (equal? (car params) crate-name)
+                  recursive-dev-dependencies?)))
          (apply crate->guix-package*
                 (append params `(#:include-dev-deps? ,include-dev-deps?))))))
    #:version version
diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm
index 038faa87db..b13b6636a6 100644
--- a/guix/scripts/import/crate.scm
+++ b/guix/scripts/import/crate.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;; Copyright © 2023 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2023 David Elsing <david.elsing@posteo.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -47,6 +48,9 @@ (define (show-help)
 Import and convert the crates.io package for PACKAGE-NAME.\n"))
   (display (G_ "
   -r, --recursive        import packages recursively"))
+  (display (G_ "
+      --recursive-dev-dependencies
+                         include dev-dependencies recursively"))
   (newline)
   (display (G_ "
   -h, --help             display this help and exit"))
@@ -67,6 +71,9 @@ (define %options
          (option '(#\r "recursive") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'recursive #t result)))
+         (option '("recursive-dev-dependencies") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'recursive-dev-dependencies #t result)))
          %standard-import-options))
 
 \f
@@ -92,7 +99,10 @@ (define-values (name version)
          (package-name->name+version spec))
 
        (match (if (assoc-ref opts 'recursive)
-                  (crate-recursive-import name #:version version)
+                  (crate-recursive-import
+                   name #:version version
+                   #:recursive-dev-dependencies?
+                   (assoc-ref opts 'recursive-dev-dependencies))
                   (crate->guix-package name #:version version #:include-dev-deps? #t))
          ((or #f '())
           (leave (G_ "failed to download meta-data for package '~a'~%")
diff --git a/tests/crate.scm b/tests/crate.scm
index 5aea5efaf3..1b9ad88358 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
 ;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2023 David Elsing <david.elsing@posteo.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -40,10 +41,11 @@ (define-module (test-crate)
 ;;
 ;; root-1.0.0
 ;; root-1.0.4
-;; 	intermediate-a  1.0.42
-;; 	intermeidate-b ^1.0.0
+;; 	intermediate-a 1.0.42
+;; 	intermediate-b ^1.0.0
 ;; 	leaf-alice     ^0.7
-;; 	leaf-bob     ^3
+;; 	leaf-bob       ^3
+;; 	intermediate-c 1 (dev-dependency)
 ;;
 ;; intermediate-a-1.0.40
 ;; intermediate-a-1.0.42
@@ -55,6 +57,9 @@ (define-module (test-crate)
 ;; intermediate-b-1.2.3
 ;; 	leaf-bob	3.0.1
 ;;
+;; intermediate-c-1.0.1
+;;      leaf-alice      0.7.5 (dev-dependency)
+;;
 ;; leaf-alice-0.7.3
 ;; leaf-alice-0.7.5
 ;;
@@ -164,6 +169,11 @@ (define test-root-dependencies
        \"crate_id\": \"leaf-bob\",
        \"kind\": \"normal\",
        \"req\": \"^3\"
+     },
+     {
+       \"crate_id\": \"intermediate-c\",
+       \"kind\": \"dev\",
+       \"req\": \"1\"
      }
   ]
 }")
@@ -262,6 +272,40 @@ (define test-intermediate-b-dependencies
   ]
 }")
 
+(define test-intermediate-c-crate
+  "{
+  \"crate\": {
+    \"max_version\": \"1.0.1\",
+    \"name\": \"intermediate-c\",
+    \"description\": \"summary\",
+    \"homepage\": \"http://example.com\",
+    \"repository\": \"http://example.com\",
+    \"keywords\": [\"dummy\", \"test\"],
+    \"categories\": [\"test\"],
+    \"actual_versions\": [
+      { \"id\": 234290,
+        \"num\": \"1.0.1\",
+        \"license\": \"MIT OR Apache-2.0\",
+        \"links\": {
+          \"dependencies\": \"/api/v1/crates/intermediate-c/1.0.1/dependencies\"
+        },
+        \"yanked\": false
+      }
+    ]
+  }
+}")
+
+(define test-intermediate-c-dependencies
+  "{
+  \"dependencies\": [
+     {
+       \"crate_id\": \"leaf-alice\",
+       \"kind\": \"dev\",
+       \"req\": \"0.7.5\"
+     }
+  ]
+}")
+
 (define test-leaf-alice-crate
   "{
   \"crate\": {
@@ -430,6 +474,15 @@ (define have-guile-semver?
               (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/intermediate-c"
+              (open-input-string test-intermediate-c-crate))
+             ("https://crates.io/api/v1/crates/intermediate-c/1.0.1/download"
+              (set! test-source-hash
+                    (bytevector->nix-base32-string
+                     (sha256 (string->bytevector "empty file\n" "utf-8"))))
+              (open-input-string "empty file\n"))
+             ("https://crates.io/api/v1/crates/intermediate-c/1.0.1/dependencies"
+              (open-input-string test-intermediate-c-dependencies))
              ("https://crates.io/api/v1/crates/leaf-alice"
               (open-input-string test-leaf-alice-crate))
              ("https://crates.io/api/v1/crates/leaf-alice/0.7.5/download"
@@ -452,7 +505,27 @@ (define have-guile-semver?
         (match (crate-recursive-import "root")
           ;; rust-intermediate-b has no dependency on the rust-leaf-alice
           ;; package, so this is a valid ordering
-          (((define-public 'rust-leaf-alice-0.7
+          (((define-public 'rust-intermediate-c-1
+              (package
+                (name "rust-intermediate-c")
+                (version "1.0.1")
+                (source
+                 (origin
+                   (method url-fetch)
+                   (uri (crate-uri "intermediate-c" version))
+                   (file-name
+                    (string-append name "-" version ".tar.gz"))
+                   (sha256
+                    (base32
+                     (?  string? hash)))))
+                (build-system cargo-build-system)
+                (arguments
+                 ('quasiquote (#:skip-build? #t)))
+                (home-page "http://example.com")
+                (synopsis "summary")
+                (description "summary")
+                (license (list license:expat license:asl2.0))))
+            (define-public 'rust-leaf-alice-0.7
               (package
                 (name "rust-leaf-alice")
                 (version "0.7.5")
@@ -562,11 +635,158 @@ (define-public 'rust-root-1
                                  ('unquote rust-intermediate-b-1))
                                 ("rust-leaf-alice"
                                  ('unquote 'rust-leaf-alice-0.7))
+                                ("rust-leaf-bob"
+                                 ('unquote rust-leaf-bob-3)))
+                               #:cargo-development-inputs
+                               (("rust-intermediate-c"
+                                 ('unquote rust-intermediate-c-1))))))
+                (home-page "http://example.com")
+                (synopsis "summary")
+                (description "summary")
+                (license (list license:expat license:asl2.0)))))
+           #t)
+          (x
+           (pk 'fail x #f)))
+        (match (crate-recursive-import "root"
+                                       #:recursive-dev-dependencies? #t)
+          ;; rust-intermediate-b has no dependency on the rust-leaf-alice
+          ;; package, so this is a valid ordering
+          (((define-public 'rust-intermediate-c-1
+              (package
+                (name "rust-intermediate-c")
+                (version "1.0.1")
+                (source
+                 (origin
+                   (method url-fetch)
+                   (uri (crate-uri "intermediate-c" version))
+                   (file-name
+                    (string-append name "-" version ".tar.gz"))
+                   (sha256
+                    (base32
+                     (?  string? hash)))))
+                (build-system cargo-build-system)
+                (arguments
+                 ('quasiquote (#:cargo-development-inputs
+                               (("rust-leaf-alice"
+                                 ('unquote rust-leaf-alice-0.7))))))
+                (home-page "http://example.com")
+                (synopsis "summary")
+                (description "summary")
+                (license (list license:expat license:asl2.0))))
+            (define-public 'rust-leaf-alice-0.7
+              (package
+                (name "rust-leaf-alice")
+                (version "0.7.5")
+                (source
+                 (origin
+                   (method url-fetch)
+                   (uri (crate-uri "leaf-alice" version))
+                   (file-name
+                    (string-append name "-" version ".tar.gz"))
+                   (sha256
+                    (base32
+                     (?  string? hash)))))
+                (build-system cargo-build-system)
+                (home-page "http://example.com")
+                (synopsis "summary")
+                (description "summary")
+                (license (list license:expat license:asl2.0))))
+            (define-public 'rust-leaf-bob-3
+              (package
+                (name "rust-leaf-bob")
+                (version "3.0.1")
+                (source
+                 (origin
+                   (method url-fetch)
+                   (uri (crate-uri "leaf-bob" version))
+                   (file-name
+                    (string-append name "-" version ".tar.gz"))
+                   (sha256
+                    (base32
+                     (?  string? hash)))))
+                (build-system cargo-build-system)
+                (home-page "http://example.com")
+                (synopsis "summary")
+                (description "summary")
+                (license (list license:expat license:asl2.0))))
+            (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 (#:cargo-inputs
+                               (("rust-leaf-bob"
+                                 ('unquote rust-leaf-bob-3))))))
+                (home-page "http://example.com")
+                (synopsis "summary")
+                (description "summary")
+                (license (list license:expat license:asl2.0))))
+            (define-public 'rust-intermediate-a-1
+              (package
+                (name "rust-intermediate-a")
+                (version "1.0.42")
+                (source
+                 (origin
+                   (method url-fetch)
+                   (uri (crate-uri "intermediate-a" version))
+                   (file-name
+                    (string-append name "-" version ".tar.gz"))
+                   (sha256
+                    (base32
+                     (?  string? hash)))))
+                (build-system cargo-build-system)
+                (arguments
+                 ('quasiquote (#:cargo-inputs
+                               (("rust-intermediate-b"
+                                 ('unquote rust-intermediate-b-1))
+                                ("rust-leaf-alice"
+                                 ('unquote 'rust-leaf-alice-0.7))
                                 ("rust-leaf-bob"
                                  ('unquote rust-leaf-bob-3))))))
                 (home-page "http://example.com")
                 (synopsis "summary")
                 (description "summary")
+                (license (list license:expat license:asl2.0))))
+            (define-public 'rust-root-1
+              (package
+                (name "rust-root")
+                (version "1.0.4")
+                (source
+                 (origin
+                   (method url-fetch)
+                   (uri (crate-uri "root" version))
+                   (file-name
+                    (string-append name "-" version ".tar.gz"))
+                   (sha256
+                    (base32
+                     (?  string? hash)))))
+                (build-system cargo-build-system)
+                (arguments
+                 ('quasiquote (#:cargo-inputs
+                               (("rust-intermediate-a"
+                                 ('unquote rust-intermediate-a-1))
+                                ("rust-intermediate-b"
+                                 ('unquote rust-intermediate-b-1))
+                                ("rust-leaf-alice"
+                                 ('unquote 'rust-leaf-alice-0.7))
+                                ("rust-leaf-bob"
+                                 ('unquote rust-leaf-bob-3)))
+                               #:cargo-development-inputs
+                               (("rust-intermediate-c"
+                                 ('unquote rust-intermediate-c-1))))))
+                (home-page "http://example.com")
+                (synopsis "summary")
+                (description "summary")
                 (license (list license:expat license:asl2.0)))))
            #t)
           (x
-- 
2.41.0





^ permalink raw reply related	[flat|nested] 7+ messages in thread

* [bug#67960] [PATCH 3/4] tests: Mock find-packages-by-name in crate importer test.
  2023-12-21 21:59 [bug#67960] [PATCH 0/4] Improve the crate importer David Elsing
  2023-12-21 22:01 ` [bug#67960] [PATCH 1/4] gnu: import: Fix memoization in crate-recursive-import David Elsing
  2023-12-21 22:01 ` [bug#67960] [PATCH 2/4] import: crate: Optionally import dev-dependencies recursively David Elsing
@ 2023-12-21 22:01 ` David Elsing
  2023-12-21 22:01 ` [bug#67960] [PATCH 4/4] guix: import: Optionally import necessary yanked crates David Elsing
  2024-01-02 20:38 ` [bug#67960] [PATCH 0/4] Improve the crate importer Jaeme Sifat via Guix-patches via
  4 siblings, 0 replies; 7+ messages in thread
From: David Elsing @ 2023-12-21 22:01 UTC (permalink / raw)
  To: 67960; +Cc: David Elsing

* tests/crate.scm: Import only sha256 from (gcrypt hash) as gcrypt-sha256 to
prevent a name collision. Rename test 'cargo-recursive-import' to
'crate-recursive-import' and 'cargo-recursive-import-hoors-existing-packages'
to 'crate-recursive-import-honors-existing-packages'. Mock
find-packages-by-name from (gnu packages). Adjust test to import fake 'bar'
crate instead of doctool.
(test-bar-crate): New variable.
(test-bar-dependencies): New variable.
(test-root-crate): Adjust sha256 -> gcrypt-sha256.
(test-doctool-crate,test-doctool-dependencies): Remove variables.
(rust-leaf-bob-3): New variable.
---
 tests/crate.scm | 203 +++++++++++++++++++++++++++---------------------
 1 file changed, 115 insertions(+), 88 deletions(-)

diff --git a/tests/crate.scm b/tests/crate.scm
index 1b9ad88358..e779f738b3 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -25,7 +25,9 @@ (define-module (test-crate)
   #:use-module (guix import crate)
   #:use-module (guix base32)
   #:use-module (guix build-system cargo)
-  #:use-module (gcrypt hash)
+  #:use-module ((gcrypt hash)
+                #:select ((sha256 . gcrypt-sha256)))
+  #:use-module (guix packages)
   #:use-module (guix tests)
   #:use-module (gnu packages)
   #:use-module (ice-9 iconv)
@@ -38,6 +40,8 @@ (define-module (test-crate)
 ;; foo-1.0.0
 ;; foo-1.0.3
 ;; 	leaf-alice 0.7.5
+;; bar-1.0.0
+;;      leaf-bob   3.0.1
 ;;
 ;; root-1.0.0
 ;; root-1.0.4
@@ -116,6 +120,40 @@ (define test-foo-dependencies
   ]
 }")
 
+(define test-bar-crate
+  "{
+  \"crate\": {
+    \"max_version\": \"1.0.0\",
+    \"name\": \"bar\",
+    \"description\": \"summary\",
+    \"homepage\": \"http://example.com\",
+    \"repository\": \"http://example.com\",
+    \"keywords\": [\"dummy\", \"test\"],
+    \"categories\": [\"test\"],
+    \"actual_versions\": [
+      { \"id\": 234100,
+        \"num\": \"1.0.0\",
+        \"license\": \"MIT OR Apache-2.0\",
+        \"links\": {
+          \"dependencies\": \"/api/v1/crates/bar/1.0.0/dependencies\"
+        },
+        \"yanked\": false
+      }
+    ]
+  }
+}")
+
+(define test-bar-dependencies
+  "{
+  \"dependencies\": [
+     {
+       \"crate_id\": \"leaf-bob\",
+       \"kind\": \"normal\",
+       \"req\": \"3.0.1\"
+     }
+  ]
+}")
+
 (define test-root-crate
   "{
   \"crate\": {
@@ -399,7 +437,7 @@ (define have-guile-semver?
              ("https://crates.io/api/v1/crates/foo/1.0.3/download"
               (set! test-source-hash
                     (bytevector->nix-base32-string
-                     (sha256 (string->bytevector "empty file\n" "utf-8"))))
+                     (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
               (open-input-string "empty file\n"))
              ("https://crates.io/api/v1/crates/foo/1.0.3/dependencies"
               (open-input-string test-foo-dependencies))
@@ -408,7 +446,7 @@ (define have-guile-semver?
              ("https://crates.io/api/v1/crates/leaf-alice/0.7.5/download"
               (set! test-source-hash
                     (bytevector->nix-base32-string
-                     (sha256 (string->bytevector "empty file\n" "utf-8"))))
+                     (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
               (open-input-string "empty file\n"))
              ("https://crates.io/api/v1/crates/leaf-alice/0.7.5/dependencies"
               (open-input-string test-leaf-alice-dependencies))
@@ -442,7 +480,7 @@ (define have-guile-semver?
            (pk 'fail x #f)))))
 
 (unless have-guile-semver? (test-skip 1))
-(test-assert "cargo-recursive-import"
+(test-assert "crate-recursive-import"
   ;; Replace network resources with sample data.
   (mock ((guix http-client) http-fetch
          (lambda (url . rest)
@@ -452,7 +490,7 @@ (define have-guile-semver?
              ("https://crates.io/api/v1/crates/root/1.0.4/download"
               (set! test-source-hash
                     (bytevector->nix-base32-string
-                     (sha256 (string->bytevector "empty file\n" "utf-8"))))
+                     (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
               (open-input-string "empty file\n"))
              ("https://crates.io/api/v1/crates/root/1.0.4/dependencies"
               (open-input-string test-root-dependencies))
@@ -461,7 +499,7 @@ (define have-guile-semver?
              ("https://crates.io/api/v1/crates/intermediate-a/1.0.42/download"
               (set! test-source-hash
                     (bytevector->nix-base32-string
-                     (sha256 (string->bytevector "empty file\n" "utf-8"))))
+                     (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
               (open-input-string "empty file\n"))
              ("https://crates.io/api/v1/crates/intermediate-a/1.0.42/dependencies"
               (open-input-string test-intermediate-a-dependencies))
@@ -470,7 +508,7 @@ (define have-guile-semver?
              ("https://crates.io/api/v1/crates/intermediate-b/1.2.3/download"
               (set! test-source-hash
                     (bytevector->nix-base32-string
-                     (sha256 (string->bytevector "empty file\n" "utf-8"))))
+                     (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))
@@ -479,7 +517,7 @@ (define have-guile-semver?
              ("https://crates.io/api/v1/crates/intermediate-c/1.0.1/download"
               (set! test-source-hash
                     (bytevector->nix-base32-string
-                     (sha256 (string->bytevector "empty file\n" "utf-8"))))
+                     (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
               (open-input-string "empty file\n"))
              ("https://crates.io/api/v1/crates/intermediate-c/1.0.1/dependencies"
               (open-input-string test-intermediate-c-dependencies))
@@ -488,7 +526,7 @@ (define have-guile-semver?
              ("https://crates.io/api/v1/crates/leaf-alice/0.7.5/download"
               (set! test-source-hash
                     (bytevector->nix-base32-string
-                     (sha256 (string->bytevector "empty file\n" "utf-8"))))
+                     (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
               (open-input-string "empty file\n"))
              ("https://crates.io/api/v1/crates/leaf-alice/0.7.5/dependencies"
               (open-input-string test-leaf-alice-dependencies))
@@ -497,7 +535,7 @@ (define have-guile-semver?
              ("https://crates.io/api/v1/crates/leaf-bob/3.0.1/download"
               (set! test-source-hash
                     (bytevector->nix-base32-string
-                     (sha256 (string->bytevector "empty file\n" "utf-8"))))
+                     (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
               (open-input-string "empty file\n"))
              ("https://crates.io/api/v1/crates/leaf-bob/3.0.1/dependencies"
               (open-input-string test-leaf-bob-dependencies))
@@ -814,85 +852,74 @@ (define-public 'rust-root-1
 
 
 \f
-(define test-doctool-crate
-  "{
-  \"crate\": {
-    \"max_version\": \"2.2.2\",
-    \"name\": \"leaf-bob\",
-    \"description\": \"summary\",
-    \"homepage\": \"http://example.com\",
-    \"repository\": \"http://example.com\",
-    \"keywords\": [\"dummy\", \"test\"],
-    \"categories\": [\"test\"]
-    \"actual_versions\": [
-      { \"id\": 234280,
-        \"num\": \"2.2.2\",
-        \"license\": \"MIT OR Apache-2.0\",
-        \"links\": {
-          \"dependencies\": \"/api/v1/crates/doctool/2.2.2/dependencies\"
-        },
-        \"yanked\": false
-      }
-    ]
-  }
-}")
-
-;; FIXME: This test depends on some existing packages
-(define test-doctool-dependencies
-  "{
-  \"dependencies\": [
-     {
-       \"crate_id\": \"docopt\",
-       \"kind\": \"normal\",
-       \"req\": \"^0.8.1\"
-     }
-  ]
-}")
-
-
-(test-assert "self-test: rust-docopt 0.8.x is gone, please adjust the test case"
-  (not (null? (find-packages-by-name "rust-docopt" "0.8"))))
+(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)))
 
 (unless have-guile-semver? (test-skip 1))
-(test-assert "cargo-recursive-import-hoors-existing-packages"
-  (mock ((guix http-client) http-fetch
-         (lambda (url . rest)
-           (match url
-             ("https://crates.io/api/v1/crates/doctool"
-              (open-input-string test-doctool-crate))
-             ("https://crates.io/api/v1/crates/doctool/2.2.2/download"
-              (set! test-source-hash
-                    (bytevector->nix-base32-string
-                     (sha256 (string->bytevector "empty file\n" "utf-8"))))
-              (open-input-string "empty file\n"))
-             ("https://crates.io/api/v1/crates/doctool/2.2.2/dependencies"
-              (open-input-string test-doctool-dependencies))
-             (_ (error "Unexpected URL: " url)))))
-        (match (crate-recursive-import "doctool")
-          (((define-public 'rust-doctool-2
-              (package
-                (name "rust-doctool")
-                (version "2.2.2")
-                (source
-                 (origin
-                   (method url-fetch)
-                   (uri (crate-uri "doctool" version))
-                   (file-name
-                    (string-append name "-" version ".tar.gz"))
-                   (sha256
-                    (base32
-                     (?  string? hash)))))
-                (build-system cargo-build-system)
-                (arguments
-                 ('quasiquote (#:cargo-inputs
-                               (("rust-docopt"
-                                 ('unquote 'rust-docopt-0.8))))))
-                (home-page "http://example.com")
-                (synopsis "summary")
-                (description "summary")
-                (license (list license:expat license:asl2.0)))))
-            #t)
-          (x
-           (pk 'fail x #f)))))
+(test-assert "crate-recursive-import-honors-existing-packages"
+  (mock
+   ((gnu packages) find-packages-by-name
+    (lambda* (name #:optional version)
+      (match name
+        ("rust-leaf-bob"
+         (list rust-leaf-bob-3))
+        (_ '()))))
+   (mock
+    ((guix http-client) http-fetch
+     (lambda (url . rest)
+       (match url
+         ("https://crates.io/api/v1/crates/bar"
+          (open-input-string test-bar-crate))
+         ("https://crates.io/api/v1/crates/bar/1.0.0/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/bar/1.0.0/dependencies"
+          (open-input-string test-bar-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.2/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/leaf-bob/3.0.2/dependencies"
+          (open-input-string test-leaf-bob-dependencies))
+         (_ (error "Unexpected URL: " url)))))
+    (match (crate-recursive-import "bar")
+      (((define-public 'rust-bar-1
+          (package
+            (name "rust-bar")
+            (version "1.0.0")
+            (source
+             (origin
+               (method url-fetch)
+               (uri (crate-uri "bar" version))
+               (file-name
+                (string-append name "-" version ".tar.gz"))
+               (sha256
+                (base32
+                 (?  string? hash)))))
+            (build-system cargo-build-system)
+            (arguments
+             ('quasiquote (#:cargo-inputs
+                           (("rust-leaf-bob"
+                             ('unquote 'rust-leaf-bob-3))))))
+            (home-page "http://example.com")
+            (synopsis "summary")
+            (description "summary")
+            (license (list license:expat license:asl2.0)))))
+       #t)
+      (x
+       (pk 'fail x #f))))))
 
 (test-end "crate")
-- 
2.41.0





^ permalink raw reply related	[flat|nested] 7+ messages in thread

* [bug#67960] [PATCH 4/4] guix: import: Optionally import necessary yanked crates.
  2023-12-21 21:59 [bug#67960] [PATCH 0/4] Improve the crate importer David Elsing
                   ` (2 preceding siblings ...)
  2023-12-21 22:01 ` [bug#67960] [PATCH 3/4] tests: Mock find-packages-by-name in crate importer test David Elsing
@ 2023-12-21 22:01 ` David Elsing
  2024-01-02 20:38 ` [bug#67960] [PATCH 0/4] Improve the crate importer Jaeme Sifat via Guix-patches via
  4 siblings, 0 replies; 7+ messages in thread
From: David Elsing @ 2023-12-21 22:01 UTC (permalink / raw)
  To: 67960; +Cc: David Elsing

* doc/guix.texi (Invoking guix import): Mention '--allow-yanked'.
* guix/import/crate.scm (make-crate-sexp): Add yanked? argument. For yanked
packages, use the full version suffixed by "-yanked" for generated variable
names and add a comment and package property.
(crate->guix-package): Add allow-yanked? argument and if it is set to #t,
allow importing yanked crates if no other version matching the requirements
exists.
[find-package-version]: Packages previously marked as yanked are only included
if allow-yanked? is #t and then take the lowest priority.
[find-crate-version]: If allow-yanked? is #t, also consider yanked versions
with the lowest priority.
[dependency-name+version]: Rename to ...
[dependency-name+version+yanked] ...this. Honor allow-yanked? and choose
between an existing package and an upstream package.  Exit with an error
message if no version fulfilling the requirement is found.
[version*]: Exit with an error message if the crate version is not found.
(cargo-recursive-import): Add allow-yanked? argument.
* guix/read-print.scm: Export <comment>.
* guix/scripts/import/crate.scm: Add "--allow-yanked".
* tests/crate.scm: Add test 'crate-recursive-import-only-yanked-available'.
[sort-map-dependencies]: Adjust accordingly.
[remove-yanked-info]: New variable.
Adjust test 'crate-recursive-import-honors-existing-packages'.
(test-bar-dependencies): Add yanked dev-dependencies.
(test-leaf-bob-crate): Add yanked versions.
(rust-leaf-bob-3.0.2-yanked): New variable.
---
 doc/guix.texi                 |   3 +
 guix/import/crate.scm         | 139 ++++++++++++++++++------
 guix/read-print.scm           |   1 +
 guix/scripts/import/crate.scm |  14 ++-
 tests/crate.scm               | 193 +++++++++++++++++++++++++++++++++-
 5 files changed, 310 insertions(+), 40 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index a19671643b..da36f90e9b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -14516,6 +14516,9 @@ in Guix.
 If @option{--recursive} is specified, also the recursively imported
 packages contain their development dependencies, which are recursively
 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.
 @end table
 
 @item elm
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index db5461312f..e3b8286350 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -26,12 +26,15 @@
 (define-module (guix import crate)
   #:use-module (guix base32)
   #:use-module (guix build-system cargo)
+  #:use-module (guix diagnostics)
   #:use-module (gcrypt hash)
   #:use-module (guix http-client)
+  #:use-module (guix i18n)
   #:use-module (guix import json)
   #:use-module (guix import utils)
   #:use-module (guix memoization)
   #:use-module (guix packages)
+  #:use-module (guix read-print)
   #:use-module (guix upstream)
   #:use-module (guix utils)
   #:use-module (gnu packages)
@@ -41,6 +44,7 @@ (define-module (guix import crate)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-69)
   #:use-module (srfi srfi-71)
   #:export (crate->guix-package
             guix-package->crate-name
@@ -100,7 +104,7 @@ (define-json-mapping <crate-dependency> make-crate-dependency
 
 ;; Autoload Guile-Semver so we only have a soft dependency.
 (module-autoload! (current-module)
-		  '(semver) '(string->semver semver->string semver<?))
+		  '(semver) '(string->semver semver->string semver<? semver=?))
 (module-autoload! (current-module)
 		  '(semver ranges) '(string->semver-range semver-range-contains?))
 
@@ -165,16 +169,18 @@ (define (version->semver-prefix version)
         (list-matches "^(0+\\.){,2}[0-9]+" version))))
 
 (define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inputs
-                          home-page synopsis description license build?)
+                          home-page synopsis description license build? yanked?)
   "Return the `package' s-expression for a rust package with the given NAME,
 VERSION, CARGO-INPUTS, CARGO-DEVELOPMENT-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION,
 and LICENSE."
   (define (format-inputs inputs)
     (map
      (match-lambda
-      ((name version)
+      ((name version yanked)
        (list (crate-name->package-name name)
-             (version->semver-prefix version))))
+             (if yanked
+                 (string-append version "-yanked")
+                 (version->semver-prefix version)))))
      inputs))
 
   (let* ((port (http-fetch (crate-uri name version)))
@@ -184,6 +190,9 @@ (define (format-inputs inputs)
          (pkg `(package
                    (name ,guix-name)
                    (version ,version)
+                   ,@(if yanked?
+                         `(,(comment "; This version was yanked!\n" #t))
+                         '())
                    (source (origin
                              (method url-fetch)
                              (uri (crate-uri ,name version))
@@ -191,6 +200,9 @@ (define (format-inputs inputs)
                              (sha256
                               (base32
                                ,(bytevector->nix-base32-string (port-sha256 port))))))
+                   ,@(if yanked?
+                         `((properties '((crate-version-yanked? . #t))))
+                         '())
                    (build-system cargo-build-system)
                    ,@(maybe-arguments (append (if build?
                                                  '()
@@ -207,7 +219,10 @@ (define (format-inputs inputs)
                                ((license) license)
                                (_ `(list ,@license)))))))
          (close-port port)
-         (package->definition pkg (version->semver-prefix version))))
+         (package->definition pkg
+                              (if yanked?
+                                  (string-append version "-yanked")
+                                  (version->semver-prefix version)))))
 
 (define (string->license string)
   (filter-map (lambda (license)
@@ -218,8 +233,9 @@ (define (string->license string)
                          'unknown-license!)))
               (string-split string (string->char-set " /"))))
 
-(define* (crate->guix-package crate-name #:key version include-dev-deps?
-                              #:allow-other-keys)
+(define* (crate->guix-package
+          crate-name
+          #:key version include-dev-deps? allow-yanked? #: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
@@ -243,63 +259,112 @@ (define version-number
          (or version
              (crate-latest-version crate))))
 
-  ;; find the highest existing package that fulfills the semver <range>
+  ;; Find the highest existing package that fulfills the semver
+  ;; <range>. Packages previously marked as yanked take lower priority.
   (define (find-package-version name range)
     (let* ((semver-range (string->semver-range range))
-           (versions
+           (package-versions
             (sort
-             (filter (lambda (version)
-                       (semver-range-contains? semver-range version))
+             (filter (match-lambda ((semver yanked)
+                                    (and
+                                     (or allow-yanked? (not yanked))
+                                     (semver-range-contains? semver-range semver))))
                      (map (lambda (pkg)
-                            (string->semver (package-version pkg)))
+                            (let ((version (package-version pkg)))
+                              (list
+                               (string->semver version)
+                               (assoc-ref (package-properties pkg) 'crate-version-yanked?))))
                           (find-packages-by-name
                            (crate-name->package-name name))))
-             semver<?)))
-      (and (not (null-list? versions))
-           (semver->string (last versions)))))
-
-  ;; Find the highest version of a crate that fulfills the semver <range>
-  ;; and hasn't been yanked.
+             (match-lambda* (((semver1 yanked1) (semver2 yanked2))
+                             (or
+                              (and yanked1 (not yanked2))
+                              (and
+                               (eq? yanked1 yanked2)
+                               (semver<? semver1 semver2))))))))
+      (and (not (null-list? package-versions))
+           (match-let (((semver yanked) (last package-versions)))
+             (list (semver->string semver) yanked)))))
+
+  ;; Find the highest version of a crate that fulfills the semver <range>. If
+  ;; no matching non-yanked version has been found and allow-yanked? is #t,
+  ;; also consider yanked packages.
   (define (find-crate-version crate range)
     (let* ((semver-range (string->semver-range range))
            (versions
             (sort
              (filter (lambda (entry)
                        (and
-                         (not (crate-version-yanked? (second entry)))
-                         (semver-range-contains? semver-range (first entry))))
+                        (or allow-yanked? (not (crate-version-yanked? (second entry))))
+                        (semver-range-contains? semver-range (first entry))))
                      (map (lambda (ver)
                             (list (string->semver (crate-version-number ver))
                                   ver))
                           (crate-versions crate)))
-             (match-lambda* (((semver _) ...)
-                             (apply semver<? semver))))))
+             (match-lambda* (((semver ver) ...)
+                             (match-let (((yanked1 yanked2)
+                                          (map crate-version-yanked? ver)))
+                               (or
+                                (and yanked1 (not yanked2))
+                                (and
+                                 (eq? yanked1 yanked2)
+                                 (apply semver<? semver)))))))))
       (and (not (null-list? versions))
            (second (last versions)))))
 
-  (define (dependency-name+version dep)
+  ;; 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)
     (let* ((name (crate-dependency-id dep))
-           (req (crate-dependency-requirement dep))
-           (existing-version (find-package-version name req)))
-      (if existing-version
-          (list name existing-version)
+                 (req (crate-dependency-requirement dep))
+                 (existing-version (find-package-version name req)))
+      (if (and existing-version (not (second existing-version)))
+          (cons name existing-version)
           (let* ((crate (lookup-crate* name))
                  (ver (find-crate-version crate req)))
-            (list name
-                  (crate-version-number ver))))))
+            (if existing-version
+                (if (and ver (not (crate-version-yanked? ver)))
+                    (if (semver=? (string->semver (first existing-version))
+                                  (string->semver (crate-version-number ver)))
+                        (begin
+                          (warning (G_ "~A: version ~a is no longer yanked~%") name (first existing-version))
+                          (cons name existing-version))
+                        (list name
+                              (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)))
+                (begin
+                  (unless ver
+                    (leave (G_ "~A: no version found for requirement ~a~%") name req))
+                  (if (crate-version-yanked? ver)
+                      (warning (G_ "~A: imported version ~a was yanked~%") name (crate-version-number ver)))
+                  (list name
+                        (crate-version-number ver)
+                        (crate-version-yanked? ver))))))))
 
   (define version*
     (and crate
-         (find-crate-version crate version-number)))
+         (or
+          (find-crate-version crate version-number)
+          (leave (G_ "~A: version ~a not found~%") crate-name version-number))))
 
   ;; sort and map the dependencies to a list containing
   ;; pairs of (name version)
   (define (sort-map-dependencies deps)
-    (sort (map dependency-name+version
+    (sort (map dependency-name+version+yanked
                deps)
-          (match-lambda* (((name _) ...)
+          (match-lambda* (((name _ _) ...)
                           (apply string-ci<? name)))))
 
+  (define (remove-yanked-info deps)
+    (map
+     (match-lambda ((name version yanked)
+                    (list name version)))
+     deps))
+
   (if (and crate version*)
       (let* ((dependencies (crate-version-dependencies version*))
              (dep-crates dev-dep-crates (partition normal-dependency? dependencies))
@@ -309,6 +374,7 @@ (define (sort-map-dependencies deps)
                                            '())))
         (values
          (make-crate-sexp #:build? include-dev-deps?
+                          #:yanked? (crate-version-yanked? version*)
                           #:name crate-name
                           #:version (crate-version-number version*)
                           #:cargo-inputs cargo-inputs
@@ -325,11 +391,13 @@ (define (sort-map-dependencies deps)
                           #:description (crate-description crate)
                           #:license (and=> (crate-version-license version*)
                                            string->license))
-         (append cargo-inputs cargo-development-inputs)))
+         (append
+          (remove-yanked-info cargo-inputs)
+          (remove-yanked-info cargo-development-inputs))))
       (values #f '())))
 
 (define* (crate-recursive-import
-          crate-name #:key version recursive-dev-dependencies?)
+          crate-name #:key version recursive-dev-dependencies? allow-yanked?)
   (recursive-import
    crate-name
    #:repo->guix-package
@@ -340,7 +408,8 @@ (define* (crate-recursive-import
               (or (equal? (car params) crate-name)
                   recursive-dev-dependencies?)))
          (apply crate->guix-package*
-                (append params `(#:include-dev-deps? ,include-dev-deps?))))))
+                (append params `(#:include-dev-deps? ,include-dev-deps?
+                                 #:allow-yanked? ,allow-yanked?))))))
    #:version version
    #:guix-name crate-name->package-name))
 
diff --git a/guix/read-print.scm b/guix/read-print.scm
index 690f5dacdd..6421b79737 100644
--- a/guix/read-print.scm
+++ b/guix/read-print.scm
@@ -46,6 +46,7 @@ (define-module (guix read-print)
             page-break
             page-break?
 
+            <comment>
             comment
             comment?
             comment->string
diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm
index b13b6636a6..082a973aee 100644
--- a/guix/scripts/import/crate.scm
+++ b/guix/scripts/import/crate.scm
@@ -51,6 +51,10 @@ (define (show-help)
   (display (G_ "
       --recursive-dev-dependencies
                          include dev-dependencies recursively"))
+  (display (G_ "
+      --allow-yanked
+                         allow importing yanked crates if no alternative
+                         satisfying the version requirement exists"))
   (newline)
   (display (G_ "
   -h, --help             display this help and exit"))
@@ -74,6 +78,9 @@ (define %options
          (option '("recursive-dev-dependencies") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'recursive-dev-dependencies #t result)))
+         (option '("allow-yanked") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'allow-yanked #t result)))
          %standard-import-options))
 
 \f
@@ -102,8 +109,11 @@ (define-values (name version)
                   (crate-recursive-import
                    name #:version version
                    #:recursive-dev-dependencies?
-                   (assoc-ref opts 'recursive-dev-dependencies))
-                  (crate->guix-package name #:version version #:include-dev-deps? #t))
+                   (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)))
          ((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 e779f738b3..ce2f08aade 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -28,6 +28,7 @@ (define-module (test-crate)
   #:use-module ((gcrypt hash)
                 #:select ((sha256 . gcrypt-sha256)))
   #:use-module (guix packages)
+  #:use-module (guix read-print)
   #:use-module (guix tests)
   #:use-module (gnu packages)
   #:use-module (ice-9 iconv)
@@ -42,6 +43,8 @@ (define-module (test-crate)
 ;; 	leaf-alice 0.7.5
 ;; bar-1.0.0
 ;;      leaf-bob   3.0.1
+;;      leaf-bob   3.0.2 (dev-dependency)
+;;      leaf-bob   4.0.0 (dev-dependency)
 ;;
 ;; root-1.0.0
 ;; root-1.0.4
@@ -68,6 +71,8 @@ (define-module (test-crate)
 ;; leaf-alice-0.7.5
 ;;
 ;; leaf-bob-3.0.1
+;; leaf-bob-3.0.2 (yanked)
+;; leaf-bob-4.0.0 (yanked)
 
 
 (define test-foo-crate
@@ -150,6 +155,16 @@ (define test-bar-dependencies
        \"crate_id\": \"leaf-bob\",
        \"kind\": \"normal\",
        \"req\": \"3.0.1\"
+     },
+     {
+       \"crate_id\": \"leaf-bob\",
+       \"kind\": \"dev\",
+       \"req\": \"^3.0.2\"
+     },
+     {
+       \"crate_id\": \"leaf-bob\",
+       \"kind\": \"dev\",
+       \"req\": \"^4.0.0\"
      }
   ]
 }")
@@ -398,6 +413,22 @@ (define test-leaf-bob-crate
           \"dependencies\": \"/api/v1/crates/leaf-bob/3.0.1/dependencies\"
         },
         \"yanked\": false
+      },
+      { \"id\": 234281,
+        \"num\": \"3.0.2\",
+        \"license\": \"MIT OR Apache-2.0\",
+        \"links\": {
+          \"dependencies\": \"/api/v1/crates/leaf-bob/3.0.2/dependencies\"
+        },
+        \"yanked\": true
+      },
+      { \"id\": 234282,
+        \"num\": \"4.0.0\",
+        \"license\": \"MIT OR Apache-2.0\",
+        \"links\": {
+          \"dependencies\": \"/api/v1/crates/leaf-bob/4.0.0/dependencies\"
+        },
+        \"yanked\": true
       }
     ]
   }
@@ -863,6 +894,18 @@ (define rust-leaf-bob-3
     (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
@@ -870,7 +913,7 @@ (define rust-leaf-bob-3
     (lambda* (name #:optional version)
       (match name
         ("rust-leaf-bob"
-         (list rust-leaf-bob-3))
+         (list rust-leaf-bob-3 rust-leaf-bob-3.0.2-yanked))
         (_ '()))))
    (mock
     ((guix http-client) http-fetch
@@ -894,8 +937,16 @@ (define rust-leaf-bob-3
           (open-input-string "empty file\n"))
          ("https://crates.io/api/v1/crates/leaf-bob/3.0.2/dependencies"
           (open-input-string test-leaf-bob-dependencies))
+         ("https://crates.io/api/v1/crates/leaf-bob/4.0.0/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/leaf-bob/4.0.0/dependencies"
+          (open-input-string test-leaf-bob-dependencies))
          (_ (error "Unexpected URL: " url)))))
-    (match (crate-recursive-import "bar")
+    (match (crate-recursive-import "bar"
+                                   #:allow-yanked? #t)
       (((define-public 'rust-bar-1
           (package
             (name "rust-bar")
@@ -913,7 +964,12 @@ (define rust-leaf-bob-3
             (arguments
              ('quasiquote (#:cargo-inputs
                            (("rust-leaf-bob"
-                             ('unquote 'rust-leaf-bob-3))))))
+                             ('unquote 'rust-leaf-bob-3)))
+                           #:cargo-development-inputs
+                           (("rust-leaf-bob"
+                             ('unquote 'rust-leaf-bob-3.0.2-yanked))
+                            ("rust-leaf-bob"
+                             ('unquote 'rust-leaf-bob-4.0.0-yanked))))))
             (home-page "http://example.com")
             (synopsis "summary")
             (description "summary")
@@ -922,4 +978,135 @@ (define rust-leaf-bob-3
       (x
        (pk 'fail x #f))))))
 
+(unless have-guile-semver? (test-skip 1))
+(test-assert "crate-import-only-yanked-available"
+  (mock
+   ((guix http-client) http-fetch
+    (lambda (url . rest)
+      (match url
+        ("https://crates.io/api/v1/crates/bar"
+         (open-input-string test-bar-crate))
+        ("https://crates.io/api/v1/crates/bar/1.0.0/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/bar/1.0.0/dependencies"
+         (open-input-string test-bar-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"))
+        ("https://crates.io/api/v1/crates/leaf-bob/3.0.1/dependencies"
+         (open-input-string test-leaf-bob-dependencies))
+        ("https://crates.io/api/v1/crates/leaf-bob/3.0.2/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/leaf-bob/3.0.2/dependencies"
+         (open-input-string test-leaf-bob-dependencies))
+        ("https://crates.io/api/v1/crates/leaf-bob/4.0.0/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/leaf-bob/4.0.0/dependencies"
+         (open-input-string test-leaf-bob-dependencies))
+        (_ (error "Unexpected URL: " url)))))
+        (match (crate-recursive-import "bar"
+                                       #:recursive-dev-dependencies? #t
+                                       #:allow-yanked? #t)
+          (((define-public 'rust-leaf-bob-4.0.0-yanked
+              (package
+                (name "rust-leaf-bob")
+                (version "4.0.0")
+                ($ <comment> "; This version was yanked!\n" #t)
+                (source
+                 (origin
+                   (method url-fetch)
+                   (uri (crate-uri "leaf-bob" version))
+                   (file-name
+                    (string-append name "-" version ".tar.gz"))
+                   (sha256
+                    (base32
+                     (?  string? hash)))))
+                (properties ('quote (('crate-version-yanked? . #t))))
+                (build-system cargo-build-system)
+                (home-page "http://example.com")
+                (synopsis "summary")
+                (description "summary")
+                (license (list license:expat license:asl2.0))))
+            (define-public 'rust-leaf-bob-3.0.2-yanked
+              (package
+                (name "rust-leaf-bob")
+                (version "3.0.2")
+                ($ <comment> "; This version was yanked!\n" #t)
+                (source
+                 (origin
+                   (method url-fetch)
+                   (uri (crate-uri "leaf-bob" version))
+                   (file-name
+                    (string-append name "-" version ".tar.gz"))
+                   (sha256
+                    (base32
+                     (?  string? hash)))))
+                (properties ('quote (('crate-version-yanked? . #t))))
+                (build-system cargo-build-system)
+                (home-page "http://example.com")
+                (synopsis "summary")
+                (description "summary")
+                (license (list license:expat license:asl2.0))))
+            (define-public 'rust-leaf-bob-3
+              (package
+                (name "rust-leaf-bob")
+                (version "3.0.1")
+                (source
+                 (origin
+                   (method url-fetch)
+                   (uri (crate-uri "leaf-bob" version))
+                   (file-name
+                    (string-append name "-" version ".tar.gz"))
+                   (sha256
+                    (base32
+                     (?  string? hash)))))
+                (build-system cargo-build-system)
+                (home-page "http://example.com")
+                (synopsis "summary")
+                (description "summary")
+                (license (list license:expat license:asl2.0))))
+            (define-public 'rust-bar-1
+              (package
+                (name "rust-bar")
+                (version "1.0.0")
+                (source
+                 (origin
+                   (method url-fetch)
+                   (uri (crate-uri "bar" version))
+                   (file-name
+                    (string-append name "-" version ".tar.gz"))
+                   (sha256
+                    (base32
+                     (?  string? hash)))))
+                (build-system cargo-build-system)
+                (arguments
+                 ('quasiquote (#:cargo-inputs
+                               (("rust-leaf-bob"
+                                 ('unquote 'rust-leaf-bob-3)))
+                               #:cargo-development-inputs
+                               (("rust-leaf-bob"
+                                 ('unquote 'rust-leaf-bob-3.0.2-yanked))
+                                ("rust-leaf-bob"
+                                 ('unquote 'rust-leaf-bob-4.0.0-yanked))))))
+                (home-page "http://example.com")
+                (synopsis "summary")
+                (description "summary")
+                (license (list license:expat license:asl2.0)))))
+            #t)
+          (x
+           (pk 'fail (pretty-print-with-comments (current-output-port) x) #f)))))
+
 (test-end "crate")
-- 
2.41.0





^ permalink raw reply related	[flat|nested] 7+ messages in thread

* [bug#67960] [PATCH 0/4] Improve the crate importer.
  2023-12-21 21:59 [bug#67960] [PATCH 0/4] Improve the crate importer David Elsing
                   ` (3 preceding siblings ...)
  2023-12-21 22:01 ` [bug#67960] [PATCH 4/4] guix: import: Optionally import necessary yanked crates David Elsing
@ 2024-01-02 20:38 ` Jaeme Sifat via Guix-patches via
  2024-01-09  7:44   ` bug#67960: " Efraim Flashner
  4 siblings, 1 reply; 7+ messages in thread
From: Jaeme Sifat via Guix-patches via @ 2024-01-02 20:38 UTC (permalink / raw)
  To: 67960; +Cc: david.elsing, efraim

I've used this to great effect when writing my crates and the test file 
passes. This should definitely be merged into master soon as this is a 
necessity for me when writing crate definitions.

Thanks for fixing the crate importer, it will be vital when trying to 
port things like `iced-0.10` and `nushell-0.88` into rust-team.


What do you think Efraim?

--

Jaeme





^ permalink raw reply	[flat|nested] 7+ messages in thread

* bug#67960: [PATCH 0/4] Improve the crate importer.
  2024-01-02 20:38 ` [bug#67960] [PATCH 0/4] Improve the crate importer Jaeme Sifat via Guix-patches via
@ 2024-01-09  7:44   ` Efraim Flashner
  0 siblings, 0 replies; 7+ messages in thread
From: Efraim Flashner @ 2024-01-09  7:44 UTC (permalink / raw)
  To: Jaeme Sifat; +Cc: david.elsing, 67960-done

[-- Attachment #1: Type: text/plain, Size: 695 bytes --]

On Tue, Jan 02, 2024 at 03:38:41PM -0500, Jaeme Sifat wrote:
> I've used this to great effect when writing my crates and the test file
> passes. This should definitely be merged into master soon as this is a
> necessity for me when writing crate definitions.
> 
> Thanks for fixing the crate importer, it will be vital when trying to port
> things like `iced-0.10` and `nushell-0.88` into rust-team.
> 
> 
> What do you think Efraim?

Looks good to me.  Patches pushed!

-- 
Efraim Flashner   <efraim@flashner.co.il>   רנשלפ םירפא
GPG key = A28B F40C 3E55 1372 662D  14F7 41AA E7DC CA3D 8351
Confidentiality cannot be guaranteed on emails sent or received unencrypted

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]

^ permalink raw reply	[flat|nested] 7+ messages in thread

end of thread, other threads:[~2024-01-09  7:45 UTC | newest]

Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-12-21 21:59 [bug#67960] [PATCH 0/4] Improve the crate importer David Elsing
2023-12-21 22:01 ` [bug#67960] [PATCH 1/4] gnu: import: Fix memoization in crate-recursive-import David Elsing
2023-12-21 22:01 ` [bug#67960] [PATCH 2/4] import: crate: Optionally import dev-dependencies recursively David Elsing
2023-12-21 22:01 ` [bug#67960] [PATCH 3/4] tests: Mock find-packages-by-name in crate importer test David Elsing
2023-12-21 22:01 ` [bug#67960] [PATCH 4/4] guix: import: Optionally import necessary yanked crates David Elsing
2024-01-02 20:38 ` [bug#67960] [PATCH 0/4] Improve the crate importer Jaeme Sifat via Guix-patches via
2024-01-09  7:44   ` bug#67960: " Efraim Flashner

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).