From 79c0c8cdf74cc0587187aa8f25af29b21fe91ba2 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 1 May 2014 16:15:00 +0200
Subject: gexp: Add support for 'origin?' objects in 'ungexp' forms.

* guix/gexp.scm (lower-inputs, gexp-inputs, gexp->sexp,
  canonicalize-reference): Add 'origin?' case.
* guix/monads.scm (origin->derivation): New procedure.
* tests/gexp.scm ("one input origin"): New test.
---
 guix/gexp.scm   | 12 ++++++++++++
 guix/monads.scm |  4 ++++
 tests/gexp.scm  | 14 ++++++++++++--
 3 files changed, 28 insertions(+), 2 deletions(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 79b6ec7085..ff4fd3f289 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -85,6 +85,9 @@ (define (lower-inputs inputs)
                     (((? package? package) sub-drv ...)
                      (mlet %store-monad ((drv (package->derivation package)))
                        (return `(,drv ,@sub-drv))))
+                    (((? origin? origin) sub-drv ...)
+                     (mlet %store-monad ((drv (origin->derivation origin)))
+                       (return `(,drv ,@sub-drv))))
                     (input
                      (return input)))
                    inputs))))
@@ -158,6 +161,8 @@ (define (add-reference-inputs ref result)
        (cons ref result))
       (((? package?) (? string?))
        (cons ref result))
+      (((? origin?) (? string?))
+       (cons ref result))
       ((? gexp? exp)
        (append (gexp-inputs exp) result))
       (((? string? file))
@@ -199,6 +204,9 @@ (define (reference->sexp ref)
          (return (derivation->output-path drv output)))
         (((? package? p) (? string? output))
          (package-file p #:output output))
+        (((? origin? o) (? string? output))
+         (mlet %store-monad ((drv (origin->derivation o)))
+           (return (derivation->output-path drv output))))
         (($ <output-ref> output)
          ;; Output file names are not known in advance but the daemon defines
          ;; an environment variable for each of them at build time, so use
@@ -224,10 +232,14 @@ (define (canonicalize-reference ref)
   (match ref
     ((? package? p)
      `(,p "out"))
+    ((? origin? o)
+     `(,o "out"))
     ((? derivation? d)
      `(,d "out"))
     (((? package?) (? string?))
      ref)
+    (((? origin?) (? string?))
+     ref)
     (((? derivation?) (? string?))
      ref)
     ((? string? s)
diff --git a/guix/monads.scm b/guix/monads.scm
index 0e99cb37f1..809aba59b1 100644
--- a/guix/monads.scm
+++ b/guix/monads.scm
@@ -56,6 +56,7 @@ (define-module (guix monads)
             text-file
             text-file*
             package-file
+            origin->derivation
             package->derivation
             built-derivations)
   #:replace (imported-modules
@@ -395,6 +396,9 @@ (define derivation-expression
 (define package->derivation
   (store-lift package-derivation))
 
+(define origin->derivation
+  (store-lift package-source-derivation))
+
 (define imported-modules
   (store-lift (@ (guix derivations) imported-modules)))
 
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 3da5b82e4c..21606b510b 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -21,8 +21,7 @@ (define-module (test-gexp)
   #:use-module (guix monads)
   #:use-module (guix gexp)
   #:use-module (guix derivations)
-  #:use-module ((guix packages)
-                #:select (package-derivation %current-system))
+  #:use-module (guix packages)
   #:use-module (gnu packages)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bootstrap)
@@ -83,6 +82,17 @@ (define-syntax-rule (test-assertm name exp)
                              (package-derivation %store coreutils)))
                  (gexp->sexp* exp)))))
 
+(test-assert "one input origin"
+  (let ((exp (gexp (display (ungexp (package-source coreutils))))))
+    (and (gexp? exp)
+         (match (gexp-inputs exp)
+           (((o "out"))
+            (eq? o (package-source coreutils))))
+         (equal? `(display ,(derivation->output-path
+                             (package-source-derivation
+                              %store (package-source coreutils))))
+                 (gexp->sexp* exp)))))
+
 (test-assert "same input twice"
   (let ((exp (gexp (begin
                      (display (ungexp coreutils))
-- 
cgit v1.2.3