import: crate: Trim version for names after left-most non-zero part.

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.
This commit is contained in:
Hartmut Goebel 2020-11-14 21:31:33 +01:00
parent 9a48e35be8
commit 45584061a9
No known key found for this signature in database
GPG key ID: 634A8DFFD3F631DF
3 changed files with 29 additions and 19 deletions

View file

@ -150,6 +150,12 @@ (define (maybe-arguments arguments)
((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 @@ (define (format-inputs inputs)
(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 @@ (define (format-inputs inputs)
((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)

View file

@ -263,16 +263,21 @@ (define* (maybe-native-inputs package-names #:optional (output #f))
((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)

View file

@ -352,7 +352,7 @@ (define test-source-hash
(_ (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 @@ (define test-source-hash
('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 @@ (define test-source-hash
(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 @@ (define-public 'rust-leaf-bob-3.0
(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 @@ (define-public 'rust-intermediate-b-1.2
('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 @@ (define-public 'rust-intermediate-a-1.0
('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 @@ (define-public 'rust-root-1.0
(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")