~ruther/guix-local

fad155d47ea22c7ffd042ffddd03b0a6babd3b65 — Mathieu Lirzin 10 years ago b134a80
packages: Factorize package specification search.

* gnu/packages.scm (%find-package): New procedure.
(specification->package, specification->package+output): Use it.
1 files changed, 31 insertions(+), 35 deletions(-)

M gnu/packages.scm
M gnu/packages.scm => gnu/packages.scm +31 -35
@@ 3,6 3,7 @@
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;


@@ 276,26 277,31 @@ return its return value."
                    (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 @@ optionally contain a version number and an output name, as in these examples:

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))))))