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.
This commit is contained in:
parent
cc4ecc2d88
commit
2876b98925
@ -323,13 +323,8 @@ version; if SPEC does not specify an output, return OUTPUT."
|
|||||||
(package-full-name p)
|
(package-full-name p)
|
||||||
sub-drv)))
|
sub-drv)))
|
||||||
|
|
||||||
(let*-values (((name sub-drv)
|
(let-values (((name version sub-drv)
|
||||||
(match (string-rindex spec #\:)
|
(package-specification->name+version+output spec)))
|
||||||
(#f (values spec output))
|
|
||||||
(colon (values (substring spec 0 colon)
|
|
||||||
(substring spec (+ 1 colon))))))
|
|
||||||
((name version)
|
|
||||||
(package-name->name+version name)))
|
|
||||||
(match (find-best-packages-by-name name version)
|
(match (find-best-packages-by-name name version)
|
||||||
((p)
|
((p)
|
||||||
(values p (ensure-output p sub-drv)))
|
(values p (ensure-output p sub-drv)))
|
||||||
|
31
guix/ui.scm
31
guix/ui.scm
@ -52,6 +52,7 @@
|
|||||||
fill-paragraph
|
fill-paragraph
|
||||||
string->recutils
|
string->recutils
|
||||||
package->recutils
|
package->recutils
|
||||||
|
package-specification->name+version+output
|
||||||
string->generations
|
string->generations
|
||||||
string->duration
|
string->duration
|
||||||
args-fold*
|
args-fold*
|
||||||
@ -358,6 +359,11 @@ converted to a space; sequences of more than one line break are preserved."
|
|||||||
((_ _ chars)
|
((_ _ chars)
|
||||||
(list->string (reverse chars)))))
|
(list->string (reverse chars)))))
|
||||||
|
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Packages.
|
||||||
|
;;;
|
||||||
|
|
||||||
(define (string->recutils str)
|
(define (string->recutils str)
|
||||||
"Return a version of STR where newlines have been replaced by newlines
|
"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
|
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)))
|
(hours->duration (* 24 30) match)))
|
||||||
(else #f)))
|
(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)
|
(define (args-fold* options unrecognized-option-proc operand-proc . seeds)
|
||||||
"A wrapper on top of `args-fold' that does proper user-facing error
|
"A wrapper on top of `args-fold' that does proper user-facing error
|
||||||
reporting."
|
reporting."
|
||||||
|
17
tests/ui.scm
17
tests/ui.scm
@ -65,6 +65,23 @@ interface, and powerful string processing.")
|
|||||||
10)
|
10)
|
||||||
#\newline))
|
#\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"
|
(test-equal "integer"
|
||||||
'(1)
|
'(1)
|
||||||
(string->generations "1"))
|
(string->generations "1"))
|
||||||
|
Loading…
Reference in New Issue
Block a user