utils: Add `package-name->name+version'.
* guix/utils.scm (package-name->name+version): New procedure. * guix-package.in (guix-package)[find-package]: Use it. * tests/utils.scm ("package-name->name+version"): New test.
This commit is contained in:
parent
d388c2c435
commit
9b48fb88ca
|
@ -283,8 +283,6 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
|
||||||
;; Find the package NAME; NAME may contain a version number and a
|
;; Find the package NAME; NAME may contain a version number and a
|
||||||
;; sub-derivation name.
|
;; sub-derivation name.
|
||||||
(define request name)
|
(define request name)
|
||||||
(define versioned-rx
|
|
||||||
(make-regexp "^(.*)-([0-9][^-]*)$"))
|
|
||||||
|
|
||||||
(let*-values (((name sub-drv)
|
(let*-values (((name sub-drv)
|
||||||
(match (string-rindex name #\:)
|
(match (string-rindex name #\:)
|
||||||
|
@ -292,10 +290,7 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
|
||||||
(colon (values (substring name (+ 1 colon))
|
(colon (values (substring name (+ 1 colon))
|
||||||
(substring name colon)))))
|
(substring name colon)))))
|
||||||
((name version)
|
((name version)
|
||||||
(match (regexp-exec versioned-rx name)
|
(package-name->name+version name)))
|
||||||
(#f (values name #f))
|
|
||||||
(m (values (match:substring m 1)
|
|
||||||
(match:substring m 2))))))
|
|
||||||
(match (find-packages-by-name name version)
|
(match (find-packages-by-name name version)
|
||||||
((p)
|
((p)
|
||||||
(list name version sub-drv p))
|
(list name version sub-drv p))
|
||||||
|
|
|
@ -58,7 +58,8 @@
|
||||||
source-properties->location
|
source-properties->location
|
||||||
|
|
||||||
gnu-triplet->nix-system
|
gnu-triplet->nix-system
|
||||||
%current-system))
|
%current-system
|
||||||
|
package-name->name+version))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
@ -571,6 +572,27 @@ returned by `config.guess'."
|
||||||
;; System type as expected by Nix, usually ARCHITECTURE-KERNEL.
|
;; System type as expected by Nix, usually ARCHITECTURE-KERNEL.
|
||||||
(make-parameter (gnu-triplet->nix-system %host-type)))
|
(make-parameter (gnu-triplet->nix-system %host-type)))
|
||||||
|
|
||||||
|
(define (package-name->name+version name)
|
||||||
|
"Given NAME, a package name like \"foo-0.9.1b\", return two values:
|
||||||
|
\"foo\" and \"0.9.1b\". When the version part is unavailable, NAME and
|
||||||
|
#f are returned. The first hyphen followed by a digit is considered to
|
||||||
|
introduce the version part."
|
||||||
|
;; See also `DrvName' in Nix.
|
||||||
|
|
||||||
|
(define number?
|
||||||
|
(cut char-set-contains? char-set:digit <>))
|
||||||
|
|
||||||
|
(let loop ((chars (string->list name))
|
||||||
|
(prefix '()))
|
||||||
|
(match chars
|
||||||
|
(()
|
||||||
|
(values name #f))
|
||||||
|
((#\- (? number? n) rest ...)
|
||||||
|
(values (list->string (reverse prefix))
|
||||||
|
(list->string (cons n rest))))
|
||||||
|
((head tail ...)
|
||||||
|
(loop tail (cons head prefix))))))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; Source location.
|
;;; Source location.
|
||||||
|
|
|
@ -104,6 +104,24 @@
|
||||||
(equal? nix (gnu-triplet->nix-system gnu)))
|
(equal? nix (gnu-triplet->nix-system gnu)))
|
||||||
gnu nix))))
|
gnu nix))))
|
||||||
|
|
||||||
|
(test-assert "package-name->name+version"
|
||||||
|
(every (match-lambda
|
||||||
|
((name version)
|
||||||
|
(let*-values (((full-name)
|
||||||
|
(if version
|
||||||
|
(string-append name "-" version)
|
||||||
|
name))
|
||||||
|
((name* version*)
|
||||||
|
(package-name->name+version full-name)))
|
||||||
|
(and (equal? name* name)
|
||||||
|
(equal? version* version)))))
|
||||||
|
'(("foo" "0.9.1b")
|
||||||
|
("foo-bar" "1.0")
|
||||||
|
("foo-bar2" #f)
|
||||||
|
("guile" "2.0.6.65-134c9") ; as produced by `git-version-gen'
|
||||||
|
("nixpkgs" "1.0pre22125_a28fe19")
|
||||||
|
("gtk2" "2.38.0"))))
|
||||||
|
|
||||||
(test-assert "define-record-type*"
|
(test-assert "define-record-type*"
|
||||||
(begin
|
(begin
|
||||||
(define-record-type* <foo> foo make-foo
|
(define-record-type* <foo> foo make-foo
|
||||||
|
|
Loading…
Reference in New Issue