Browse Source

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'.
version-0.8.3
Ludovic Courtès 8 years ago
parent
commit
b53833b2ef
  1. 16
      doc/guix.texi
  2. 82
      gnu/system/vm.scm
  3. 51
      guix/gexp.scm
  4. 52
      tests/gexp.scm

16
doc/guix.texi

@ -2278,6 +2278,22 @@ search path to be copied in the store, compiled, and made available in
the load path during the execution of @var{exp}---e.g., @code{((guix
build utils) (guix build gnu-build-system))}.
When @var{references-graphs} is true, it must be a list of tuples of one of the
following forms:
@example
(@var{file-name} @var{package})
(@var{file-name} @var{package} @var{output})
(@var{file-name} @var{derivation})
(@var{file-name} @var{derivation} @var{output})
(@var{file-name} @var{store-item})
@end example
The right-hand-side of each element of @var{references-graphs} is automatically made
an input of the build process of @var{exp}. In the build environment, each
@var{file-name} contains the reference graph of the corresponding item, in a simple
text format.
The other arguments are as for @code{derivation} (@pxref{Derivations}).
@end deffn

82
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))
;;;

51
guix/gexp.scm

@ -109,6 +109,17 @@ the cross-compilation target triplet."
(return input)))
inputs))))
(define* (lower-reference-graphs graphs #:key system target)
"Given GRAPHS, a list of (FILE-NAME INPUT ...) lists for use as a
#:reference-graphs argument, lower it such that each INPUT is replaced by the
corresponding derivation."
(match graphs
(((file-names . inputs) ...)
(mlet %store-monad ((inputs (lower-inputs inputs
#:system system
#:target target)))
(return (map cons file-names inputs))))))
(define* (gexp->derivation name exp
#:key
system (target 'current)
@ -127,10 +138,38 @@ names of Guile modules from the current search path to be copied in the store,
compiled, and made available in the load path during the execution of
EXP---e.g., '((guix build utils) (guix build gnu-build-system)).
When REFERENCES-GRAPHS is true, it must be a list of tuples of one of the
following forms:
(FILE-NAME PACKAGE)
(FILE-NAME PACKAGE OUTPUT)
(FILE-NAME DERIVATION)
(FILE-NAME DERIVATION OUTPUT)
(FILE-NAME STORE-ITEM)
The right-hand-side of each element of REFERENCES-GRAPHS is automatically made
an input of the build process of EXP. In the build environment, each
FILE-NAME contains the reference graph of the corresponding item, in a simple
text format.
In that case, the reference graph of each store path is exported in
the build environment in the corresponding file, in a simple text format.
The other arguments are as for 'derivation'."
(define %modules modules)
(define outputs (gexp-outputs exp))
(define (graphs-file-names graphs)
;; Return a list of (FILE-NAME . STORE-PATH) pairs made from GRAPHS.
(map (match-lambda
((file-name (? derivation? drv))
(cons file-name (derivation->output-path drv)))
((file-name (? derivation? drv) sub-drv)
(cons file-name (derivation->output-path drv sub-drv)))
((file-name thing)
(cons file-name thing)))
graphs))
(mlet* %store-monad (;; The following binding is here to force
;; '%current-system' and '%current-target-system' to be
;; looked up at >>= time.
@ -162,6 +201,11 @@ The other arguments are as for 'derivation'."
#:system system
#:guile guile-for-build)
(return #f)))
(graphs (if references-graphs
(lower-reference-graphs references-graphs
#:system system
#:target target)
(return #f)))
(guile (if guile-for-build
(return guile-for-build)
(package->derivation (default-guile)
@ -182,9 +226,12 @@ The other arguments are as for 'derivation'."
(,builder)
,@(if modules
`((,modules) (,compiled) ,@inputs)
inputs))
inputs)
,@(match graphs
(((_ . inputs) ...) inputs)
(_ '())))
#:hash hash #:hash-algo hash-algo #:recursive? recursive?
#:references-graphs references-graphs
#:references-graphs (and=> graphs graphs-file-names)
#:local-build? local-build?)))
(define* (gexp-inputs exp #:optional (references gexp-references))

52
tests/gexp.scm

@ -335,19 +335,16 @@
(call-with-output-file (string-append #$output "/two")
(lambda (port)
(display "This is the second one." port))))))
(build-drv (lambda (two)
#~(begin
(use-modules (guix build store-copy))
(build-drv #~(begin
(use-modules (guix build store-copy))
(mkdir #$output)
'#$two ;make it an input
(populate-store '("graph") #$output)))))
(mkdir #$output)
(populate-store '("graph") #$output))))
(mlet* %store-monad ((one (gexp->derivation "one" build-one))
(two (gexp->derivation "two" (build-two one)))
(dir -> (derivation->output-path two))
(drv (gexp->derivation "store-copy" (build-drv two)
(drv (gexp->derivation "store-copy" build-drv
#:references-graphs
`(("graph" . ,dir))
`(("graph" ,two))
#:modules
'((guix build store-copy)
(guix build utils))))
@ -362,6 +359,43 @@
(string=? (readlink (string-append out "/" two "/one"))
one)))))))
(test-assertm "gexp->derivation #:references-graphs"
(mlet* %store-monad
((one (text-file "one" "hello, world"))
(two (gexp->derivation "two"
#~(symlink #$one #$output:chbouib)))
(drv (gexp->derivation "ref-graphs"
#~(begin
(use-modules (guix build store-copy))
(with-output-to-file #$output
(lambda ()
(write (call-with-input-file "guile"
read-reference-graph))))
(with-output-to-file #$output:one
(lambda ()
(write (call-with-input-file "one"
read-reference-graph))))
(with-output-to-file #$output:two
(lambda ()
(write (call-with-input-file "two"
read-reference-graph)))))
#:references-graphs `(("one" ,one)
("two" ,two "chbouib")
("guile" ,%bootstrap-guile))
#:modules '((guix build store-copy)
(guix build utils))))
(ok? (built-derivations (list drv)))
(guile-drv (package->derivation %bootstrap-guile))
(g-one -> (derivation->output-path drv "one"))
(g-two -> (derivation->output-path drv "two"))
(g-guile -> (derivation->output-path drv)))
(return (and ok?
(equal? (call-with-input-file g-one read) (list one))
(equal? (call-with-input-file g-two read)
(list one (derivation->output-path two "chbouib")))
(equal? (call-with-input-file g-guile read)
(list (derivation->output-path guile-drv)))))))
(define shebang
(string-append "#!" (derivation->output-path (%guile-for-build))
"/bin/guile --no-auto-compile"))

Loading…
Cancel
Save