system: Rewrite 'union' using gexps.

* gnu/system.scm (union): Rewrite using 'gexp->derivation'.
This commit is contained in:
Ludovic Courtès 2014-04-27 22:40:48 +02:00
parent 8779d34294
commit 8c35bfb68c
1 changed files with 14 additions and 29 deletions

View File

@ -120,38 +120,23 @@
"Return a derivation that builds the union of INPUTS. INPUTS is a list of "Return a derivation that builds the union of INPUTS. INPUTS is a list of
input tuples." input tuples."
(define builder (define builder
'(begin #~(begin
(use-modules (guix build union)) (use-modules (guix build union))
(setvbuf (current-output-port) _IOLBF) (define inputs '#$inputs)
(setvbuf (current-error-port) _IOLBF)
(let ((output (assoc-ref %outputs "out")) (setvbuf (current-output-port) _IOLBF)
(inputs (map cdr %build-inputs))) (setvbuf (current-error-port) _IOLBF)
(format #t "building union `~a' with ~a packages...~%"
output (length inputs))
(union-build output inputs))))
(mlet %store-monad (format #t "building union `~a' with ~a packages...~%"
((inputs (sequence %store-monad #$output (length inputs))
(map (match-lambda (union-build #$output inputs)))
((or ((? package? p)) (? package? p))
(mlet %store-monad (gexp->derivation name builder
((drv (package->derivation p system))) #:system system
(return `(,name ,drv)))) #:modules '((guix build union))
(((? package? p) output) #:guile-for-build guile
(mlet %store-monad #:local-build? #t))
((drv (package->derivation p system)))
(return `(,name ,drv ,output))))
(x
(return x)))
inputs))))
(derivation-expression name builder
#:system system
#:inputs inputs
#:modules '((guix build union))
#:guile-for-build guile
#:local-build? #t)))
(define* (file-union name files) (define* (file-union name files)
"Return a derivation that builds a directory containing all of FILES. Each "Return a derivation that builds a directory containing all of FILES. Each