diff options
| -rw-r--r-- | guix/scripts/package.scm | 9 | ||||
| -rw-r--r-- | guix/ui.scm | 31 | ||||
| -rw-r--r-- | 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")) |