[bug#35813] Add crate-recursive-import.
diff mbox series

Message ID CAAc=MEyUOF8_fqbDu8b+q30uhxUhHKyf5MvW2eNNPwcL8_+FtA@mail.gmail.com
State New
Headers show
Series
  • [bug#35813] Add crate-recursive-import.
Related show

Commit Message

Brian Leung Sept. 7, 2019, 9:49 p.m. UTC
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 <efraim@flashner.co.il>
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 <bkleung89@gmail.com> wrote:
> >
> > > OK, I updated to remove print statements I missed.
> > >
> > > On Mon, Aug 5, 2019 at 7:50 PM Brian Leung <bkleung89@gmail.com>
> 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   <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
>

Comments

Efraim Flashner Sept. 8, 2019, 7:57 a.m. UTC | #1
As a simple test I ran 'guix import crate encoding -r' and it gave me
the 6 packages I expected. 'guix import crate winapi -r' only gave me
rust-winapi, as the dependent crates are already packaged. When I tried
'guix import crate rand -r' it found the updated version and started
importing all the new dependencies also.

It looks good. I'm tempted to leave it running with 'guix import crate
serde -r' just to see if we're ever going to make it there.

I see that it imports A then B then C then D, and prints out D then C
then B then A. For the one I tested with is still rust-encoding. I'll
try my hand at ascii art:

                            encoding
                                |
  -------------------------------------------------------
  |         |               |           |               |
japanese  korean      simpchinese    singlebyte     tradchinese
  |         |               |           |               |
  -------------------------------------------------------
                        |
                 encoding-tests

import went encoding, japanese, tests, korean, simpchinese, singlebyte,
tradchinese

I think the only thing I would wish for would be to do tests, then the
languages and then encoding (best for upstreaming one at a time), or to
do them alphabetically (plop them in alphabetically all at once). This
I'm happy to live without I think.

The other thing was I ran 'guix import crate security-framework -r' and
after ~40 crates it crashed on me with:
    web/http.scm:1186:15: In procedure read-response-line:
    Bad Read-Header-Line header: #<eof>
and I would prefer to have the ~40 crates it did grab first to be
printed out and not lost. Between these two I would like most to not
lose the imported crates than worrying over the printed order.

Great job! From what I've tested I think it's ready as-is and any
changes would just be gravy.

Patch
diff mbox series

From 751bf2367edf54015792f339dcaca797cd7da937 Mon Sep 17 00:00:00 2001
From: Brian Leung <bkleung89@gmail.com>
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