From 5f7c5a97ba0a30b7fcdcbdf330efa4800c7bce90 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sat, 16 Feb 2013 01:37:26 +0100
Subject: [PATCH] packages: Add `package-output'.

* guix/packages.scm (package-output): New procedure.
* tests/packages.scm ("package-output"): New test.
---
 guix/packages.scm  | 13 +++++++++++++
 tests/packages.scm |  9 ++++++++-
 2 files changed, 21 insertions(+), 1 deletion(-)

diff --git a/guix/packages.scm b/guix/packages.scm
index b372f03818..51984baa3b 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -20,10 +20,12 @@
   #:use-module (guix utils)
   #:use-module (guix store)
   #:use-module (guix base32)
+  #:use-module (guix derivations)
   #:use-module (guix build-system)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9 gnu)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:re-export (%current-system)
@@ -62,6 +64,7 @@
             package-source-derivation
             package-derivation
             package-cross-derivation
+            package-output
 
             &package-error
             package-error?
@@ -305,3 +308,13 @@ PACKAGE for SYSTEM."
 (define* (package-cross-derivation store package)
   ;; TODO
   #f)
+
+(define* (package-output store package output
+                         #:optional (system (%current-system)))
+  "Return the output path of PACKAGE's OUTPUT for SYSTEM---where OUTPUT is the
+symbolic output name, such as \"out\".  Note that this procedure calls
+`package-derivation', which is costly."
+  (let-values (((_ drv)
+                (package-derivation store package system)))
+    (derivation-output-path
+     (assoc-ref (derivation-outputs drv) output))))
diff --git a/tests/packages.scm b/tests/packages.scm
index 32ee558518..f441532d22 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -71,7 +71,7 @@
                    ("d" ,d) ("d/x" "something.drv"))
                  (pk 'x (package-transitive-inputs e))))))
 
-(test-skip (if (not %store) 3 0))
+(test-skip (if (not %store) 4 0))
 
 (test-assert "return values"
   (let-values (((drv-path drv)
@@ -79,6 +79,13 @@
     (and (derivation-path? drv-path)
          (derivation? drv))))
 
+(test-assert "package-output"
+  (let* ((package  (dummy-package "p"))
+         (drv-path (package-derivation %store package)))
+    (and (derivation-path? drv-path)
+         (string=? (derivation-path->output-path drv-path)
+                   (package-output %store package "out")))))
+
 (test-assert "trivial"
   (let* ((p (package (inherit (dummy-package "trivial"))
               (build-system trivial-build-system)