From 054e308f5d85ca96327861a577d69c6e18fdc9dc Mon Sep 17 00:00:00 2001
From: Hartmut Goebel <h.goebel@crazy-compilers.com>
Date: Sun, 15 Nov 2020 21:25:16 +0100
Subject: import: crate: Use existing package satisfying semver requirement.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

If a package satisfying the dependency's semver requirement already exists,
use it. Prior to this change the highest version matching the semver
requirement was used (and imported in case it was not defined as package
already).

When resolving a dependency (now done in `sort-map-dependencies`), first
search for a package matching the semver requirement and only if this fails
reach out for a crate.

* guix/import/crate.scm (crate->guix-package)[find-package-version]: New
  function. [dependency-name+version]: New function.
  [sort-map-dependencies]: Use it instead of lambda function.

* tests/crate.scm (test-doctool-crate, test-doctool-dependencies): New
  variables.
  ("self-test …", "cargo-recursive-import-hoors-existing-packages"): New
  tests.
---
 guix/import/crate.scm | 37 +++++++++++++++++++++++++++++--------
 1 file changed, 29 insertions(+), 8 deletions(-)

(limited to 'guix/import/crate.scm')

diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index b133529ba7..3bc261b04e 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -32,6 +32,7 @@ (define-module (guix import crate)
   #:use-module (guix packages)
   #:use-module (guix upstream)
   #:use-module (guix utils)
+  #:use-module (gnu packages)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (json)
@@ -92,7 +93,7 @@ (define-json-mapping <crate-dependency> make-crate-dependency
   (requirement   crate-dependency-requirement "req")) ;string
 
 (module-autoload! (current-module)
-		  '(semver) '(string->semver semver<?))
+		  '(semver) '(string->semver semver->string semver<?))
 (module-autoload! (current-module)
 		  '(semver ranges) '(string->semver-range semver-range-contains?))
 
@@ -235,6 +236,21 @@ (define version-number
          (or version
              (crate-latest-version crate))))
 
+  ;; find the highest existing package that fulfills the semver <range>
+  (define (find-package-version name range)
+    (let* ((semver-range (string->semver-range range))
+           (versions
+            (sort
+             (filter (lambda (version)
+                       (semver-range-contains? semver-range version))
+                     (map (lambda (pkg)
+                            (string->semver (package-version pkg)))
+                          (find-packages-by-name
+                           (crate-name->package-name name))))
+             semver<?)))
+      (and (not (null-list? versions))
+           (semver->string (last versions)))))
+
   ;; find the highest version of a crate that fulfills the semver <range>
   (define (find-crate-version crate range)
     (let* ((semver-range (string->semver-range range))
@@ -251,6 +267,17 @@ (define (find-crate-version crate range)
       (and (not (null-list? versions))
            (second (last versions)))))
 
+  (define (dependency-name+version dep)
+    (let* ((name (crate-dependency-id dep))
+           (req (crate-dependency-requirement dep))
+           (existing-version (find-package-version name req)))
+      (if existing-version
+          (list name existing-version)
+          (let* ((crate (lookup-crate* name))
+                 (ver (find-crate-version crate req)))
+            (list name
+                  (crate-version-number ver))))))
+
   (define version*
     (and crate
          (find-crate-version crate version-number)))
@@ -258,13 +285,7 @@ (define version*
   ;; sort and map the dependencies to a list containing
   ;; pairs of (name version)
   (define (sort-map-dependencies deps)
-    (sort (map (lambda (dep)
-                 (let* ((name (crate-dependency-id dep))
-                        (crate (lookup-crate* name))
-                        (req (crate-dependency-requirement dep))
-                        (ver (find-crate-version crate req)))
-                   (list name
-                         (crate-version-number ver))))
+    (sort (map dependency-name+version
                deps)
           (match-lambda* (((name _) ...)
                           (apply string-ci<? name)))))
-- 
cgit v1.2.3