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'.
This commit is contained in:
Ludovic Courtès 2014-09-06 15:45:32 +02:00
parent 108293c5ea
commit b53833b2ef
4 changed files with 144 additions and 49 deletions

View File

@ -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 the load path during the execution of @var{exp}---e.g., @code{((guix
build utils) (guix build gnu-build-system))}. 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}). The other arguments are as for @code{derivation} (@pxref{Derivations}).
@end deffn @end deffn

View File

@ -219,8 +219,6 @@ 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, 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 register INPUTS in the store database of the image so that Guix can be used in
the image." the image."
(mlet %store-monad
((graph (sequence %store-monad (map input->name+output inputs))))
(expression->derivation-in-linux-vm (expression->derivation-in-linux-vm
name name
#~(begin #~(begin
@ -260,7 +258,7 @@ the image."
#:make-disk-image? #t #:make-disk-image? #t
#:disk-image-size disk-image-size #:disk-image-size disk-image-size
#:disk-image-format disk-image-format #:disk-image-format disk-image-format
#:references-graphs graph))) #:references-graphs inputs))
;;; ;;;

View File

@ -109,6 +109,17 @@ the cross-compilation target triplet."
(return input))) (return input)))
inputs)))) 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 (define* (gexp->derivation name exp
#:key #:key
system (target 'current) 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 compiled, and made available in the load path during the execution of
EXP---e.g., '((guix build utils) (guix build gnu-build-system)). 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'." The other arguments are as for 'derivation'."
(define %modules modules) (define %modules modules)
(define outputs (gexp-outputs exp)) (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 (mlet* %store-monad (;; The following binding is here to force
;; '%current-system' and '%current-target-system' to be ;; '%current-system' and '%current-target-system' to be
;; looked up at >>= time. ;; looked up at >>= time.
@ -162,6 +201,11 @@ The other arguments are as for 'derivation'."
#:system system #:system system
#:guile guile-for-build) #:guile guile-for-build)
(return #f))) (return #f)))
(graphs (if references-graphs
(lower-reference-graphs references-graphs
#:system system
#:target target)
(return #f)))
(guile (if guile-for-build (guile (if guile-for-build
(return guile-for-build) (return guile-for-build)
(package->derivation (default-guile) (package->derivation (default-guile)
@ -182,9 +226,12 @@ The other arguments are as for 'derivation'."
(,builder) (,builder)
,@(if modules ,@(if modules
`((,modules) (,compiled) ,@inputs) `((,modules) (,compiled) ,@inputs)
inputs)) inputs)
,@(match graphs
(((_ . inputs) ...) inputs)
(_ '())))
#:hash hash #:hash-algo hash-algo #:recursive? recursive? #:hash hash #:hash-algo hash-algo #:recursive? recursive?
#:references-graphs references-graphs #:references-graphs (and=> graphs graphs-file-names)
#:local-build? local-build?))) #:local-build? local-build?)))
(define* (gexp-inputs exp #:optional (references gexp-references)) (define* (gexp-inputs exp #:optional (references gexp-references))

View File

@ -335,19 +335,16 @@
(call-with-output-file (string-append #$output "/two") (call-with-output-file (string-append #$output "/two")
(lambda (port) (lambda (port)
(display "This is the second one." port)))))) (display "This is the second one." port))))))
(build-drv (lambda (two) (build-drv #~(begin
#~(begin
(use-modules (guix build store-copy)) (use-modules (guix build store-copy))
(mkdir #$output) (mkdir #$output)
'#$two ;make it an input (populate-store '("graph") #$output))))
(populate-store '("graph") #$output)))))
(mlet* %store-monad ((one (gexp->derivation "one" build-one)) (mlet* %store-monad ((one (gexp->derivation "one" build-one))
(two (gexp->derivation "two" (build-two one))) (two (gexp->derivation "two" (build-two one)))
(dir -> (derivation->output-path two)) (drv (gexp->derivation "store-copy" build-drv
(drv (gexp->derivation "store-copy" (build-drv two)
#:references-graphs #:references-graphs
`(("graph" . ,dir)) `(("graph" ,two))
#:modules #:modules
'((guix build store-copy) '((guix build store-copy)
(guix build utils)))) (guix build utils))))
@ -362,6 +359,43 @@
(string=? (readlink (string-append out "/" two "/one")) (string=? (readlink (string-append out "/" two "/one"))
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 (define shebang
(string-append "#!" (derivation->output-path (%guile-for-build)) (string-append "#!" (derivation->output-path (%guile-for-build))
"/bin/guile --no-auto-compile")) "/bin/guile --no-auto-compile"))