system: Rewrite 'union' using gexps.

* gnu/system.scm (union): Rewrite using 'gexp->derivation'.

1 files changed, 14 insertions, 29 deletions

diff --git a/gnu/system.scm b/gnu/system.scm
index 0b2501392d..86904d9be2 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -120,38 +120,23 @@
   "Return a derivation that builds the union of INPUTS.  INPUTS is a list of
 input tuples."
   (define builder
-    '(begin
-       (use-modules (guix build union))
+    #~(begin
+        (use-modules (guix build union))
+
+        (define inputs '#$inputs)
 
-       (setvbuf (current-output-port) _IOLBF)
-       (setvbuf (current-error-port) _IOLBF)
+        (setvbuf (current-output-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...~%"
-                 output (length inputs))
-         (union-build output inputs))))
+        (format #t "building union `~a' with ~a packages...~%"
+                #$output (length inputs))
+        (union-build #$output inputs)))
 
-  (mlet %store-monad
-      ((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
-                           #:inputs inputs
-                           #:modules '((guix build union))
-                           #:guile-for-build guile
-                           #:local-build? #t)))
+  (gexp->derivation name builder
+                    #:system system
+                    #:modules '((guix build union))
+                    #:guile-for-build guile
+                    #:local-build? #t))
 
 (define* (file-union name files)
   "Return a derivation that builds a directory containing all of FILES.  Each