From b53833b2ef36cf139f65193bec688396a734b0d0 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 6 Sep 2014 15:45:32 +0200
Subject: gexp: Allow use of high-level objects in #:references-graphs.

* guix/gexp.scm (lower-reference-graphs): New procedure.
  (gexp->derivation)[graphs-file-names]: New procedure.
  Use 'lower-reference-graphs', and augment #:inputs argument as a
  function of #:references-graphs.
* doc/guix.texi (G-Expressions): Adjust 'gexp->derivation' documentation
  accordingly.
* tests/gexp.scm ("gexp->derivation, store copy"): Remove reference to
  TWO in BUILD-DRV.  Use TWO directly in #:references-graphs argument.
  ("gexp->derivation #:references-graphs"): New test.
* gnu/system/vm.scm (qemu-image): Remove variable 'graph'; use INPUTS as
  the #:references-graphs argument to
  'expression->derivation-in-linux-vm'.
---
 gnu/system/vm.scm | 82 +++++++++++++++++++++++++++----------------------------
 1 file changed, 40 insertions(+), 42 deletions(-)

(limited to 'gnu')

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 624f2a680a..205bf2cb19 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -219,48 +219,46 @@ (define* (qemu-image #:key
 all of INPUTS into the image being built.  When REGISTER-CLOSURES? is true,
 register INPUTS in the store database of the image so that Guix can be used in
 the image."
-  (mlet %store-monad
-      ((graph (sequence %store-monad (map input->name+output inputs))))
-   (expression->derivation-in-linux-vm
-    name
-    #~(begin
-        (use-modules (gnu build vm)
-                     (guix build utils))
-
-        (let ((inputs
-               '#$(append (list qemu parted grub e2fsprogs util-linux)
-                          (map canonical-package
-                               (list sed grep coreutils findutils gawk))
-                          (if register-closures? (list guix) '())))
-
-              ;; This variable is unused but allows us to add INPUTS-TO-COPY
-              ;; as inputs.
-              (to-register
-                '#$(map (match-lambda
-                         ((name thing) thing)
-                         ((name thing output) `(,thing ,output)))
-                        inputs)))
-
-          (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
-
-          (let ((graphs '#$(match inputs
-                             (((names . _) ...)
-                              names))))
-            (initialize-hard-disk "/dev/vda"
-                                  #:system-directory #$os-derivation
-                                  #:grub.cfg #$grub-configuration
-                                  #:closures graphs
-                                  #:copy-closures? #$copy-inputs?
-                                  #:register-closures? #$register-closures?
-                                  #:disk-image-size #$disk-image-size
-                                  #:file-system-type #$file-system-type
-                                  #:file-system-label #$file-system-label)
-            (reboot))))
-    #:system system
-    #:make-disk-image? #t
-    #:disk-image-size disk-image-size
-    #:disk-image-format disk-image-format
-    #:references-graphs graph)))
+  (expression->derivation-in-linux-vm
+   name
+   #~(begin
+       (use-modules (gnu build vm)
+                    (guix build utils))
+
+       (let ((inputs
+              '#$(append (list qemu parted grub e2fsprogs util-linux)
+                         (map canonical-package
+                              (list sed grep coreutils findutils gawk))
+                         (if register-closures? (list guix) '())))
+
+             ;; This variable is unused but allows us to add INPUTS-TO-COPY
+             ;; as inputs.
+             (to-register
+              '#$(map (match-lambda
+                       ((name thing) thing)
+                       ((name thing output) `(,thing ,output)))
+                      inputs)))
+
+         (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+
+         (let ((graphs '#$(match inputs
+                            (((names . _) ...)
+                             names))))
+           (initialize-hard-disk "/dev/vda"
+                                 #:system-directory #$os-derivation
+                                 #:grub.cfg #$grub-configuration
+                                 #:closures graphs
+                                 #:copy-closures? #$copy-inputs?
+                                 #:register-closures? #$register-closures?
+                                 #:disk-image-size #$disk-image-size
+                                 #:file-system-type #$file-system-type
+                                 #:file-system-label #$file-system-label)
+           (reboot))))
+   #:system system
+   #:make-disk-image? #t
+   #:disk-image-size disk-image-size
+   #:disk-image-format disk-image-format
+   #:references-graphs inputs))
 
 
 ;;;
-- 
cgit v1.2.3