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
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

View File

@ -31,6 +31,8 @@
gexp-input
gexp-input?
local-file
local-file?
gexp->derivation
gexp->file
@ -133,6 +135,37 @@ cross-compiling.)"
(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 @@ and in the current monad setting (system type, etc.)"
(($ <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 @@ its search path."
(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)

View File

@ -97,6 +97,18 @@
%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 @@
(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)