mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
gexp: Add 'local-file'.
* guix/gexp.scm (<local-file>): New record type. (local-file): New procedure. (local-file-compiler): New compiler. (gexp->sexp) <struct? thing>: Handle the case where 'lower' returns a file name. (text-file*): Update docstring.local-file doc * tests/gexp.scm ("one local file", "gexp->derivation, local-file"): New tests. * doc/guix.texi (G-Expressions): Mention local files early. Document 'local-file'. Update 'text-file*' documentation.
This commit is contained in:
parent
b39fc6f7bc
commit
d9ae938f2c
3 changed files with 90 additions and 7 deletions
|
@ -2503,7 +2503,10 @@ processes that use them.
|
|||
Actually this mechanism is not limited to package and derivation
|
||||
objects; @dfn{compilers} able to ``lower'' other high-level objects to
|
||||
derivations can be defined, such that these objects can also be inserted
|
||||
into gexps.
|
||||
into gexps. Another useful type of high-level object that can be
|
||||
inserted in a gexp is @dfn{local files}, which allows files from the
|
||||
local file system to be added to the store and referred to by
|
||||
derivations and such (see @code{local-file} below.)
|
||||
|
||||
To illustrate the idea, here is an example of a gexp:
|
||||
|
||||
|
@ -2666,6 +2669,20 @@ refer to. Any reference to another store item will lead to a build error.
|
|||
The other arguments are as for @code{derivation} (@pxref{Derivations}).
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} local-file @var{file} [@var{name}] @
|
||||
[#:recursive? #t]
|
||||
Return an object representing local file @var{file} to add to the store; this
|
||||
object can be used in a gexp. @var{file} will be added to the store under @var{name}--by
|
||||
default the base name of @var{file}.
|
||||
|
||||
When @var{recursive?} is true, the contents of @var{file} are added recursively; if @var{file}
|
||||
designates a flat file and @var{recursive?} is true, its contents are added, and its
|
||||
permission bits are kept.
|
||||
|
||||
This is the declarative counterpart of the @code{interned-file} monadic
|
||||
procedure (@pxref{The Store Monad, @code{interned-file}}).
|
||||
@end deffn
|
||||
|
||||
@deffn {Monadic Procedure} gexp->script @var{name} @var{exp}
|
||||
Return an executable script @var{name} that runs @var{exp} using
|
||||
@var{guile} with @var{modules} in its search path.
|
||||
|
@ -2703,8 +2720,9 @@ or a subset thereof.
|
|||
@deffn {Monadic Procedure} text-file* @var{name} @var{text} @dots{}
|
||||
Return as a monadic value a derivation that builds a text file
|
||||
containing all of @var{text}. @var{text} may list, in addition to
|
||||
strings, packages, derivations, and store file names; the resulting
|
||||
store file holds references to all these.
|
||||
strings, objects of any type that can be used in a gexp: packages,
|
||||
derivations, local file objects, etc. The resulting store file holds
|
||||
references to all these.
|
||||
|
||||
This variant should be preferred over @code{text-file} anytime the file
|
||||
to create will reference items from the store. This is typically the
|
||||
|
|
|
@ -31,6 +31,8 @@ (define-module (guix gexp)
|
|||
|
||||
gexp-input
|
||||
gexp-input?
|
||||
local-file
|
||||
local-file?
|
||||
|
||||
gexp->derivation
|
||||
gexp->file
|
||||
|
@ -133,6 +135,37 @@ (define-gexp-compiler (derivation-compiler (drv derivation?) system target)
|
|||
(with-monad %store-monad
|
||||
(return drv)))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Local files.
|
||||
;;;
|
||||
|
||||
(define-record-type <local-file>
|
||||
(%local-file file name recursive?)
|
||||
local-file?
|
||||
(file local-file-file) ;string
|
||||
(name local-file-name) ;string
|
||||
(recursive? local-file-recursive?)) ;Boolean
|
||||
|
||||
(define* (local-file file #:optional (name (basename file))
|
||||
#:key (recursive? #t))
|
||||
"Return an object representing local file FILE to add to the store; this
|
||||
object can be used in a gexp. FILE will be added to the store under NAME--by
|
||||
default the base name of FILE.
|
||||
|
||||
When RECURSIVE? is true, the contents of FILE are added recursively; if FILE
|
||||
designates a flat file and RECURSIVE? is true, its contents are added, and its
|
||||
permission bits are kept.
|
||||
|
||||
This is the declarative counterpart of the 'interned-file' monadic procedure."
|
||||
(%local-file file name recursive?))
|
||||
|
||||
(define-gexp-compiler (local-file-compiler (file local-file?) system target)
|
||||
;; "Compile" FILE by adding it to the store.
|
||||
(match file
|
||||
(($ <local-file> file name recursive?)
|
||||
(interned-file file name #:recursive? recursive?))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Inputs & outputs.
|
||||
|
@ -453,8 +486,13 @@ (define* (reference->sexp ref #:optional native?)
|
|||
(($ <gexp-input> (? struct? thing) output n?)
|
||||
(let ((lower (lookup-compiler thing))
|
||||
(target (if (or n? native?) #f target)))
|
||||
(mlet %store-monad ((drv (lower thing system target)))
|
||||
(return (derivation->output-path drv output)))))
|
||||
(mlet %store-monad ((obj (lower thing system target)))
|
||||
;; OBJ must be either a derivation or a store file name.
|
||||
(return (match obj
|
||||
((? derivation? drv)
|
||||
(derivation->output-path drv output))
|
||||
((? string? file)
|
||||
file))))))
|
||||
(($ <gexp-input> x)
|
||||
(return x))
|
||||
(x
|
||||
|
@ -809,8 +847,9 @@ (define (gexp->file name exp)
|
|||
|
||||
(define* (text-file* name #:rest text)
|
||||
"Return as a monadic value a derivation that builds a text file containing
|
||||
all of TEXT. TEXT may list, in addition to strings, packages, derivations,
|
||||
and store file names; the resulting store file holds references to all these."
|
||||
all of TEXT. TEXT may list, in addition to strings, objects of any type that
|
||||
can be used in a gexp: packages, derivations, local file objects, etc. The
|
||||
resulting store file holds references to all these."
|
||||
(define builder
|
||||
(gexp (call-with-output-file (ungexp output "out")
|
||||
(lambda (port)
|
||||
|
|
|
@ -97,6 +97,18 @@ (define-syntax-rule (test-assertm name exp)
|
|||
%store (package-source coreutils))))
|
||||
(gexp->sexp* exp)))))
|
||||
|
||||
(test-assert "one local file"
|
||||
(let* ((file (search-path %load-path "guix.scm"))
|
||||
(local (local-file file))
|
||||
(exp (gexp (display (ungexp local))))
|
||||
(intd (add-to-store %store (basename file) #t
|
||||
"sha256" file)))
|
||||
(and (gexp? exp)
|
||||
(match (gexp-inputs exp)
|
||||
(((x "out"))
|
||||
(eq? x local)))
|
||||
(equal? `(display ,intd) (gexp->sexp* exp)))))
|
||||
|
||||
(test-assert "same input twice"
|
||||
(let ((exp (gexp (begin
|
||||
(display (ungexp coreutils))
|
||||
|
@ -336,6 +348,20 @@ (define (match-input thing)
|
|||
(mlet %store-monad ((drv mdrv))
|
||||
(return (string=? system (derivation-system drv))))))
|
||||
|
||||
(test-assertm "gexp->derivation, local-file"
|
||||
(mlet* %store-monad ((file -> (search-path %load-path "guix.scm"))
|
||||
(intd (interned-file file))
|
||||
(local -> (local-file file))
|
||||
(exp -> (gexp (begin
|
||||
(stat (ungexp local))
|
||||
(symlink (ungexp local)
|
||||
(ungexp output)))))
|
||||
(drv (gexp->derivation "local-file" exp)))
|
||||
(mbegin %store-monad
|
||||
(built-derivations (list drv))
|
||||
(return (string=? (readlink (derivation->output-path drv))
|
||||
intd)))))
|
||||
|
||||
(test-assertm "gexp->derivation, cross-compilation"
|
||||
(mlet* %store-monad ((target -> "mips64el-linux")
|
||||
(exp -> (gexp (list (ungexp coreutils)
|
||||
|
|
Loading…
Reference in a new issue