mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 22:08:16 -05:00
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:
parent
696893801c
commit
79c0c8cdf7
3 changed files with 28 additions and 2 deletions
|
@ -85,6 +85,9 @@ (define (lower-inputs inputs)
|
||||||
(((? package? package) sub-drv ...)
|
(((? package? package) sub-drv ...)
|
||||||
(mlet %store-monad ((drv (package->derivation package)))
|
(mlet %store-monad ((drv (package->derivation package)))
|
||||||
(return `(,drv ,@sub-drv))))
|
(return `(,drv ,@sub-drv))))
|
||||||
|
(((? origin? origin) sub-drv ...)
|
||||||
|
(mlet %store-monad ((drv (origin->derivation origin)))
|
||||||
|
(return `(,drv ,@sub-drv))))
|
||||||
(input
|
(input
|
||||||
(return input)))
|
(return input)))
|
||||||
inputs))))
|
inputs))))
|
||||||
|
@ -158,6 +161,8 @@ (define (add-reference-inputs ref result)
|
||||||
(cons ref result))
|
(cons ref result))
|
||||||
(((? package?) (? string?))
|
(((? package?) (? string?))
|
||||||
(cons ref result))
|
(cons ref result))
|
||||||
|
(((? origin?) (? string?))
|
||||||
|
(cons ref result))
|
||||||
((? gexp? exp)
|
((? gexp? exp)
|
||||||
(append (gexp-inputs exp) result))
|
(append (gexp-inputs exp) result))
|
||||||
(((? string? file))
|
(((? string? file))
|
||||||
|
@ -199,6 +204,9 @@ (define (reference->sexp ref)
|
||||||
(return (derivation->output-path drv output)))
|
(return (derivation->output-path drv output)))
|
||||||
(((? package? p) (? string? output))
|
(((? package? p) (? string? output))
|
||||||
(package-file p #:output 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-ref> output)
|
||||||
;; Output file names are not known in advance but the daemon defines
|
;; Output file names are not known in advance but the daemon defines
|
||||||
;; an environment variable for each of them at build time, so use
|
;; an environment variable for each of them at build time, so use
|
||||||
|
@ -224,10 +232,14 @@ (define (canonicalize-reference ref)
|
||||||
(match ref
|
(match ref
|
||||||
((? package? p)
|
((? package? p)
|
||||||
`(,p "out"))
|
`(,p "out"))
|
||||||
|
((? origin? o)
|
||||||
|
`(,o "out"))
|
||||||
((? derivation? d)
|
((? derivation? d)
|
||||||
`(,d "out"))
|
`(,d "out"))
|
||||||
(((? package?) (? string?))
|
(((? package?) (? string?))
|
||||||
ref)
|
ref)
|
||||||
|
(((? origin?) (? string?))
|
||||||
|
ref)
|
||||||
(((? derivation?) (? string?))
|
(((? derivation?) (? string?))
|
||||||
ref)
|
ref)
|
||||||
((? string? s)
|
((? string? s)
|
||||||
|
|
|
@ -56,6 +56,7 @@ (define-module (guix monads)
|
||||||
text-file
|
text-file
|
||||||
text-file*
|
text-file*
|
||||||
package-file
|
package-file
|
||||||
|
origin->derivation
|
||||||
package->derivation
|
package->derivation
|
||||||
built-derivations)
|
built-derivations)
|
||||||
#:replace (imported-modules
|
#:replace (imported-modules
|
||||||
|
@ -395,6 +396,9 @@ (define derivation-expression
|
||||||
(define package->derivation
|
(define package->derivation
|
||||||
(store-lift package-derivation))
|
(store-lift package-derivation))
|
||||||
|
|
||||||
|
(define origin->derivation
|
||||||
|
(store-lift package-source-derivation))
|
||||||
|
|
||||||
(define imported-modules
|
(define imported-modules
|
||||||
(store-lift (@ (guix derivations) imported-modules)))
|
(store-lift (@ (guix derivations) imported-modules)))
|
||||||
|
|
||||||
|
|
|
@ -21,8 +21,7 @@ (define-module (test-gexp)
|
||||||
#:use-module (guix monads)
|
#:use-module (guix monads)
|
||||||
#:use-module (guix gexp)
|
#:use-module (guix gexp)
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
#:use-module ((guix packages)
|
#:use-module (guix packages)
|
||||||
#:select (package-derivation %current-system))
|
|
||||||
#:use-module (gnu packages)
|
#:use-module (gnu packages)
|
||||||
#:use-module (gnu packages base)
|
#:use-module (gnu packages base)
|
||||||
#:use-module (gnu packages bootstrap)
|
#:use-module (gnu packages bootstrap)
|
||||||
|
@ -83,6 +82,17 @@ (define-syntax-rule (test-assertm name exp)
|
||||||
(package-derivation %store coreutils)))
|
(package-derivation %store coreutils)))
|
||||||
(gexp->sexp* exp)))))
|
(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"
|
(test-assert "same input twice"
|
||||||
(let ((exp (gexp (begin
|
(let ((exp (gexp (begin
|
||||||
(display (ungexp coreutils))
|
(display (ungexp coreutils))
|
||||||
|
|
Loading…
Reference in a new issue