>From a39b458002e2c4c36c9adb2718f166b4e5ff7965 Mon Sep 17 00:00:00 2001
From: Mathieu Lirzin <address@hidden>
Date: Sun, 28 Feb 2016 17:50:58 +0100
Subject: [PATCH 1/2] packages: Factorize package specification search.

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

diff --git a/gnu/packages.scm b/gnu/packages.scm
index 64a695d..baec897 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2013 Mark H Weaver <address@hidden>
 ;;; Copyright © 2014 Eric Bavier <address@hidden>
 ;;; Copyright © 2016 Alex Kost <address@hidden>
+;;; Copyright © 2016 Mathieu Lirzin <address@hidden>
 ;;;
 ;;; 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,12 @@ 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)))))
+    (and=> (%find-package spec name version)
+           (lambda (pkg)
+             (if (member sub-drv (package-outputs pkg))
+                 (values pkg sub-drv)
+                 (leave (_ "package `~a' lacks output `~a'~%")
+                        (package-full-name pkg)
+                        sub-drv))))))
-- 
2.7.0