diff --git a/gnu/packages.scm b/gnu/packages.scm index 64a695d970..9b111eda28 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2013 Mark H Weaver ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2016 Alex Kost +;;; Copyright © 2016 Mathieu Lirzin ;;; ;;; This file is part of GNU Guix. ;;; @@ -276,26 +277,31 @@ (define (call-with-sigint-handler thunk handler) (lambda (k signum) (handler signum)))) + +;;; +;;; Package specification. +;;; + +(define (%find-package spec name version) + (match (find-best-packages-by-name name version) + ((pkg . pkg*) + (unless (null? pkg*) + (warning (_ "ambiguous package specification `~a'~%") spec) + (warning (_ "choosing ~a from ~a~%") + (package-full-name pkg) + (location->string (package-location pkg)))) + pkg) + (_ + (if version + (leave (_ "~A: package not found for version ~a~%") name version) + (leave (_ "~A: unknown package~%") name))))) + (define (specification->package spec) "Return a package matching SPEC. SPEC may be a package name, or a package name followed by a hyphen and a version number. If the version number is not present, return the preferred newest version." - (let-values (((name version) - (package-name->name+version spec))) - (match (find-best-packages-by-name name version) - ((p) ; one match - p) - ((p x ...) ; several matches - (warning (_ "ambiguous package specification `~a'~%") spec) - (warning (_ "choosing ~a from ~a~%") - (package-full-name p) - (location->string (package-location p))) - p) - (_ ; no matches - (if version - (leave (_ "~A: package not found for version ~a~%") - name version) - (leave (_ "~A: unknown package~%") name)))))) + (let-values (((name version) (package-name->name+version spec))) + (%find-package spec name version))) (define* (specification->package+output spec #:optional (output "out")) "Return the package and output specified by SPEC, or #f and #f; SPEC may @@ -308,24 +314,14 @@ (define* (specification->package+output spec #:optional (output "out")) If SPEC does not specify a version number, return the preferred newest version; if SPEC does not specify an output, return OUTPUT." - (define (ensure-output p sub-drv) - (if (member sub-drv (package-outputs p)) - sub-drv - (leave (_ "package `~a' lacks output `~a'~%") - (package-full-name p) - sub-drv))) - (let-values (((name version sub-drv) (package-specification->name+version+output spec output))) - (match (find-best-packages-by-name name version) - ((p) - (values p (ensure-output p sub-drv))) - ((p p* ...) - (warning (_ "ambiguous package specification `~a'~%") - spec) - (warning (_ "choosing ~a from ~a~%") - (package-full-name p) - (location->string (package-location p))) - (values p (ensure-output p sub-drv))) - (() - (leave (_ "~a: package not found~%") spec))))) + (match (%find-package spec name version) + (#f + (values #f #f)) + (package + (if (member sub-drv (package-outputs package)) + (values package sub-drv) + (leave (_ "package `~a' lacks output `~a'~%") + (package-full-name package) + sub-drv))))))