[bug#38408] [PATCH v4 1/6] gnu: added new function, find-packages-by-name*/direct

[Martin Becze <mjbecze@riseup.net>]

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


> 
> Providing an explicit cache bypassing method also sounds worrying to me:
> the cache is supposed to be transparent and semantics-preserving.
> 
> More generally, I think adding new features to an importer shouldn’t
> require modifications in this area, as a matter of separating concerns.
> 
> WDYT?
> 
> Thanks,
> Ludo’.

yes I agree, I removed that in the last version! Which also rebases off
the new topological sort procedure. I'll attach the latest patches here,
in case you missed it.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: v5-0001-guix-import-added-recusive-import-semver.patch --]
[-- Type: text/x-diff; name=v5-0001-guix-import-added-recusive-import-semver.patch, Size: 9441 bytes --]

From eeffdf569c4d7fbfd843e0b48404b6a2f3d46343 Mon Sep 17 00:00:00 2001
From: Martin Becze <mjbecze@riseup.net>
Date: Mon, 16 Dec 2019 17:08:16 -0500
Subject: [PATCH v5 1/4] guix: import: added recusive-import-semver

* guix/import/utils.scm (recusive-import-semver): New Varible
* guix/import/utils.scm (package->definition)[arguments]: Add append-verions option
---
 guix/import/utils.scm | 168 ++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 161 insertions(+), 7 deletions(-)

diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index d17d400ddf..7f75f50e23 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2017, 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net>
+;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -40,10 +41,13 @@
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 receive)
   #:use-module (ice-9 regex)
+  #:use-module (semver)
+  #:use-module (semver ranges)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-71)
   #:export (factorize-uri
 
             flatten
@@ -70,7 +74,8 @@
 
             guix-name
 
-            recursive-import))
+            recursive-import
+            recursive-import-semver))
 
 (define (factorize-uri uri version)
   "Factorize URI, a package tarball URI as a string, such that any occurrences
@@ -258,13 +263,13 @@ package definition."
     ((package-inputs ...)
      `((native-inputs (,'quasiquote ,package-inputs))))))
 
-(define (package->definition guix-package)
+(define* (package->definition guix-package #:optional append-version?)
   (match guix-package
-    (('package ('name (? string? name)) _ ...)
-     `(define-public ,(string->symbol name)
-        ,guix-package))
-    (('let anything ('package ('name (? string? name)) _ ...))
-     `(define-public ,(string->symbol name)
+    ((or ('package ('name name) ('version version) . rest)
+         ('let _ ('package ('name name) ('version version) . rest)))
+     `(define-public ,(string->symbol (if append-version?
+                                          (string-append name "-" version)
+                                          version))
         ,guix-package))))
 
 (define (build-system-modules)
@@ -428,3 +433,152 @@ name corresponding to the upstream name."
                                 (remove exists?
                                         (node-dependencies node))))
                          node-name)))
+
+(define* (recursive-import-semver #:key
+                                  name
+                                  (range "*")
+                                  name->metadata
+                                  metadata->package
+                                  metadata-versions
+                                  package-dependencies
+                                  dependency-name
+                                  dependency-range
+                                  guix-name
+                                  make-sexp)
+  "Generates a list of package expressions for the dependencies of the given 
+NAME and version RANGE. The dependencies will be resolved using semantic versioning.
+This procedure makes the assumption that most package repositories will, for a
+given package provide some <metadata> on that package that includes what
+versions of the package that are available and a list of dependencies for each
+version. Dependencies are assumed to be composed of a NAME, a semantic RANGE and
+other data.
+
+This procedure takes the following keys:
+  NAME - The name of the package to import
+  RANGE - The version range of the package to import
+  NAME->METADATA - A procedure that takes a NAME of a package and returns that
+package's <metadata>
+  METADATA->PACKAGE A procedure that takes a package's <metadata> and VERSION 
+and returns the <package> for the given VERSION
+  METADATA-VERSIONS A procedure that that takes a packages <metadata> and
+returns a list of version as strings that are available for the given package
+  PACKAGE-DEPENDENCIES a procedure that returns a list of <dependency> given a 
+<package>
+  DEPENDENCY-NAME A procedure that takes a <dependency> and returns the its name
+  DEPENDENCY-RANGE A procedure that takes a <dependency> and returns that
+decency's range as a string
+  GUIX-NAME A procedure that take a NAME and returns the Guix version of it
+  MAKE-SEXP A procedure that takes <metadata>, <package> and a list of pairs
+containing (EXPORT-NAME <dependency>), returning the package expression as an 
+s-expression"
+  (define-record-type <node-dependency>
+    (make-node-dependency dependency version exists?)
+    node-dependency?
+    (dependency  node-dependency-dependency)
+    (version     node-dependency-version)
+    (exists?     node-dependency-exists?))
+
+  (define-record-type <node>
+    (make-node name version metadata package dependencies)
+    node?
+    (name         node-name)
+    (version      node-version)
+    (metadata     node-metadata)
+    (package      node-package)
+    (dependencies node-dependencies))
+
+  (define mem-name->metadata (memoize name->metadata))
+  (define mem-package-dependencies (memoize package-dependencies))
+
+  (define (semver-range-contains-string? range version)
+    (semver-range-contains? range (string->semver version)))
+
+  (define (name+version name version)
+    (string-append name "-" version))
+
+  (define (public-name name version)
+    "Given a NAME and a VERSION of a package, returns the name of the
+symbol used is define-public"
+    (guix-name (name+version name version)))
+
+  ;; searches searches for a package in guix
+  (define (find-locally name range)
+    (match (find
+            (lambda (package)
+              (semver-range-contains-string?
+               range
+               (package-version package)))
+            (find-packages-by-name (guix-name name)))
+      (#f #f)
+      (package (list (package-version package) #t))))
+
+  ;; searches for a package in some external repo
+  (define (find-remote name range)
+    (let* ((versions (sort
+                      (metadata-versions
+                       (mem-name->metadata name))
+                      version>?))
+           (version (find
+                     (lambda (ver)
+                       (semver-range-contains-string? range ver))
+                     versions)))
+      (list version #f)))
+
+  (define (find-by-name-range name range)
+    "Given a NAME, RANGE this will return a VERSION and BOOL which repesents
+whether the package has been encountered or not."
+    (let ((semver-range (string->semver-range range)))
+      (apply values
+             (or (find-locally name semver-range)
+                 (find-remote name semver-range)))))
+
+  (define (make-package-definition node)
+    (let* ((metadata (node-metadata node))
+           (package (node-package node))
+           (dependencies ;; a list of (public-name dependency)
+            (map (lambda (node-dep)
+                   (let* ((dep (node-dependency-dependency node-dep))
+                          (ver (node-dependency-version node-dep))
+                          (name (dependency-name dep)))
+                     (list (public-name name ver) dep)))
+                 (node-dependencies node)))
+           (sexp (make-sexp metadata package dependencies)))
+      (package->definition sexp #t)))
+
+  (define (dependency->node-dependency dep)
+    (let* ((name (dependency-name dep))
+           (range (dependency-range dep))
+           (version exists? (find-by-name-range name range)))
+      (make-node-dependency dep version exists?)))
+
+  (define (name-version->node name version)
+    (let* ((metadata (mem-name->metadata name))
+           (package (metadata->package metadata version))
+           (dependencies (mem-package-dependencies package))
+           (node-dependencies (map (lambda (dep)
+                                     (dependency->node-dependency dep))
+                                   dependencies)))
+      (make-node name version metadata package node-dependencies)))
+
+  (define (node-dependency->node node-dependency)
+    (let* ((dependency (node-dependency-dependency node-dependency))
+           (name (dependency-name dependency))
+           (version (node-dependency-version node-dependency)))
+      (name-version->node name version)))
+
+  (let ((version exists? (find-by-name-range name range)))
+    (if exists?
+        (display
+         (string-append "package " (name+version name version) " alread exists - ")
+         (current-error-port))
+        (map make-package-definition
+             (topological-sort (list (name-version->node name version))
+                               (lambda (node)
+                                 (map (lambda (dep)
+                                        (node-dependency->node dep))
+                                      (remove node-dependency-exists?
+                                              (node-dependencies node))))
+                               (lambda (node)
+                                 (name+version
+                                  (node-name node)
+                                  (node-version node))))))))
-- 
2.24.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: v5-0002-guix-import-crate-crate-recusive-import-use-recus.patch --]
[-- Type: text/x-diff; name=v5-0002-guix-import-crate-crate-recusive-import-use-recus.patch, Size: 23572 bytes --]

From d3130d97a02f29bfe388650fe40131aa5c762f04 Mon Sep 17 00:00:00 2001
From: Martin Becze <mjbecze@riseup.net>
Date: Mon, 16 Dec 2019 17:33:50 -0500
Subject: [PATCH v5 2/4] guix: import: crate: crate-recusive-import, use
 recusive-import-semver

* guix/import/crate.scm (crate-recusive-import): use recusive-import-semver
* guix/import/crate.scm (make-crate-sexp)[argumnets]: use <crate> and <version>
* guix/import/crate.scm (crate-version-dependencies): dedup dependencies
* guix/test/crate.scm: updated test
---
 guix/import/crate.scm | 175 +++++++++++++++++--------------
 tests/crate.scm       | 232 ++++++++++++++++++++++++------------------
 2 files changed, 229 insertions(+), 178 deletions(-)

diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 4c3f8000d0..3e5b022873 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -38,6 +38,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-71)
   #:export (crate->guix-package
             guix-package->crate-name
             crate-recursive-import
@@ -85,7 +86,7 @@
   crate-dependency?
   json->crate-dependency
   (id            crate-dependency-id "crate_id")  ;string
-  (kind          crate-dependency-kind "kind"     ;'normal | 'dev
+  (kind          crate-dependency-kind "kind"     ;'normal | 'dev | 'build
                  string->symbol)
   (requirement   crate-dependency-requirement "req")) ;string
 
@@ -108,13 +109,22 @@ record or #f if it was not found."
   "Return the list of <crate-dependency> records of VERSION, a
 <crate-version>."
   (let* ((path (assoc-ref (crate-version-links version) "dependencies"))
-         (url  (string-append (%crate-base-url) path)))
-    (match (assoc-ref (or (json-fetch url) '()) "dependencies")
-      ((? vector? vector)
-       (map json->crate-dependency (vector->list vector)))
-      (_
-       '()))))
-
+         (url  (string-append (%crate-base-url) path))
+         (deps-list (match (assoc-ref (or (json-fetch url) '()) "dependencies")
+                      ((? vector? vector) (vector->list vector))
+                      (_
+                       '())))
+         ;; turn the raw list into <dependency>'s and remove dev depenedencies
+         (deps (filter-map (lambda (json)
+                             (let ((dep (json->crate-dependency json)))
+                               (if (eq? (crate-dependency-kind dep) 'dev)
+                                   #f
+                                   dep)))
+                           deps-list)))
+    ;;remove duplicate dependencies
+    (apply lset-adjoin `(,(lambda (a b)
+                            (string-ci=? (crate-dependency-id a) (crate-dependency-id b)))
+                         () ,@deps))))
 \f
 ;;;
 ;;; Converting crates to Guix packages.
@@ -141,42 +151,55 @@ record or #f if it was not found."
     ((args ...)
      `((arguments (,'quasiquote ,args))))))
 
-(define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inputs
-                          home-page synopsis description license
-                          #:allow-other-keys)
-  "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."
-  (let* ((port (http-fetch (crate-uri name version)))
+(define (make-crate-sexp crate version* dependencies)
+  "Return the `package' s-expression for a rust package given <crate>,
+ <crate-version> and a list of <crate-dependency>"
+  (define normal-dependency?
+    (match-lambda ((_ dep) (not (eq? (crate-dependency-kind dep) 'dev)))))
+
+  (let* ((dep-crates dev-dep-crates (partition normal-dependency? dependencies))
+         (cargo-inputs (sort (unzip1 dep-crates)
+                             string-ci<?))
+         (cargo-development-inputs
+          (sort (unzip1 dev-dep-crates)
+                string-ci<?))
+         (name (crate-name crate))
+         (version (crate-version-number version*))
+         (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))
+         (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
-                                        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 ".crate"))
+                           (sha256
+                            (base32
+                             ,(bytevector->nix-base32-string (port-sha256 port))))))
+                 (build-system cargo-build-system)
+                 ,@(maybe-arguments (append `(#:skip-build? #t)
+                                            (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))
 
 (define (string->license string)
   (filter-map (lambda (license)
@@ -187,15 +210,24 @@ and LICENSE."
                          'unknown-license!)))
               (string-split string (string->char-set " /"))))
 
+(define (crate->crate-version crate version-number)
+  "returns the <crate-version> for a given CRATE and VERSION-NUMBER"
+  (find (lambda (version)
+            (string=? (crate-version-number version)
+                      version-number))
+          (crate-versions crate)))
+
+(define (crate->versions crate)
+  "Returns a list of versions for a given CRATE"
+  (map (lambda (version)
+         (crate-version-number version))
+       (crate-versions crate)))
+
 (define* (crate->guix-package crate-name #:optional version)
   "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, attempt to fetch that version; otherwise fetch the
 latest version of CRATE-NAME."
-
-  (define (normal-dependency? dependency)
-    (eq? (crate-dependency-kind dependency) 'normal))
-
   (define crate
     (lookup-crate crate-name))
 
@@ -204,38 +236,28 @@ latest version of CRATE-NAME."
         (crate-latest-version crate)))
 
   (define version*
-    (find (lambda (version)
-            (string=? (crate-version-number version)
-                      version-number))
-          (crate-versions crate)))
+    (crate->crate-version crate version-number))
+
+  (define dependencies (map
+                        (lambda (dep)
+                          (list (crate-name->package-name
+                           (crate-dependency-id dep)) dep))
+                        (crate-version-dependencies version*)))
+  (make-crate-sexp crate version* dependencies))
 
-  (and crate version*
-       (let* ((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<?)))
-         (values
-          (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))
-          (append cargo-inputs cargo-development-inputs)))))
 
-(define (crate-recursive-import crate-name)
-  (recursive-import crate-name #f
-                    #:repo->guix-package (lambda (name repo)
-                                           (crate->guix-package name))
-                    #:guix-name crate-name->package-name))
+(define* (crate-recursive-import name #:optional range)
+  (recursive-import-semver
+   #:name name
+   #:range (if range range "*")
+   #:name->metadata lookup-crate
+   #:metadata->package crate->crate-version
+   #:metadata-versions crate->versions
+   #:package-dependencies crate-version-dependencies
+   #:dependency-name crate-dependency-id
+   #:dependency-range crate-dependency-requirement
+   #:guix-name crate-name->package-name
+   #:make-sexp make-crate-sexp))
 
 (define (guix-package->crate-name package)
   "Return the crate name of PACKAGE."
@@ -284,4 +306,3 @@ latest version of CRATE-NAME."
    (description "Updater for crates.io packages")
    (pred crate-package?)
    (latest latest-release)))
-
diff --git a/tests/crate.scm b/tests/crate.scm
index 61933a8de8..42c94b9996 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2014 David Thompson <davet@gnu.org>
 ;;; Copyright © 2016 David Craven <david@craven.ch>
 ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -56,6 +57,7 @@
      {
        \"crate_id\": \"bar\",
        \"kind\": \"normal\",
+       \"req\": \"1\"
      }
   ]
 }")
@@ -88,18 +90,22 @@
      {
        \"crate_id\": \"intermediate-1\",
        \"kind\": \"normal\",
+       \"req\": \"1\"
      },
      {
        \"crate_id\": \"intermediate-2\",
        \"kind\": \"normal\",
+       \"req\": \"1\"
      }
      {
        \"crate_id\": \"leaf-alice\",
        \"kind\": \"normal\",
+       \"req\": \"1\"
      },
      {
        \"crate_id\": \"leaf-bob\",
        \"kind\": \"normal\",
+       \"req\": \"1\"
      },
   ]
 }")
@@ -132,14 +138,17 @@
      {
        \"crate_id\": \"intermediate-2\",
        \"kind\": \"normal\",
+       \"req\": \"1\"
      },
      {
        \"crate_id\": \"leaf-alice\",
        \"kind\": \"normal\",
+       \"req\": \"1\"
      },
      {
        \"crate_id\": \"leaf-bob\",
        \"kind\": \"normal\",
+       \"req\": \"1\"
      }
   ]
 }")
@@ -172,6 +181,7 @@
      {
        \"crate_id\": \"leaf-bob\",
        \"kind\": \"normal\",
+       \"req\": \"1\"
      },
   ]
 }")
@@ -268,14 +278,15 @@
          ('source ('origin
                     ('method 'url-fetch)
                     ('uri ('crate-uri "foo" 'version))
-                    ('file-name ('string-append 'name "-" 'version ".tar.gz"))
+                    ('file-name ('string-append 'name "-" 'version ".crate"))
                     ('sha256
                      ('base32
                       (? string? hash)))))
          ('build-system 'cargo-build-system)
          ('arguments
           ('quasiquote
-           ('#:cargo-inputs (("rust-bar" ('unquote rust-bar))))))
+           ('#:skip-build? #t
+            #:cargo-inputs (("rust-bar" ('unquote rust-bar))))))
          ('home-page "http://example.com")
          ('synopsis "summary")
          ('description "summary")
@@ -335,107 +346,126 @@
              ("https://crates.io/api/v1/crates/leaf-bob/1.0.0/dependencies"
               (open-input-string test-leaf-bob-dependencies))
              (_ (error "Unexpected URL: " url)))))
+
         (match (crate-recursive-import "root")
           ;; rust-intermediate-2 has no dependency on the rust-leaf-alice package, so this is a valid ordering
-          ((('package
-              ('name "rust-leaf-alice")
-              ('version (? string? ver))
-              ('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)))
-            ('package
-              ('name "rust-leaf-bob")
-              ('version (? string? ver))
-              ('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)))
-            ('package
-              ('name "rust-intermediate-2")
-              ('version (? string? ver))
-              ('source
-               ('origin
-                 ('method 'url-fetch)
-                 ('uri ('crate-uri "intermediate-2" '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))))))
-              ('home-page "http://example.com")
-              ('synopsis "summary")
-              ('description "summary")
-              ('license ('list 'license:expat 'license:asl2.0)))
-            ('package
-              ('name "rust-intermediate-1")
-              ('version (? string? ver))
-              ('source
-               ('origin
-                 ('method 'url-fetch)
-                 ('uri ('crate-uri "intermediate-1" 'version))
-                 ('file-name
-                  ('string-append 'name "-" 'version ".tar.gz"))
-                 ('sha256
-                  ('base32
-                   (? string? hash)))))
-              ('build-system 'cargo-build-system)
-              ('arguments
-               ('quasiquote
-                ('#:cargo-inputs (("rust-intermediate-2" ('unquote rust-intermediate-2))
-                                  ("rust-leaf-alice" ('unquote rust-leaf-alice))
-                                  ("rust-leaf-bob" ('unquote rust-leaf-bob))))))
-              ('home-page "http://example.com")
-              ('synopsis "summary")
-              ('description "summary")
-              ('license ('list 'license:expat 'license:asl2.0)))
-            ('package
-              ('name "rust-root")
-              ('version (? string? ver))
-              ('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-1" ('unquote rust-intermediate-1))
-                                  ("rust-intermediate-2" ('unquote rust-intermediate-2))
-                                  ("rust-leaf-alice" ('unquote rust-leaf-alice))
-                                  ("rust-leaf-bob" ('unquote rust-leaf-bob))))))
-              ('home-page "http://example.com")
-              ('synopsis "summary")
-              ('description "summary")
-              ('license ('list 'license:expat 'license:asl2.0))))
+          ((('define-public 'rust-intermediate-1-1.0.0
+              ('package
+                ('name "rust-intermediate-1")
+                ('version (? string? ver))
+                ('source
+                 ('origin
+                   ('method 'url-fetch)
+                   ('uri ('crate-uri "intermediate-1" 'version))
+                   ('file-name
+                    ('string-append 'name "-" 'version ".crate"))
+                   ('sha256
+                    ('base32
+                     (? string? hash)))))
+                ('build-system 'cargo-build-system)
+                ('arguments
+                 ('quasiquote
+                  ('#:skip-build? #t
+                   '#:cargo-inputs (("rust-intermediate-2-1.0.0" ('unquote rust-intermediate-2-1.0.0))
+                                    ("rust-leaf-alice-1.0.0" ('unquote rust-leaf-alice-1.0.0))
+                                    ("rust-leaf-bob-1.0.0" ('unquote rust-leaf-bob-1.0.0))))))
+                ('home-page "http://example.com")
+                ('synopsis "summary")
+                ('description "summary")
+                ('license ('list 'license:expat 'license:asl2.0))))
+            ('define-public 'rust-intermediate-2-1.0.0
+              ('package
+                ('name "rust-intermediate-2")
+                ('version (? string? ver))
+                ('source
+                 ('origin
+                   ('method 'url-fetch)
+                   ('uri ('crate-uri "intermediate-2" 'version))
+                   ('file-name
+                    ('string-append 'name "-" 'version ".crate"))
+                   ('sha256
+                    ('base32
+                     (? string? hash)))))
+                ('build-system 'cargo-build-system)
+                ('arguments
+                 ('quasiquote
+                  ('#:skip-build? #t
+                   '#:cargo-inputs (("rust-leaf-bob-1.0.0" ('unquote rust-leaf-bob-1.0.0))))))
+                ('home-page "http://example.com")
+                ('synopsis "summary")
+                ('description "summary")
+                ('license ('list 'license:expat 'license:asl2.0))))
+            ('define-public 'rust-leaf-alice-1.0.0
+              ('package
+                ('name "rust-leaf-alice")
+                ('version (? string? ver))
+                ('source
+                 ('origin
+                   ('method 'url-fetch)
+                   ('uri ('crate-uri "leaf-alice" 'version))
+                   ('file-name
+                    ('string-append 'name "-" 'version ".crate"))
+                   ('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-bob-1.0.0
+              ('package
+                ('name "rust-leaf-bob")
+                ('version (? string? ver))
+                ('source
+                 ('origin
+                   ('method 'url-fetch)
+                   ('uri ('crate-uri "leaf-bob" 'version))
+                   ('file-name
+                    ('string-append 'name "-" 'version ".crate"))
+                   ('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-root-1.0.0
+              ('package
+                ('name "rust-root")
+                ('version (? string? ver))
+                ('source
+                 ('origin
+                   ('method 'url-fetch)
+                   ('uri ('crate-uri "root" 'version))
+                   ('file-name
+                    ('string-append 'name "-" 'version ".crate"))
+                   ('sha256
+                    ('base32
+                     (? string? hash)))))
+                ('build-system 'cargo-build-system)
+                ('arguments
+                 ('quasiquote
+                  ('#:skip-build? #t
+                   '#:cargo-inputs (("rust-intermediate-1-1.0.0"
+                                     ('unquote rust-intermediate-1-1.0.0))
+                                    ("rust-intermediate-2-1.0.0"
+                                     ('unquote rust-intermediate-2-1.0.0))
+                                    ("rust-leaf-alice-1.0.0"
+                                     ('unquote rust-leaf-alice-1.0.0))
+                                    ("rust-leaf-bob-1.0.0"
+                                     ('unquote rust-leaf-bob-1.0.0))))))
+                ('home-page "http://example.com")
+                ('synopsis "summary")
+                ('description "summary")
+                ('license ('list 'license:expat 'license:asl2.0)))))
            #t)
           (x
            (pk 'fail x #f)))))
-- 
2.24.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: v5-0003-guix-tests-added-tests-for-recursive-import-semve.patch --]
[-- Type: text/x-diff; name=v5-0003-guix-tests-added-tests-for-recursive-import-semve.patch, Size: 7378 bytes --]

From 5495834ca375186912eeed40c7c8ce96254c36b3 Mon Sep 17 00:00:00 2001
From: Martin Becze <mjbecze@riseup.net>
Date: Mon, 16 Dec 2019 17:46:47 -0500
Subject: [PATCH v5 3/4] guix: tests: added tests for recursive-import-semver

* guix/tests/import-utils.scm: tests for recursive-import-semver
---
 tests/import-utils.scm | 177 ++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 175 insertions(+), 2 deletions(-)

diff --git a/tests/import-utils.scm b/tests/import-utils.scm
index 87dda3238f..2ee81386ec 100644
--- a/tests/import-utils.scm
+++ b/tests/import-utils.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
+;;; Copyright © 2016 Martin Becze <mjbecze@riseup.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,8 +25,10 @@
   #:use-module (guix packages)
   #:use-module (guix build-system)
   #:use-module (gnu packages)
-  #:use-module (srfi srfi-64)
-  #:use-module (ice-9 match))
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-64))
 
 (test-begin "import-utils")
 
@@ -141,4 +144,174 @@
                  ("license" . #f))))
     (package-native-inputs (alist->package meta))))
 
+(define-record-type <metadata>
+  (make-metadata name versions)
+  metadata?
+  (name metadata-name)
+  (versions  metadata-versions))
+
+(define-record-type <package>
+  (make-package version dependencies)
+  package?
+  (version package-version)
+  (dependencies package-dependencies))
+
+(define-record-type <dependency>
+  (make-dependency name range)
+  dependency?
+  (name dependency-name)
+  (range dependency-range))
+
+(define (metadata-semver-versions metadata)
+  (map (lambda (p)
+         (package-version p))
+       (metadata-versions metadata)))
+
+(define (metadata->package metadata version)
+  (find
+   (lambda (package)
+     (equal? (package-version package) version))
+   (metadata-versions metadata)))
+
+(define (make-sexp metadata package dependencies)
+  `(package
+    (name ,(guix-name (metadata-name metadata)))
+    (version ,(package-version package))
+    (dependcies ,(map
+                  (match-lambda ((public-name dep)
+                                 (list (guix-name (dependency-name dep)) public-name)))
+                  dependencies))))
+
+(define (guix-name name)
+  (string-append "test-" name))
+
+(define packages
+  `(("no-deps" . (("1.0.0" . ()) ("0.1.0" . ())))
+    ("one-dep" . (("1.0.0" . (("no-deps" "^1.0")))
+                  ("0.1.0" . (("no-deps" "^0.1.0")))))
+    ("shared-dep" . (("1.0.0" . (("one-dep" "^0.1.0")
+                                 ("no-deps" "*")))))
+    ("recursive" . (("1.0.0" . (("recursive" "=1.0.0")))))
+    ("already-packaged" . (("1.0.0" . (("rust" "~1.28")))))))
+
+(define (name->metadata name)
+  (let ((versions (assoc-ref packages name)))
+    (make-metadata name
+                   (map
+                    (match-lambda
+                      ((version . deps)
+                       (make-package version
+                                     (map
+                                      (lambda (name-range)
+                                        (apply make-dependency name-range))
+                                      deps))))
+                    versions))))
+
+(define* (test-recursive-importer name version #:optional (guix-name guix-name))
+  (recursive-import-semver #:name name
+                           #:range version
+                           #:name->metadata name->metadata
+                           #:metadata->package metadata->package
+                           #:metadata-versions metadata-semver-versions
+                           #:package-dependencies package-dependencies
+                           #:dependency-name dependency-name
+                           #:dependency-range dependency-range
+                           #:guix-name guix-name
+                           #:make-sexp make-sexp))
+
+(test-equal "recursive import test with no dependencies"
+  `((define-public test-no-deps-1.0.0
+      (package
+        (name "test-no-deps")
+        (version "1.0.0")
+        (dependcies ()))))
+  (test-recursive-importer "no-deps" "1.0.0"))
+
+(test-equal "recursive import test with one dependencies"
+  `((define-public test-no-deps-1.0.0
+      (package
+        (name "test-no-deps")
+        (version "1.0.0")
+        (dependcies ())))
+    (define-public test-one-dep-1.0.0
+      (package
+        (name "test-one-dep")
+        (version "1.0.0")
+        (dependcies (("test-no-deps" "test-no-deps-1.0.0"))))))
+  (test-recursive-importer "one-dep" "1.0.0"))
+
+(test-equal "recursive import test with recursuve dependencies"
+  `((define-public test-recursive-1.0.0
+      (package
+        (name "test-recursive")
+        (version "1.0.0")
+        (dependcies (("test-recursive" "test-recursive-1.0.0"))))))
+  (test-recursive-importer "recursive" "1.0.0"))
+
+(test-equal "recursive import test with no dependencies using an old version"
+  `((define-public test-no-deps-0.1.0
+      (package
+        (name "test-no-deps")
+        (version "0.1.0")
+        (dependcies ()))))
+  (test-recursive-importer "no-deps" "0.1.0"))
+
+(test-equal "recursive import test with one dependencies unsing an old version"
+  `((define-public test-no-deps-0.1.0
+      (package
+        (name "test-no-deps")
+        (version "0.1.0")
+        (dependcies ())))
+    (define-public test-one-dep-0.1.0
+      (package
+        (name "test-one-dep")
+        (version "0.1.0")
+        (dependcies (("test-no-deps" "test-no-deps-0.1.0"))))))
+  (test-recursive-importer "one-dep" "0.1.0"))
+
+(test-equal "recursive import test with a version range"
+  `((define-public test-no-deps-1.0.0
+      (package
+        (name "test-no-deps")
+        (version "1.0.0")
+        (dependcies ())))
+    (define-public test-one-dep-1.0.0
+      (package
+        (name "test-one-dep")
+        (version "1.0.0")
+        (dependcies (("test-no-deps" "test-no-deps-1.0.0"))))))
+  (test-recursive-importer "one-dep" "*"))
+
+(test-equal "recursive import test with with dependency that is already in the repo"
+  `((define-public test-already-packaged-1.0.0
+      (package (name "test-already-packaged")
+               (version "1.0.0")
+               (dependcies
+                (("test-rust" "rust-1.28.0"))))))
+  (test-recursive-importer "already-packaged" "1.0.0" identity))
+
+(test-equal "shared dependencies"
+  `((define-public test-no-deps-1.0.0
+      (package
+        (name "test-no-deps")
+        (version "1.0.0")
+        (dependcies ())))
+    (define-public test-no-deps-0.1.0
+      (package
+        (name "test-no-deps")
+        (version "0.1.0")
+        (dependcies ())))
+    (define-public test-one-dep-0.1.0
+      (package
+        (name "test-one-dep")
+        (version "0.1.0")
+        (dependcies (("test-no-deps" "test-no-deps-0.1.0")))))
+    (define-public test-shared-dep-1.0.0
+      (package
+        (name "test-shared-dep")
+        (version "1.0.0")
+        (dependcies (("test-one-dep" "test-one-dep-0.1.0")
+                     ("test-no-deps" "test-no-deps-1.0.0"))))))
+  (test-recursive-importer "shared-dep" "1.0.0"))
+
 (test-end "import-utils")
-- 
2.24.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: v5-0004-gnu-scripts-import-crate-Remove-define-public-gen.patch --]
[-- Type: text/x-diff; name=v5-0004-gnu-scripts-import-crate-Remove-define-public-gen.patch, Size: 1273 bytes --]

From aa6aaeacb5f91508f4158999ba6e7f95e8309bed Mon Sep 17 00:00:00 2001
From: Martin Becze <mjbecze@riseup.net>
Date: Mon, 16 Dec 2019 18:11:38 -0500
Subject: [PATCH v5 4/4] gnu: scripts: import: crate: Remove `define-public`
 generation from UI

* guix/scripts/import/crate.scm (guix-import-crate): Remove `define-public` generation from UI
---
 guix/scripts/import/crate.scm | 7 +------
 1 file changed, 1 insertion(+), 6 deletions(-)

diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm
index 92034dab3c..9a08c9b8b4 100644
--- a/guix/scripts/import/crate.scm
+++ b/guix/scripts/import/crate.scm
@@ -95,12 +95,7 @@ Import and convert the crate.io package for PACKAGE-NAME.\n"))
          (package-name->name+version spec))
 
        (if (assoc-ref opts 'recursive)
-           (map (match-lambda
-                  ((and ('package ('name name) . rest) pkg)
-                   `(define-public ,(string->symbol name)
-                      ,pkg))
-                  (_ #f))
-                (crate-recursive-import name))
+           (crate-recursive-import name version)
            (let ((sexp (crate->guix-package name version)))
              (unless sexp
                (leave (G_ "failed to download meta-data for package '~a'~%")
-- 
2.24.1