aboutsummaryrefslogtreecommitdiff
path: root/gnu/system/vm.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-09-06 15:45:32 +0200
committerLudovic Courtès <ludo@gnu.org>2014-09-06 23:42:56 +0200
commitb53833b2ef36cf139f65193bec688396a734b0d0 (patch)
tree36869e74c9147a95fb7ad3e8dea9bc65216dc093 /gnu/system/vm.scm
parent108293c5ea65502e351cb2f6682668d5d345dd1f (diff)
downloadpatches-b53833b2ef36cf139f65193bec688396a734b0d0.tar
patches-b53833b2ef36cf139f65193bec688396a734b0d0.tar.gz
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'.
Diffstat (limited to 'gnu/system/vm.scm')
-rw-r--r--gnu/system/vm.scm82
1 files changed, 40 insertions, 42 deletions
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 @@ INPUTS is a list of inputs (as for packages). When COPY-INPUTS? is true, copy
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))
;;;