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
|
||||
;; sub-derivation name.
|
||||
(define request name)
|
||||
(define versioned-rx
|
||||
(make-regexp "^(.*)-([0-9][^-]*)$"))
|
||||
|
||||
(let*-values (((name sub-drv)
|
||||
(match (string-rindex name #\:)
|
||||
@ -292,10 +290,7 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
|
||||
(colon (values (substring name (+ 1 colon))
|
||||
(substring name colon)))))
|
||||
((name version)
|
||||
(match (regexp-exec versioned-rx name)
|
||||
(#f (values name #f))
|
||||
(m (values (match:substring m 1)
|
||||
(match:substring m 2))))))
|
||||
(package-name->name+version name)))
|
||||
(match (find-packages-by-name name version)
|
||||
((p)
|
||||
(list name version sub-drv p))
|
||||
|
@ -58,7 +58,8 @@
|
||||
source-properties->location
|
||||
|
||||
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.
|
||||
(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.
|
||||
|
@ -104,6 +104,24 @@
|
||||
(equal? nix (gnu-triplet->nix-system gnu)))
|
||||
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*"
|
||||
(begin
|
||||
(define-record-type* <foo> foo make-foo
|
||||
|
Loading…
Reference in New Issue
Block a user