summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2012-11-04 01:29:18 +0100
committerLudovic Courtès <ludo@gnu.org>2012-11-04 01:29:18 +0100
commit9b48fb88ca8177c987b0d3bf2e9ae46dac782430 (patch)
tree03cc3b7428339c1b9ba250dba3dd1aa6365f0d34
parentd388c2c435395aee61dc074023b1f218e6037545 (diff)
downloadpatches-9b48fb88ca8177c987b0d3bf2e9ae46dac782430.tar
patches-9b48fb88ca8177c987b0d3bf2e9ae46dac782430.tar.gz
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.
-rw-r--r--guix-package.in7
-rw-r--r--guix/utils.scm24
-rw-r--r--tests/utils.scm18
3 files changed, 42 insertions, 7 deletions
diff --git a/guix-package.in b/guix-package.in
index ed46a26ffb..41716d3ecc 100644
--- a/guix-package.in
+++ b/guix-package.in
@@ -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))
diff --git a/guix/utils.scm b/guix/utils.scm
index 345ed374cd..7ebc026702 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -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.
diff --git a/tests/utils.scm b/tests/utils.scm
index 7dd248fae2..1ced410d41 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -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