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.

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