diff options
author | Ludovic Courtès <ludo@gnu.org> | 2014-09-06 15:45:32 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2014-09-06 23:42:56 +0200 |
commit | b53833b2ef36cf139f65193bec688396a734b0d0 (patch) | |
tree | 36869e74c9147a95fb7ad3e8dea9bc65216dc093 /gnu/system/vm.scm | |
parent | 108293c5ea65502e351cb2f6682668d5d345dd1f (diff) | |
download | gnu-guix-b53833b2ef36cf139f65193bec688396a734b0d0.tar gnu-guix-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.scm | 82 |
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)) ;;; |