ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-25 20:19:18 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

packages: Factorize package specification search.

Browse source 
* gnu/packages.scm (%find-package): New procedure.
(specification->package, specification->package+output): Use it.
This commit is contained in:
Mathieu Lirzin 2016-02-28 17:50:58 +01:00
parent b134a80c36
commit fad155d47e
1 changed files with 31 additions and 35 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

66
gnu/packages.scm
View file

@ -3,6 +3,7 @@
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -276,26 +277,31 @@ (define (call-with-sigint-handler thunk handler)
(lambda (k signum) (lambda (k signum)
(handler 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) (define (specification->package spec)
"Return a package matching SPEC. SPEC may be a package name, or a package "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 name followed by a hyphen and a version number. If the version number is not
present, return the preferred newest version." present, return the preferred newest version."
(let-values (((name version) (let-values (((name version) (package-name->name+version spec)))
(package-name->name+version spec))) (%find-package spec name version)))
(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))))))
(define* (specification->package+output spec #:optional (output "out")) (define* (specification->package+output spec #:optional (output "out"))
"Return the package and output specified by SPEC, or #f and #f; SPEC may "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 If SPEC does not specify a version number, return the preferred newest
version; if SPEC does not specify an output, return OUTPUT." 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) (let-values (((name version sub-drv)
(package-specification->name+version+output spec output))) (package-specification->name+version+output spec output)))
(match (find-best-packages-by-name name version) (match (%find-package spec name version)
((p) (#f
(values p (ensure-output p sub-drv))) (values #f #f))
((p p* ...) (package
(warning (_ "ambiguous package specification `~a'~%") (if (member sub-drv (package-outputs package))
spec) (values package sub-drv)
(warning (_ "choosing ~a from ~a~%") (leave (_ "package `~a' lacks output `~a'~%")
(package-full-name p) (package-full-name package)
(location->string (package-location p))) sub-drv))))))
(values p (ensure-output p sub-drv)))
(()
(leave (_ "~a: package not found~%") spec)))))