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))
(define inputs '#$inputs)
(setvbuf (current-output-port) _IOLBF) (setvbuf (current-output-port) _IOLBF)
(setvbuf (current-error-port) _IOLBF) (setvbuf (current-error-port) _IOLBF)
(let ((output (assoc-ref %outputs "out"))
(inputs (map cdr %build-inputs)))
(format #t "building union `~a' with ~a packages...~%" (format #t "building union `~a' with ~a packages...~%"
output (length inputs)) #$output (length inputs))
(union-build output inputs)))) (union-build #$output inputs)))
(mlet %store-monad (gexp->derivation name builder
((inputs (sequence %store-monad
(map (match-lambda
((or ((? package? p)) (? package? p))
(mlet %store-monad
((drv (package->derivation p system)))
(return `(,name ,drv))))
(((? package? p) output)
(mlet %store-monad
((drv (package->derivation p system)))
(return `(,name ,drv ,output))))
(x
(return x)))
inputs))))
(derivation-expression name builder
#:system system #:system system
#:inputs inputs
#:modules '((guix build union)) #:modules '((guix build union))
#:guile-for-build guile #:guile-for-build guile
#:local-build? #t))) #: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