Subject: [bug#35813] [PATCH] Add crate-recursive-import.

From: Brian Leung <[email-masked]>
Date: Sat, 7 Sep 2019 23:49:59 +0200

Hi Efraim,

An updated patch is attached.

I was and still am confused why my previous patch was yielding duplicates.
I'm not getting duplicates right now, even with packages that previously
yielded duplicates (I tried this on ripgrep); please test and let me know
if there are any issues. Maybe I fixed the issue in the course of rebasing?

And "guix import crate -r asfeusnoetuhesont" should now print "failed to
download meta-data for...", though I don't know how to do this more
idiomatically without using error or leave (which would end the recursive
import earlier than desired). And the double quotes actually appear, which
is not ideal. I'd appreciate any advice on how to clean this up.

Best,
Brian

On Thu, Aug 8, 2019 at 12:39 PM Efraim Flashner <[email-masked]>
wrote:

> On Tue, Aug 06, 2019 at 06:03:23PM +0200, Brian Leung wrote:
> > Should have sent this to you too, Ivan.
> >
> > On Tue, Aug 6, 2019 at 5:42 AM Brian Leung <[email-masked]> wrote:
> >
> > > OK, I updated to remove print statements I missed.
> > >
> > > On Mon, Aug 5, 2019 at 7:50 PM Brian Leung <[email-masked]>
> wrote:
> > >
> > >> I took Karl's changes and updated them accordingly. I've also added a
> > >> small test. The patch containing his importer, my changes, and my
> test is
> > >> attached (the commit was made using my name--not sure if I should
> instead
> > >> apply Karl's patch).
> > >>
> > >
>
> I ran 'guix import crate -r afl' on a machine where I had a bunch of
> crates pre-packaged the (very shorted output looked like this:
>
> (define-public rust-xdg
> ...
>
> (define-public rust-xdg
> ...
>
> (define-public rust-afl
>   (package
>     (name "rust-afl")
>     (version "0.4.4")
>     (source
>       (origin
>         (method url-fetch)
>         (uri (crate-uri "afl" version))
>         (file-name
>           (string-append name "-" version ".tar.gz"))
>         (sha256
>           (base32
>             "14k6hnwzqn7rrs0hs87vcfqj4334k9wff38d15378frlxpviaard"))))
>     (build-system cargo-build-system)
>     (arguments
>       `(#:cargo-inputs
>         (("rust-cc" ,rust-cc)
>          ("rust-clap" ,rust-clap)
>          ("rust-rustc-version" ,rust-rustc-version)
>          ("rust-xdg" ,rust-xdg))
>         #:cargo-development-inputs
>         (("rust-rustc-version" ,rust-rustc-version)
>          ("rust-xdg" ,rust-xdg))))
>     (home-page "https://github.com/rust-fuzz/afl.rs")
>     (synopsis
>       "Fuzzing Rust code with american-fuzzy-lop")
>     (description
>       "Fuzzing Rust code with american-fuzzy-lop")
>     (license #f)))
>
> I know rust-xdg is there twice, but IMO it should only be printed once.
>
> also 'guix import crate -r rusty-fork' gives me #f
> 'guix import crate rusty-fork' gives me:
> guix import: error: failed to download meta-data for package 'rusty-fork'
>
>
> --
> Efraim Flashner   <[email-masked]>   אפרים פלשנר
> GPG key = A28B F40C 3E55 1372 662D  14F7 41AA E7DC CA3D 8351
> Confidentiality cannot be guaranteed on emails sent or received unencrypted
>
From 751bf2367edf54015792f339dcaca797cd7da937 Mon Sep 17 00:00:00 2001
From: Brian Leung <[email-masked]>
Date: Sat, 20 Jul 2019 21:35:14 +0200
Subject: [PATCH] gnu: Add crate-recursive-import.

* guix/import/crate.scm (crate-recursive-import): New variable.
* guix/script/import/crate.scm: Add recursive option.
* guix/tests/crate.scm (crate-recursive-import): New test.
---
---
 guix/import/crate.scm         | 131 +++++++++++++------------
 guix/import/utils.scm         |  16 ++--
 guix/scripts/import/crate.scm |  32 ++++++-
 tests/crate.scm               | 173 +++++++++++++++++++++++++++++++++-
 4 files changed, 273 insertions(+), 79 deletions(-)

diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index f6057dbf8b..5e81c015d8 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -38,6 +38,7 @@
   #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-26)
   #:export (crate->guix-package
+            crate-recursive-import
             guix-package->crate-name
             %crate-updater))
 
@@ -147,78 +148,86 @@ VERSION, CARGO-INPUTS, CARGO-DEVELOPMENT-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTIO
 and LICENSE."
   (let* ((port (http-fetch (crate-uri name version)))
          (guix-name (crate-name->package-name name))
-         (cargo-inputs (map crate-name->package-name cargo-inputs))
-         (cargo-development-inputs (map crate-name->package-name
+         (inputs (map crate-name->package-name cargo-inputs))
+         (development-inputs (map crate-name->package-name
                                         cargo-development-inputs))
          (pkg `(package
-                   (name ,guix-name)
-                   (version ,version)
-                   (source (origin
-                             (method url-fetch)
-                             (uri (crate-uri ,name version))
-                             (file-name (string-append name "-" version ".tar.gz"))
-                             (sha256
-                              (base32
-                               ,(bytevector->nix-base32-string (port-sha256 port))))))
-                   (build-system cargo-build-system)
-                   ,@(maybe-arguments (append (maybe-cargo-inputs cargo-inputs)
-                                              (maybe-cargo-development-inputs
-                                                cargo-development-inputs)))
-                   (home-page ,(match home-page
-                                 (() "")
-                                 (_ home-page)))
-                   (synopsis ,synopsis)
-                   (description ,(beautify-description description))
-                   (license ,(match license
-                               (() #f)
-                               ((license) license)
-                               (_ `(list ,@license)))))))
-         (close-port port)
-         pkg))
+                 (name ,guix-name)
+                 (version ,version)
+                 (source (origin
+                           (method url-fetch)
+                           (uri (crate-uri ,name version))
+                           (file-name (string-append name "-" version ".tar.gz"))
+                           (sha256
+                            (base32
+                             ,(bytevector->nix-base32-string (port-sha256 port))))))
+                 (build-system cargo-build-system)
+                 ,@(maybe-arguments (append (maybe-cargo-inputs inputs)
+                                            (maybe-cargo-development-inputs
+                                             development-inputs)))
+                 (home-page ,(match home-page
+                               (() "")
+                               (_ home-page)))
+                 (synopsis ,synopsis)
+                 (description ,(beautify-description description))
+                 (license ,(match license
+                             (() #f)
+                             ((license) license)
+                             (_ `(list ,@license)))))))
+    (close-port port)
+    (values pkg
+            (lset-union equal? cargo-inputs cargo-development-inputs))))
 
 (define %dual-license-rx
   ;; Dual licensing is represented by a string such as "MIT OR Apache-2.0".
   ;; This regexp matches that.
   (make-regexp "^(.*) OR (.*)$"))
 
-(define (crate->guix-package crate-name)
-  "Fetch the metadata for CRATE-NAME from crates.io, and return the
-`package' s-expression corresponding to that package, or #f on failure."
-  (define (string->license string)
-    (match (regexp-exec %dual-license-rx string)
-      (#f (list (spdx-string->license string)))
-      (m  (list (spdx-string->license (match:substring m 1))
-                (spdx-string->license (match:substring m 2))))))
+(define (string->license string)
+  (match (regexp-exec %dual-license-rx string)
+    (#f (list (spdx-string->license string)))
+    (m  (list (spdx-string->license (match:substring m 1))
+              (spdx-string->license (match:substring m 2))))))
+
+(define (normal-dependency? dependency)
+  (eq? (crate-dependency-kind dependency) 'normal))
 
-  (define (normal-dependency? dependency)
-    (eq? (crate-dependency-kind dependency) 'normal))
+(define crate->guix-package
+  (memoize
+   (lambda (crate-name)
+     "Fetch the metadata for CRATE-NAME from crates.io, and return the
+`package' s-expression corresponding to that package, or #f on failure."
+     (define crate
+       (lookup-crate crate-name))
 
-  (define crate
-    (lookup-crate crate-name))
+     (and crate
+          (let* ((version        (find (lambda (version)
+                                         (string=? (crate-version-number version)
+                                                   (crate-latest-version crate)))
+                                       (crate-versions crate)))
+                 (dependencies   (crate-version-dependencies version))
+                 (dep-crates     (filter normal-dependency? dependencies))
+                 (dev-dep-crates (remove normal-dependency? dependencies))
+                 (cargo-inputs   (sort (map crate-dependency-id dep-crates)
+                                       string-ci<?))
+                 (cargo-development-inputs
+                  (sort (map crate-dependency-id dev-dep-crates)
+                        string-ci<?)))
+            (make-crate-sexp #:name crate-name
+                             #:version (crate-version-number version)
+                             #:cargo-inputs cargo-inputs
+                             #:cargo-development-inputs cargo-development-inputs
+                             #:home-page (or (crate-home-page crate)
+                                             (crate-repository crate))
+                             #:synopsis (crate-description crate)
+                             #:description (crate-description crate)
+                             #:license (and=> (crate-version-license version)
+                                              string->license)))))))
 
-  (and crate
-       (let* ((version        (find (lambda (version)
-                                      (string=? (crate-version-number version)
-                                                (crate-latest-version crate)))
-                                    (crate-versions crate)))
-              (dependencies   (crate-version-dependencies version))
-              (dep-crates     (filter normal-dependency? dependencies))
-              (dev-dep-crates (remove normal-dependency? dependencies))
-              (cargo-inputs   (sort (map crate-dependency-id dep-crates)
-                                    string-ci<?))
-              (cargo-development-inputs
-               (sort (map crate-dependency-id dev-dep-crates)
-                     string-ci<?)))
-         (make-crate-sexp #:name crate-name
-                          #:version (crate-version-number version)
-                          #:cargo-inputs cargo-inputs
-                          #:cargo-development-inputs cargo-development-inputs
-                          #:home-page (or (crate-home-page crate)
-                                          (crate-repository crate))
-                          #:synopsis (crate-description crate)
-                          #:description (crate-description crate)
-                          #:license (and=> (crate-version-license version)
-                                           string->license)))))
+(define* (crate-recursive-import package-name)
+  (recursive-import package-name #f
+                    #:repo->guix-package (lambda (name _) (crate->guix-package name))
+                    #:guix-name crate-name->package-name))
 
 (define (guix-package->crate-name package)
   "Return the crate name of PACKAGE."
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 252875eeab..e58f5cba94 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -381,16 +381,16 @@ dependencies."
       ((prev (next . rest) done)
        (define (handle? dep)
          (and
-           (not (equal? dep next))
-           (not (member dep done))
-           (not (exists? dep))))
+          (not (equal? dep next))
+          (not (member dep done))
+          (not (exists? dep))))
        (receive (package . dependencies) (repo->guix-package next repo)
          (list
-           (if package package '()) ;; default #f on failure would interrupt
-           (if package
-             (lset-union equal? rest (filter handle? (car dependencies)))
-             rest)
-           (cons next done))))
+          (or package next)
+          (if package
+              (lset-union equal? rest (filter handle? (car dependencies)))
+              rest)
+          (cons next done))))
       ((prev '() done)
        (list #f '() done))))
 
diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm
index cab9a4397b..9970b1a231 100644
--- a/guix/scripts/import/crate.scm
+++ b/guix/scripts/import/crate.scm
@@ -27,6 +27,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-37)
+  #:use-module (srfi srfi-41)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:export (guix-import-crate))
@@ -45,6 +46,8 @@ Import and convert the crate.io package for PACKAGE-NAME.\n"))
   (display (G_ "
   -h, --help             display this help and exit"))
   (display (G_ "
+  -r, --recursive        import packages recursively"))
+  (display (G_ "
   -V, --version          display version information and exit"))
   (newline)
   (show-bug-report-information))
@@ -58,6 +61,9 @@ Import and convert the crate.io package for PACKAGE-NAME.\n"))
          (option '(#\V "version") #f #f
                  (lambda args
                    (show-version-and-exit "guix import crate")))
+         (option '(#\r "recursive") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'recursive #t result)))
          %standard-import-options))
 
 
@@ -83,11 +89,27 @@ Import and convert the crate.io package for PACKAGE-NAME.\n"))
                            (reverse opts))))
     (match args
       ((package-name)
-       (let ((sexp (crate->guix-package package-name)))
-         (unless sexp
-           (leave (G_ "failed to download meta-data for package '~a'~%")
-                  package-name))
-         sexp))
+       (if (assoc-ref opts 'recursive)
+           ;; Recursive import
+           (map (match-lambda
+                  ((and ('package ('name name) . rest) pkg)
+                   `(define-public ,(string->symbol name)
+                      ,pkg))
+                  ((and string? pkg-name)
+                   ;; (format #f (G_ "failed to download meta-data for package '~a'") dep-name)
+                   (string-append "failed to download meta-data for package '"
+                                  pkg-name
+                                  "'"))
+                  (_ #f))
+                (reverse
+                 (stream->list
+                  (crate-recursive-import package-name))))
+           ;; Single import
+           (let ((sexp (crate->guix-package package-name)))
+             (unless sexp
+               (leave (G_ "failed to download meta-data for package '~a'~%")
+                      package-name))
+             sexp)))
       (()
        (leave (G_ "too few arguments~%")))
       ((many ...)
diff --git a/tests/crate.scm b/tests/crate.scm
index c14862ad9f..8e7b0bda9b 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -26,9 +26,10 @@
   #:use-module (guix tests)
   #:use-module (ice-9 iconv)
   #:use-module (ice-9 match)
+  #:use-module (srfi srfi-41)
   #:use-module (srfi srfi-64))
 
-(define test-crate
+(define test-foo-crate
   "{
   \"crate\": {
     \"max_version\": \"1.0.0\",
@@ -50,16 +51,81 @@
   }
 }")
 
-(define test-dependencies
+(define test-foo-dependencies
   "{
   \"dependencies\": [
      {
        \"crate_id\": \"bar\",
        \"kind\": \"normal\",
+     },
+     {
+       \"crate_id\": \"baz\",
+       \"kind\": \"normal\",
+     }
+  ]
+}")
+
+(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\": \"bar\",
+        \"num\": \"1.0.0\",
+        \"license\": \"MIT OR Apache-2.0\",
+        \"links\": {
+          \"dependencies\": \"/api/v1/crates/bar/1.0.0/dependencies\"
+        }
+      }
+    ]
+    \"license\": \"MIT OR Apache-2.0\",
+  }
+}")
+
+(define test-bar-dependencies
+  "{
+  \"dependencies\": [
+     {
+       \"crate_id\": \"baz\",
+       \"kind\": \"normal\",
      }
   ]
 }")
 
+(define test-baz-crate
+  "{
+  \"crate\": {
+    \"max_version\": \"1.0.0\",
+    \"name\": \"baz\",
+    \"description\": \"summary\",
+    \"homepage\": \"http://example.com\",
+    \"repository\": \"http://example.com\",
+    \"keywords\": [\"dummy\" \"test\"],
+    \"categories\": [\"test\"]
+    \"actual_versions\": [
+      { \"id\": \"baz\",
+        \"num\": \"1.0.0\",
+        \"license\": \"MIT OR Apache-2.0\",
+        \"links\": {
+          \"dependencies\": \"/api/v1/crates/baz/1.0.0/dependencies\"
+        }
+      }
+    ]
+    \"license\": \"MIT OR Apache-2.0\",
+  }
+}")
+
+(define test-baz-dependencies
+  "{
+\"dependencies\": []
+}")
+
 (define test-source-hash
   "")
 
@@ -79,14 +145,14 @@
          (lambda (url . rest)
            (match url
              ("https://crates.io/api/v1/crates/foo"
-              (open-input-string test-crate))
+              (open-input-string test-foo-crate))
              ("https://crates.io/api/v1/crates/foo/1.0.0/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/foo/1.0.0/dependencies"
-              (open-input-string test-dependencies))
+              (open-input-string test-foo-dependencies))
              (_ (error "Unexpected URL: " url)))))
     (match (crate->guix-package "foo")
       (('package
@@ -102,7 +168,8 @@
          ('build-system 'cargo-build-system)
          ('arguments
           ('quasiquote
-           ('#:cargo-inputs (("rust-bar" ('unquote rust-bar))))))
+           ('#:cargo-inputs (("rust-bar" ('unquote rust-bar))
+                             ("rust-baz" ('unquote rust-baz))))))
          ('home-page "http://example.com")
          ('synopsis "summary")
          ('description "summary")
@@ -111,4 +178,100 @@
       (x
        (pk 'fail x #f)))))
 
+(test-assert "cargo-recursive-import"
+  ;; Replace network resources with sample data.
+  (mock ((guix http-client) http-fetch
+         (lambda (url . rest)
+           (match url
+             ("https://crates.io/api/v1/crates/foo"
+              (open-input-string test-foo-crate))
+             ("https://crates.io/api/v1/crates/foo/1.0.0/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/foo/1.0.0/dependencies"
+              (open-input-string test-foo-dependencies))
+             ("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
+                     (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/baz"
+              (open-input-string test-baz-crate))
+             ("https://crates.io/api/v1/crates/baz/1.0.0/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/baz/1.0.0/dependencies"
+              (open-input-string test-baz-dependencies))
+             (_ (error "Unexpected URL: " url)))))
+        (match (stream->list (crate-recursive-import "foo"))
+          ((('package
+              ('name "rust-foo")
+              ('version (? string? ver))
+              ('source
+               ('origin
+                 ('method 'url-fetch)
+                 ('uri ('crate-uri "foo" 'version))
+                 ('file-name
+                  ('string-append 'name "-" 'version ".tar.gz"))
+                 ('sha256
+                  ('base32
+                   (? string? hash)))))
+              ('build-system 'cargo-build-system)
+              ('arguments
+               ('quasiquote
+                ('#:cargo-inputs (("rust-bar" ('unquote rust-bar))
+                                  ("rust-baz" ('unquote rust-baz))))))
+              ('home-page "http://example.com")
+              ('synopsis "summary")
+              ('description "summary")
+              ('license ('list 'license:expat 'license:asl2.0)))
+            ('package
+              ('name "rust-bar")
+              ('version (? string? ver))
+              ('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-baz" ('unquote rust-baz))))))
+              ('home-page "http://example.com")
+              ('synopsis "summary")
+              ('description "summary")
+              ('license ('list 'license:expat 'license:asl2.0)))
+            ('package
+              ('name "rust-baz")
+              ('version (? string? ver))
+              ('source
+               ('origin
+                 ('method 'url-fetch)
+                 ('uri ('crate-uri "baz" '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))))
+           #t)
+          (x
+           (pk 'fail x #f)))))
+
 (test-end "crate")
-- 
2.23.0