import: crate: Use guile-semver to resolve module versions.

* guix/import/crate.scm: Add guile-semver as a soft dependency.
  (make-crate-sexp): Don't allow other keys. Add '#:skip-build?' to build
  system args. Pass a VERSION argument to 'cargo-inputs'.
  (crate->guix-package): Use guile-semver to resolve the correct module
  versions. Treat "build" dependencies as normal dependencies.
  (crate-name->package-name): Reuse the procedure 'guix-name' instead of
  duplicating its logic.
* guix/import/utils.scm (package-names->package-inputs): Implement
  handling of (name version) pairs.
* guix/scripts/import/crate.scm (guix-import-crate): Use
  crate-recursive-import instead of duplicate code.
* tests/crate.scm (recursive-import): Change test packages versions to be
  distinguishable. Add version data to the test. Check created symbols, too.

Co-authored-by: Hartmut Goebel <h.goebel@crazy-compilers.com>

1 files changed, 66 insertions, 25 deletions

diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 47bfc16105..5498d1f0ff 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 David Craven <david@craven.ch>
 ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,6 +37,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
             string->license
@@ -85,10 +86,15 @@
   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
 
+(module-autoload! (current-module)
+		  '(semver) '(string->semver semver<?))
+(module-autoload! (current-module)
+		  '(semver ranges) '(string->semver-range semver-range-contains?))
+
 (define (lookup-crate name)
   "Look up NAME on https://crates.io and return the corresopnding <crate>
 record or #f if it was not found."
@@ -142,16 +148,21 @@ record or #f if it was not found."
      `((arguments (,'quasiquote ,args))))))
 
 (define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inputs
-                          home-page synopsis description license
-                          #:allow-other-keys)
+                          home-page synopsis description license)
   "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."
+  (define (format-inputs inputs)
+    (map
+     (match-lambda
+      ((name version)
+       (list (crate-name->package-name name) version)))
+     inputs))
+
   (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
-                                        cargo-development-inputs))
+         (cargo-inputs (format-inputs cargo-inputs))
+         (cargo-development-inputs (format-inputs cargo-development-inputs))
          (pkg `(package
                    (name ,guix-name)
                    (version ,version)
@@ -163,7 +174,8 @@ and LICENSE."
                               (base32
                                ,(bytevector->nix-base32-string (port-sha256 port))))))
                    (build-system cargo-build-system)
-                   ,@(maybe-arguments (append (maybe-cargo-inputs cargo-inputs)
+                   ,@(maybe-arguments (append '(#:skip-build? #t)
+                                              (maybe-cargo-inputs cargo-inputs)
                                               (maybe-cargo-development-inputs
                                                 cargo-development-inputs)))
                    (home-page ,(match home-page
@@ -176,7 +188,7 @@ and LICENSE."
                                ((license) license)
                                (_ `(list ,@license)))))))
          (close-port port)
-         pkg))
+         (package->definition pkg #t)))
 
 (define (string->license string)
   (filter-map (lambda (license)
@@ -190,11 +202,17 @@ and LICENSE."
 (define* (crate->guix-package crate-name #:key version repo)
   "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."
+When VERSION is specified, convert it into a semver range and attempt to fetch
+the latest version matching this semver range; otherwise fetch the latest
+version of CRATE-NAME."
+
+  (define (semver-range-contains-string? range version)
+    (semver-range-contains? (string->semver-range range)
+                            (string->semver version)))
 
   (define (normal-dependency? dependency)
-    (eq? (crate-dependency-kind dependency) 'normal))
+    (or (eq? (crate-dependency-kind dependency) 'build)
+        (eq? (crate-dependency-kind dependency) 'normal)))
 
   (define crate
     (lookup-crate crate-name))
@@ -204,22 +222,45 @@ latest version of CRATE-NAME."
          (or version
              (crate-latest-version crate))))
 
+  ;; 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))
+           (versions
+            (sort
+             (filter (lambda (entry)
+                       (semver-range-contains? semver-range (first entry)))
+                     (map (lambda (ver)
+                            (list (string->semver (crate-version-number ver))
+                                  ver))
+                          (crate-versions crate)))
+             (match-lambda* (((semver _) ...)
+                             (apply semver<? semver))))))
+      (and (not (null-list? versions))
+           (second (last versions)))))
+
   (define version*
     (and crate
-         (find (lambda (version)
-                 (string=? (crate-version-number version)
-                           version-number))
-               (crate-versions crate))))
+         (find-crate-version crate version-number)))
+
+  ;; 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))))
+               deps)
+          (match-lambda* (((name _) ...)
+                          (apply string-ci<? name)))))
 
   (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<?)))
+       (let* ((dependencies (crate-version-dependencies version*))
+              (dep-crates dev-dep-crates (partition normal-dependency? dependencies))
+              (cargo-inputs (sort-map-dependencies dep-crates))
+              (cargo-development-inputs '()))
          (values
           (make-crate-sexp #:name crate-name
                            #:version (crate-version-number version*)
@@ -251,7 +292,7 @@ latest version of CRATE-NAME."
       ((name _ ...) name))))
 
 (define (crate-name->package-name name)
-  (string-append "rust-" (string-join (string-split name #\_) "-")))
+  (guix-name "rust-" name))
 
 
 ;;;