~ruther/guix-local

d9ae938f2c950f3bf1896fb07189c3e28b4d8029 — Ludovic Courtès 11 years ago b39fc6f
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.
3 files changed, 90 insertions(+), 7 deletions(-)

M doc/guix.texi
M guix/gexp.scm
M tests/gexp.scm
M doc/guix.texi => doc/guix.texi +21 -3
@@ 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

M guix/gexp.scm => guix/gexp.scm +43 -4
@@ 31,6 31,8 @@

            gexp-input
            gexp-input?
            local-file
            local-file?

            gexp->derivation
            gexp->file


@@ 135,6 137,37 @@ cross-compiling.)"

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

M tests/gexp.scm => tests/gexp.scm +26 -0
@@ 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)