From 02100028bb78b9bb17764eab0f009fd6fa07fd7b Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 26 Apr 2014 16:36:48 +0200
Subject: gnu: Use gexps in obvious places in (gnu system ...).

* gnu/system.scm (operating-system-boot-script): Use 'gexp->file'
  instead of 'text-file*'.
* gnu/system/vm.scm (expression->derivation-in-linux-vm): Likewise.
  (system-qemu-image/shared-store-script)[builder]: Turn into a gexp.
  Use 'gexp->derivation' instead of 'derivation-expression'.
---
 gnu/system/vm.scm | 60 ++++++++++++++++++++++---------------------------------
 1 file changed, 24 insertions(+), 36 deletions(-)

(limited to 'gnu/system')

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index c491336ccb..82f9ec9a12 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -19,6 +19,7 @@
 (define-module (gnu system vm)
   #:use-module (guix config)
   #:use-module (guix store)
+  #:use-module (guix gexp)
   #:use-module (guix derivations)
   #:use-module (guix packages)
   #:use-module (guix monads)
@@ -158,12 +159,14 @@ (define builder
                         ,exp))
        (user-builder (text-file "builder-in-linux-vm"
                                 (object->string exp*)))
-       (loader       (text-file* "linux-vm-loader" ; XXX: use 'sexp-file'
-                                 "(begin (set! %load-path (cons \""
-                                 module-dir "\" %load-path)) "
-                                 "(set! %load-compiled-path (cons \""
-                                 compiled "\" %load-compiled-path))"
-                                 "(primitive-load \"" user-builder "\"))"))
+       (loader       (gexp->file "linux-vm-loader"
+                                 #~(begin
+                                     (set! %load-path
+                                           (cons #$module-dir %load-path))
+                                     (set! %load-compiled-path
+                                           (cons #$compiled
+                                                 %load-compiled-path))
+                                     (primitive-load #$user-builder))))
        (coreutils -> (car (assoc-ref %final-inputs "coreutils")))
        (initrd       (if initrd                   ; use the default initrd?
                          (return initrd)
@@ -351,37 +354,22 @@ (define initrd
        (initrd initrd)
        (image  (system-qemu-image/shared-store os)))
     (define builder
-      (mlet %store-monad ((qemu   (package-file qemu
-                                                "bin/qemu-system-x86_64"))
-                          (bash   (package-file bash "bin/sh"))
-                          (kernel (package-file (operating-system-kernel os)
-                                                "bzImage")))
-        (return `(let ((out (assoc-ref %outputs "out")))
-                   (call-with-output-file out
-                     (lambda (port)
-                       (display
-                        (string-append "#!" ,bash "
-exec " ,qemu " -enable-kvm -no-reboot -net nic,model=virtio \
-  -virtfs local,path=" ,(%store-prefix) ",security_model=none,mount_tag=store \
+      #~(call-with-output-file #$output
+          (lambda (port)
+            (display
+             (string-append "#!" #$bash "/bin/sh
+exec " #$qemu "/bin/qemu-system-x86_64 -enable-kvm -no-reboot -net nic,model=virtio \
+  -virtfs local,path=" #$(%store-prefix) ",security_model=none,mount_tag=store \
   -net user \
-  -kernel " ,kernel " -initrd "
-  ,(string-append (derivation->output-path initrd) "/initrd") " \
--append \"" ,(if graphic? "" "console=ttyS0 ")
-"--load=" ,(derivation->output-path os-drv) "/boot --root=/dev/vda1\" \
-  -drive file=" ,(derivation->output-path image)
+  -kernel " #$(operating-system-kernel os) "/bzImage \
+  -initrd " #$initrd "/initrd \
+-append \"" #$(if graphic? "" "console=ttyS0 ")
+  "--load=" #$os-drv "/boot --root=/dev/vda1\" \
+  -drive file=" #$image
   ",if=virtio,cache=writeback,werror=report,readonly\n")
-                        port)))
-                   (chmod out #o555)
-                   #t))))
-
-    (mlet %store-monad ((qemu    (package->derivation qemu))
-                        (bash    (package->derivation bash))
-                        (builder builder))
-      (derivation-expression "run-vm.sh" builder
-                             #:inputs `(("qemu" ,qemu)
-                                        ("image" ,image)
-                                        ("bash" ,bash)
-                                        ("initrd" ,initrd)
-                                        ("os" ,os-drv))))))
+             port)
+            (chmod port #o555))))
+
+    (gexp->derivation "run-vm.sh" builder)))
 
 ;;; vm.scm ends here
-- 
cgit v1.2.3