From 2876b9892583bc1245d77fd10286025cd8433ede Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 1 Nov 2013 16:57:48 +0100
Subject: ui: Factorize package specification parsing.

* guix/ui.scm (package-specification->name+version+output): New
  procedure.
* guix/scripts/package.scm (specification->package+output): Use it.
* tests/ui.scm ("package-specification->name+version+output"): New test.
---
 guix/scripts/package.scm |  9 ++-------
 guix/ui.scm              | 31 +++++++++++++++++++++++++++++++
 tests/ui.scm             | 17 +++++++++++++++++
 3 files changed, 50 insertions(+), 7 deletions(-)

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 4dbe2b7b63..941b2cdca7 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -323,13 +323,8 @@ version; if SPEC does not specify an output, return OUTPUT."
                (package-full-name p)
                sub-drv)))
 
-  (let*-values (((name sub-drv)
-                 (match (string-rindex spec #\:)
-                   (#f    (values spec output))
-                   (colon (values (substring spec 0 colon)
-                                  (substring spec (+ 1 colon))))))
-                ((name version)
-                 (package-name->name+version name)))
+  (let-values (((name version sub-drv)
+                (package-specification->name+version+output spec)))
     (match (find-best-packages-by-name name version)
       ((p)
        (values p (ensure-output p sub-drv)))
diff --git a/guix/ui.scm b/guix/ui.scm
index 7f8ed970d4..ddc93f9db4 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -52,6 +52,7 @@
             fill-paragraph
             string->recutils
             package->recutils
+            package-specification->name+version+output
             string->generations
             string->duration
             args-fold*
@@ -358,6 +359,11 @@ converted to a space; sequences of more than one line break are preserved."
     ((_ _ chars)
      (list->string (reverse chars)))))
 
+
+;;;
+;;; Packages.
+;;;
+
 (define (string->recutils str)
   "Return a version of STR where newlines have been replaced by newlines
 followed by \"+ \", which makes for a valid multi-line field value in the
@@ -472,6 +478,31 @@ following patterns: \"1d\", \"1w\", \"1m\"."
            (hours->duration (* 24 30) match)))
         (else #f)))
 
+(define* (package-specification->name+version+output spec
+                                                     #:optional (output "out"))
+  "Parse package specification SPEC and return three value: the specified
+package name, version number (or #f), and output name (or OUTPUT).  SPEC may
+optionally contain a version number and an output name, as in these examples:
+
+  guile
+  guile-2.0.9
+  guile:debug
+  guile-2.0.9:debug
+"
+  (let*-values (((name sub-drv)
+                 (match (string-rindex spec #\:)
+                   (#f    (values spec output))
+                   (colon (values (substring spec 0 colon)
+                                  (substring spec (+ 1 colon))))))
+                ((name version)
+                 (package-name->name+version name)))
+    (values name version sub-drv)))
+
+
+;;;
+;;; Command-line option processing.
+;;;
+
 (define (args-fold* options unrecognized-option-proc operand-proc . seeds)
   "A wrapper on top of `args-fold' that does proper user-facing error
 reporting."
diff --git a/tests/ui.scm b/tests/ui.scm
index 3d5c3e7969..08ee3967a8 100644
--- a/tests/ui.scm
+++ b/tests/ui.scm
@@ -65,6 +65,23 @@ interface, and powerful string processing.")
                    10)
    #\newline))
 
+(test-equal "package-specification->name+version+output"
+  '(("guile" #f "out")
+    ("guile" "2.0.9" "out")
+    ("guile" #f "debug")
+    ("guile" "2.0.9" "debug")
+    ("guile-cairo" "1.4.1" "out"))
+  (map (lambda (spec)
+         (call-with-values
+             (lambda ()
+               (package-specification->name+version+output spec))
+           list))
+       '("guile"
+         "guile-2.0.9"
+         "guile:debug"
+         "guile-2.0.9:debug"
+         "guile-cairo-1.4.1")))
+
 (test-equal "integer"
   '(1)
   (string->generations "1"))
-- 
cgit 1.4.1