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:
Ludovic Courtès 2015-03-28 21:26:33 +01:00
parent b39fc6f7bc
commit d9ae938f2c
3 changed files with 90 additions and 7 deletions

View File

@ -2503,7 +2503,10 @@ processes that use them.
Actually this mechanism is not limited to package and derivation Actually this mechanism is not limited to package and derivation
objects; @dfn{compilers} able to ``lower'' other high-level objects to objects; @dfn{compilers} able to ``lower'' other high-level objects to
derivations can be defined, such that these objects can also be inserted 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: 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}). The other arguments are as for @code{derivation} (@pxref{Derivations}).
@end deffn @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} @deffn {Monadic Procedure} gexp->script @var{name} @var{exp}
Return an executable script @var{name} that runs @var{exp} using Return an executable script @var{name} that runs @var{exp} using
@var{guile} with @var{modules} in its search path. @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{} @deffn {Monadic Procedure} text-file* @var{name} @var{text} @dots{}
Return as a monadic value a derivation that builds a text file Return as a monadic value a derivation that builds a text file
containing all of @var{text}. @var{text} may list, in addition to containing all of @var{text}. @var{text} may list, in addition to
strings, packages, derivations, and store file names; the resulting strings, objects of any type that can be used in a gexp: packages,
store file holds references to all these. 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 This variant should be preferred over @code{text-file} anytime the file
to create will reference items from the store. This is typically the to create will reference items from the store. This is typically the

View File

@ -31,6 +31,8 @@
gexp-input gexp-input
gexp-input? gexp-input?
local-file
local-file?
gexp->derivation gexp->derivation
gexp->file gexp->file
@ -133,6 +135,37 @@ cross-compiling.)"
(with-monad %store-monad (with-monad %store-monad
(return drv))) (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. ;;; Inputs & outputs.
@ -453,8 +486,13 @@ and in the current monad setting (system type, etc.)"
(($ <gexp-input> (? struct? thing) output n?) (($ <gexp-input> (? struct? thing) output n?)
(let ((lower (lookup-compiler thing)) (let ((lower (lookup-compiler thing))
(target (if (or n? native?) #f target))) (target (if (or n? native?) #f target)))
(mlet %store-monad ((drv (lower thing system target))) (mlet %store-monad ((obj (lower thing system target)))
(return (derivation->output-path drv output))))) ;; 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) (($ <gexp-input> x)
(return x)) (return x))
(x (x
@ -809,8 +847,9 @@ its search path."
(define* (text-file* name #:rest text) (define* (text-file* name #:rest text)
"Return as a monadic value a derivation that builds a text file containing "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, all of TEXT. TEXT may list, in addition to strings, objects of any type that
and store file names; the resulting store file holds references to all these." can be used in a gexp: packages, derivations, local file objects, etc. The
resulting store file holds references to all these."
(define builder (define builder
(gexp (call-with-output-file (ungexp output "out") (gexp (call-with-output-file (ungexp output "out")
(lambda (port) (lambda (port)

View File

@ -97,6 +97,18 @@
%store (package-source coreutils)))) %store (package-source coreutils))))
(gexp->sexp* exp))))) (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" (test-assert "same input twice"
(let ((exp (gexp (begin (let ((exp (gexp (begin
(display (ungexp coreutils)) (display (ungexp coreutils))
@ -336,6 +348,20 @@
(mlet %store-monad ((drv mdrv)) (mlet %store-monad ((drv mdrv))
(return (string=? system (derivation-system drv)))))) (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" (test-assertm "gexp->derivation, cross-compilation"
(mlet* %store-monad ((target -> "mips64el-linux") (mlet* %store-monad ((target -> "mips64el-linux")
(exp -> (gexp (list (ungexp coreutils) (exp -> (gexp (list (ungexp coreutils)