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.
This commit is contained in:
Ludovic Courtès 2014-05-01 16:15:00 +02:00
parent 696893801c
commit 79c0c8cdf7
3 changed files with 28 additions and 2 deletions

View file

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

View file

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

View file

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