[bug#38408] [PATCH v4 6/6] guix: import: recursive-import-semver: allow the range of a package to be specified when begining import.

[Martin Becze <mjbecze@riseup.net>]

* guix/import/crate.scm (crate-recursive-import) changed param version to range
* guix/import/util.scm (recursive-import-semver) changed param version to range
* guix/tests/import-utils.scm added  range test for (recursive-import-semver)
---
 guix/import/crate.scm  |  5 +--
 guix/import/utils.scm  | 69 ++++++++++++++++++++++++------------------
 tests/import-utils.scm | 15 ++++++++-
 3 files changed, 57 insertions(+), 32 deletions(-)

diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 535ac2d8e5..cd9ab61cca 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -247,10 +247,11 @@ latest version of CRATE-NAME."
                         (crate-version-dependencies version*)))
   (make-crate-sexp crate version* dependencies))
 
-(define* (crate-recursive-import name #:optional version)
+
+(define* (crate-recursive-import name #:optional range)
   (recursive-import-semver
    #:name name
-   #:version version
+   #:range (if range range "*")
    #:name->metadata lookup-crate
    #:metadata->package crate->crate-version
    #:metadata-versions crate->versions
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 6932614f8e..35d5c79286 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -422,8 +422,9 @@ dependencies."
     ;; initial state
     (step initial-state)))
 
-(define* (recursive-import-semver #:key name
-                                  (version #f)
+(define* (recursive-import-semver #:key
+                                  name
+                                  (range "*")
                                   name->metadata
                                   metadata->package
                                   metadata-versions
@@ -433,7 +434,7 @@ dependencies."
                                   guix-name
                                   make-sexp)
   "Generates a stream of package expressions for the dependencies of the given 
-NAME and VERSION. The dependencies will be resolved using semantic versioning.
+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
@@ -442,7 +443,7 @@ other data.
 
 This procedure takes the following keys:
   NAME - The name of the package to import
-  VERSION - The version 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 
@@ -473,6 +474,8 @@ s-expression"
     (semver-range-contains? range
                             (string->semver version)))
 
+  ;; given a name of a package and a version number this returns the export
+  ;; symbol that will be used
   (define (guix-export-name name version)
     (let ((versions (name->versions name))
           (name (guix-name name)))
@@ -518,14 +521,17 @@ s-expression"
            (export-name (guix-export-name name version)))
       `(,export-name ,version #t)))
 
+  (define (find-dep-version-by-name-range name range-string known-deps)
+    (let ((range (string->semver-range range-string)))
+      (or (find-known name range known-deps)
+          (find-locally name range)
+          (find-remote name range))))
 
   (define (find-dep-version dep known-deps)
     (let* ((name (dependency-name dep))
-           (range (string->semver-range (dependency-range dep)))
+           (range (dependency-range dep))
            (export-name-version-needed
-            (or (find-known name range known-deps)
-                (find-locally name range)
-                (find-remote name range))))
+            (find-dep-version-by-name-range name range known-deps)))
       `(,name ,@export-name-version-needed ,dep)
       ))
 
@@ -536,12 +542,12 @@ s-expression"
            (deps (map (lambda (dep)
                         (find-dep-version dep known-deps))
                       (package-dependencies package)))
+           (deps-with-export-symbol (map
+                                     (match-lambda ((_ export-symbol _ _ dep)
+                                                    (list export-symbol dep)))
+                                     deps))
            (sexp
-            (make-sexp metadata package
-                       (map
-                        (match-lambda ((_ export-symbol _ _ dep)
-                                       (list export-symbol dep)))
-                        deps))))
+            (make-sexp metadata package deps-with-export-symbol)))
       (values
        (package->definition sexp (latest? versions version))
        (filter-map
@@ -551,15 +557,12 @@ s-expression"
                            #f)))
         deps))))
 
-  (define initial-state
-    (list #f
-          (list
-           ;; packages to find
-           (list name (if version
-                          version
-                          (car (name->versions name)))))
-          ;; packages that have been found
-          (list)))
+  (define (initial-state name version)
+    `(#f
+      ;; packages to find
+      ,(list (list name version))
+      ;; packages that have been found
+      ()))
 
   (define (step state)
     (match state
@@ -573,11 +576,19 @@ s-expression"
           (cons (list next-name next-version) done))))
       ((prev '() done)
        (list #f '() done))))
+
+  (define (create-stream initial-state)
+    (stream-unfold
+     ;; map: produce a stream element
+     (match-lambda ((latest queue done) latest))
+     ;; predicate
+     (match-lambda ((latest queue done) latest))
+     step
+     (step initial-state)))
  
-  (stream-unfold
-   ;; map: produce a stream element
-   (match-lambda ((latest queue done) latest))
-   ;; predicate
-   (match-lambda ((latest queue done) latest))
-   step
-   (step initial-state)))
+  (match (find-dep-version-by-name-range name range '())
+    ((_ version #t)
+     (create-stream (initial-state name version)))
+    ;; if the initial package alread exsits then just return its export symbol
+    ((export-name _ #f)
+     (list->stream (list export-name)))))
diff --git a/tests/import-utils.scm b/tests/import-utils.scm
index 4ed3a5e1da..022b8f2b32 100644
--- a/tests/import-utils.scm
+++ b/tests/import-utils.scm
@@ -190,7 +190,7 @@
 
 (define* (test-recursive-importer name version #:optional (guix-name guix-name))
   (recursive-import-semver #:name name
-                           #:version version
+                           #:range version
                            #:name->metadata name->metadata
                            #:metadata->package metadata->package
                            #:metadata-versions metadata-semver-versions
@@ -250,6 +250,19 @@
         (dependcies ()))))
   (stream->list (test-recursive-importer "one-dep" "0.1.0")))
 
+(test-equal "recursive import test with a version range"
+  `((define-public test-one-dep
+      (package
+        (name "test-one-dep")
+        (version "1.0.0")
+        (dependcies (("test-no-deps" "test-no-deps")))))
+    (define-public test-no-deps
+      (package
+        (name "test-no-deps")
+        (version "1.0.0")
+        (dependcies ()))))
+  (stream->list (test-recursive-importer "one-dep" "*")))
+
 (test-equal "recursive import test with with dependency that is already in the repo"
   `((define-public test-already-packaged
       (package (name "test-already-packaged")
-- 
2.24.0