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:
parent
108293c5ea
commit
b53833b2ef
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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"))
|
||||||
|
|
Loading…
Reference in New Issue