From 84189ebc66266f03b9ca7e8b912d529886436851 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 17 Jun 2015 10:49:29 +0200
Subject: Move 'specification->package+output' to (gnu packages).

* guix/scripts/package.scm (specification->package+output): Move to...
* gnu/packages.scm (specification->package+output): ... here
* guix/scripts/archive.scm (guix): Adjust accordingly.
---
 gnu/packages.scm | 36 +++++++++++++++++++++++++++++++++++-
 1 file changed, 35 insertions(+), 1 deletion(-)

(limited to 'gnu/packages.scm')

diff --git a/gnu/packages.scm b/gnu/packages.scm
index 9eb4877be8..6e46a890bb 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -51,7 +51,8 @@
 
             check-package-freshness
 
-            specification->package))
+            specification->package
+            specification->package+output))
 
 ;;; Commentary:
 ;;;
@@ -418,3 +419,36 @@ present, return the preferred newest version."
            (leave (_ "~A: package not found for version ~a~%")
                   name version)
            (leave (_ "~A: unknown package~%") name))))))
+
+(define* (specification->package+output spec #:optional (output "out"))
+  "Return the package and output specified by SPEC, or #f and #f; SPEC may
+optionally contain a version number and an output name, as in these examples:
+
+  guile
+  guile-2.0.9
+  guile:debug
+  guile-2.0.9:debug
+
+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)))))
-- 
cgit v1.2.3