aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/scripts/package.scm9
-rw-r--r--guix/ui.scm31
-rw-r--r--tests/ui.scm17
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"))