diff options
| author | Mathieu Lirzin <mthl@gnu.org> | 2016-02-28 17:50:58 +0100 |
|---|---|---|
| committer | Mathieu Lirzin <mthl@gnu.org> | 2016-03-02 21:41:41 +0100 |
| commit | fad155d47ea22c7ffd042ffddd03b0a6babd3b65 (patch) | |
| tree | 118ffda1b1700dcb741b883fd13dc36014ef7331 /gnu | |
| parent | b134a80c36b973aa67072a542e9a01cf97975443 (diff) | |
packages: Factorize package specification search.
* gnu/packages.scm (%find-package): New procedure.
(specification->package, specification->package+output): Use it.
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/packages.scm | 66 |
1 files changed, 31 insertions, 35 deletions
diff --git a/gnu/packages.scm b/gnu/packages.scm index 64a695d9702..9b111eda28c 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm | |||
| @@ -3,6 +3,7 @@ | |||
| 3 | ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org> | 3 | ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org> |
| 4 | ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> | 4 | ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> |
| 5 | ;;; Copyright © 2016 Alex Kost <alezost@gmail.com> | 5 | ;;; Copyright © 2016 Alex Kost <alezost@gmail.com> |
| 6 | ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> | ||
| 6 | ;;; | 7 | ;;; |
| 7 | ;;; This file is part of GNU Guix. | 8 | ;;; This file is part of GNU Guix. |
| 8 | ;;; | 9 | ;;; |
| @@ -276,26 +277,31 @@ return its return value." | |||
| 276 | (lambda (k signum) | 277 | (lambda (k signum) |
| 277 | (handler signum)))) | 278 | (handler signum)))) |
| 278 | 279 | ||
| 280 | |||
| 281 | ;;; | ||
| 282 | ;;; Package specification. | ||
| 283 | ;;; | ||
| 284 | |||
| 285 | (define (%find-package spec name version) | ||
| 286 | (match (find-best-packages-by-name name version) | ||
| 287 | ((pkg . pkg*) | ||
| 288 | (unless (null? pkg*) | ||
| 289 | (warning (_ "ambiguous package specification `~a'~%") spec) | ||
| 290 | (warning (_ "choosing ~a from ~a~%") | ||
| 291 | (package-full-name pkg) | ||
| 292 | (location->string (package-location pkg)))) | ||
| 293 | pkg) | ||
| 294 | (_ | ||
| 295 | (if version | ||
| 296 | (leave (_ "~A: package not found for version ~a~%") name version) | ||
| 297 | (leave (_ "~A: unknown package~%") name))))) | ||
| 298 | |||
| 279 | (define (specification->package spec) | 299 | (define (specification->package spec) |
| 280 | "Return a package matching SPEC. SPEC may be a package name, or a package | 300 | "Return a package matching SPEC. SPEC may be a package name, or a package |
| 281 | name followed by a hyphen and a version number. If the version number is not | 301 | name followed by a hyphen and a version number. If the version number is not |
| 282 | present, return the preferred newest version." | 302 | present, return the preferred newest version." |
| 283 | (let-values (((name version) | 303 | (let-values (((name version) (package-name->name+version spec))) |
| 284 | (package-name->name+version spec))) | 304 | (%find-package spec name version))) |
| 285 | (match (find-best-packages-by-name name version) | ||
| 286 | ((p) ; one match | ||
| 287 | p) | ||
| 288 | ((p x ...) ; several matches | ||
| 289 | (warning (_ "ambiguous package specification `~a'~%") spec) | ||
| 290 | (warning (_ "choosing ~a from ~a~%") | ||
| 291 | (package-full-name p) | ||
| 292 | (location->string (package-location p))) | ||
| 293 | p) | ||
| 294 | (_ ; no matches | ||
| 295 | (if version | ||
| 296 | (leave (_ "~A: package not found for version ~a~%") | ||
| 297 | name version) | ||
| 298 | (leave (_ "~A: unknown package~%") name)))))) | ||
| 299 | 305 | ||
| 300 | (define* (specification->package+output spec #:optional (output "out")) | 306 | (define* (specification->package+output spec #:optional (output "out")) |
| 301 | "Return the package and output specified by SPEC, or #f and #f; SPEC may | 307 | "Return the package and output specified by SPEC, or #f and #f; SPEC may |
| @@ -308,24 +314,14 @@ optionally contain a version number and an output name, as in these examples: | |||
| 308 | 314 | ||
| 309 | If SPEC does not specify a version number, return the preferred newest | 315 | If SPEC does not specify a version number, return the preferred newest |
| 310 | version; if SPEC does not specify an output, return OUTPUT." | 316 | version; if SPEC does not specify an output, return OUTPUT." |
| 311 | (define (ensure-output p sub-drv) | ||
| 312 | (if (member sub-drv (package-outputs p)) | ||
| 313 | sub-drv | ||
| 314 | (leave (_ "package `~a' lacks output `~a'~%") | ||
| 315 | (package-full-name p) | ||
| 316 | sub-drv))) | ||
| 317 | |||
| 318 | (let-values (((name version sub-drv) | 317 | (let-values (((name version sub-drv) |
| 319 | (package-specification->name+version+output spec output))) | 318 | (package-specification->name+version+output spec output))) |
| 320 | (match (find-best-packages-by-name name version) | 319 | (match (%find-package spec name version) |
| 321 | ((p) | 320 | (#f |
| 322 | (values p (ensure-output p sub-drv))) | 321 | (values #f #f)) |
| 323 | ((p p* ...) | 322 | (package |
| 324 | (warning (_ "ambiguous package specification `~a'~%") | 323 | (if (member sub-drv (package-outputs package)) |
| 325 | spec) | 324 | (values package sub-drv) |
| 326 | (warning (_ "choosing ~a from ~a~%") | 325 | (leave (_ "package `~a' lacks output `~a'~%") |
| 327 | (package-full-name p) | 326 | (package-full-name package) |
| 328 | (location->string (package-location p))) | 327 | sub-drv)))))) |
| 329 | (values p (ensure-output p sub-drv))) | ||
| 330 | (() | ||
| 331 | (leave (_ "~a: package not found~%") spec))))) | ||
