[bug#38408] [PATCH v17 7/8] import: crate: Trim version for names after left-most non-zero part.

[Hartmut Goebel <h.goebel@crazy-compilers.com>]

This complies to how versions are matched for caret requirements in crates:
An update is allowed if the new version number does not modify the left-most
non-zero digit in the major, minor, patch grouping.

* guix/import/crate.scm (version->semver-prefix): New function.
  (make-crate-sexp)[format-inputs]: Use it.
  (make-crate-sexp): Use it to pass shorter version to package->definition.
* guix/import/utils.scm (package->definition): Change optional parameter
  APPEND-VERSION? into APPEND-VERSION?/STRING. If it is a string, append its
  value to name.
* tests/crate.scm: Adjust tests accordingly.
---
 guix/import/crate.scm | 10 ++++++++--
 guix/import/utils.scm | 13 +++++++++----
 tests/crate.scm       | 25 ++++++++++++-------------
 3 files changed, 29 insertions(+), 19 deletions(-)

diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 20efa131d5..b133529ba7 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -150,6 +150,12 @@ record or #f if it was not found."
     ((args ...)
      `((arguments (,'quasiquote ,args))))))
 
+(define (version->semver-prefix version)
+  "Return the version up to and including the first non-zero part"
+  (first
+   (map match:substring
+        (list-matches "^(0+\\.){,2}[0-9]+" version))))
+
 (define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inputs
                           home-page synopsis description license build?)
   "Return the `package' s-expression for a rust package with the given NAME,
@@ -160,7 +166,7 @@ and LICENSE."
      (match-lambda
       ((name version)
        (list (crate-name->package-name name)
-             (version-major+minor version))))
+             (version->semver-prefix version))))
      inputs))
 
   (let* ((port (http-fetch (crate-uri name version)))
@@ -194,7 +200,7 @@ and LICENSE."
                                ((license) license)
                                (_ `(list ,@license)))))))
          (close-port port)
-         (package->definition pkg #t)))
+         (package->definition pkg (version->semver-prefix version))))
 
 (define (string->license string)
   (filter-map (lambda (license)
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index b74393e617..7de95349cd 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -263,16 +263,21 @@ package definition."
     ((package-inputs ...)
      `((native-inputs (,'quasiquote ,package-inputs))))))
 
-(define* (package->definition guix-package #:optional append-version?)
+(define* (package->definition guix-package #:optional append-version?/string)
+  "If APPEND-VERSION?/STRING is #t, append the package's major+minor
+version. If APPEND-VERSION?/string is a string, append this string."
   (match guix-package
     ((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-major+minor version))
-                           version))
+                       (cond
+                        ((string? append-version?/string)
+                         (string-append name "-" append-version?/string))
+                        ((= append-version?/string #t)
+                         (string-append name "-" (version-major+minor version)))
+                        ((#t) version)))
         ,guix-package))))
 
 (define (build-system-modules)
diff --git a/tests/crate.scm b/tests/crate.scm
index 3fbf6762c5..1506daeadd 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -352,7 +352,7 @@
              (_ (error "Unexpected URL: " url)))))
 
         (match (crate->guix-package "foo")
-          ((define-public 'rust-foo-1.0
+          ((define-public 'rust-foo-1
              (package (name "rust-foo")
                       (version "1.0.3")
                       (source
@@ -368,8 +368,7 @@
                        ('quasiquote
                         (#:skip-build? #t
                          #:cargo-inputs
-                         (("rust-leaf-alice"
-                           ('unquote 'rust-leaf-alice-0.7))))))
+                         (("rust-leaf-alice" ('unquote 'rust-leaf-alice-0.7))))))
                       (home-page "http://example.com")
                       (synopsis "summary")
                       (description "summary")
@@ -452,7 +451,7 @@
                 (synopsis "summary")
                 (description "summary")
                 (license (list license:expat license:asl2.0))))
-            (define-public 'rust-leaf-bob-3.0
+            (define-public 'rust-leaf-bob-3
               (package
                 (name "rust-leaf-bob")
                 (version "3.0.1")
@@ -471,7 +470,7 @@
                 (synopsis "summary")
                 (description "summary")
                 (license (list license:expat license:asl2.0))))
-            (define-public 'rust-intermediate-b-1.2
+            (define-public 'rust-intermediate-b-1
               (package
                 (name "rust-intermediate-b")
                 (version "1.2.3")
@@ -489,12 +488,12 @@
                  ('quasiquote (#:skip-build? #t
                                #:cargo-inputs
                                (("rust-leaf-bob"
-                                 ('unquote 'rust-leaf-bob-3.0))))))
+                                 ('unquote rust-leaf-bob-3))))))
                 (home-page "http://example.com")
                 (synopsis "summary")
                 (description "summary")
                 (license (list license:expat license:asl2.0))))
-            (define-public 'rust-intermediate-a-1.0
+            (define-public 'rust-intermediate-a-1
               (package
                 (name "rust-intermediate-a")
                 (version "1.0.42")
@@ -512,16 +511,16 @@
                  ('quasiquote (#:skip-build? #t
                                #:cargo-inputs
                                (("rust-intermediate-b"
-                                 ('unquote 'rust-intermediate-b-1.2))
+                                 ('unquote rust-intermediate-b-1))
                                 ("rust-leaf-alice"
                                  ('unquote 'rust-leaf-alice-0.7))
                                 ("rust-leaf-bob"
-                                 ('unquote 'rust-leaf-bob-3.0))))))
+                                 ('unquote rust-leaf-bob-3))))))
                 (home-page "http://example.com")
                 (synopsis "summary")
                 (description "summary")
                 (license (list license:expat license:asl2.0))))
-            (define-public 'rust-root-1.0
+            (define-public 'rust-root-1
               (package
                 (name "rust-root")
                 (version "1.0.4")
@@ -538,13 +537,13 @@
                 (arguments
                  ('quasiquote (#:cargo-inputs
                                (("rust-intermediate-a"
-                                 ('unquote 'rust-intermediate-a-1.0))
+                                 ('unquote rust-intermediate-a-1))
                                 ("rust-intermediate-b"
-                                 ('unquote 'rust-intermediate-b-1.2))
+                                 ('unquote rust-intermediate-b-1))
                                 ("rust-leaf-alice"
                                  ('unquote 'rust-leaf-alice-0.7))
                                 ("rust-leaf-bob"
-                                 ('unquote 'rust-leaf-bob-3.0))))))
+                                 ('unquote rust-leaf-bob-3))))))
                 (home-page "http://example.com")
                 (synopsis "summary")
                 (description "summary")
-- 
2.21.3