gexp: Add #:select? parameter to 'local-file'.

* guix/gexp.scm (<local-file>)[select?]: New field.
(true): New procedure.
(%local-file): Add #:select? and honor it.
(local-file): Likewise.
* tests/gexp.scm ("local-file, #:select?"): New test.
* doc/guix.texi (G-Expressions): Adjust accordingly.
This commit is contained in:
Ludovic Courtès 2016-06-16 00:06:27 +02:00
parent 07c8a98c3b
commit 0687fc9cd9
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 37 additions and 8 deletions

View File

@ -3804,7 +3804,7 @@ does not have any effect on what the G-expression does.
content is directly passed as a string.
@deffn {Scheme Procedure} local-file @var{file} [@var{name}] @
[#:recursive? #f]
[#:recursive? #f] [#:select? (const #t)]
Return an object representing local file @var{file} to add to the store; this
object can be used in a gexp. If @var{file} is a relative file name, it is looked
up relative to the source file where this form appears. @var{file} will be added to
@ -3814,6 +3814,11 @@ When @var{recursive?} is true, the contents of @var{file} are added recursively;
designates a flat file and @var{recursive?} is true, its contents are added, and its
permission bits are kept.
When @var{recursive?} is true, call @code{(@var{select?} @var{file}
@var{stat})} for each directory entry, where @var{file} is the entry's
absolute file name and @var{stat} is the result of @code{lstat}; exclude
entries for which @var{select?} does not return true.
This is the declarative counterpart of the @code{interned-file} monadic
procedure (@pxref{The Store Monad, @code{interned-file}}).
@end deffn

View File

@ -189,18 +189,21 @@ cross-compiling.)"
;; absolute file name. We keep it in a promise to compute it lazily and avoid
;; repeated 'stat' calls.
(define-record-type <local-file>
(%%local-file file absolute name recursive?)
(%%local-file file absolute name recursive? select?)
local-file?
(file local-file-file) ;string
(absolute %local-file-absolute-file-name) ;promise string
(name local-file-name) ;string
(recursive? local-file-recursive?)) ;Boolean
(recursive? local-file-recursive?) ;Boolean
(select? local-file-select?)) ;string stat -> Boolean
(define (true file stat) #t)
(define* (%local-file file promise #:optional (name (basename file))
#:key recursive?)
#:key recursive? (select? true))
;; This intermediate procedure is part of our ABI, but the underlying
;; %%LOCAL-FILE is not.
(%%local-file file promise name recursive?))
(%%local-file file promise name recursive? select?))
(define (absolute-file-name file directory)
"Return the canonical absolute file name for FILE, which lives in the
@ -222,6 +225,10 @@ 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.
When RECURSIVE? is true, call (SELECT? FILE STAT) for each directory entry,
where FILE is the entry's absolute file name and STAT is the result of
'lstat'; exclude entries for which SELECT? does not return true.
This is the declarative counterpart of the 'interned-file' monadic procedure."
(%local-file file
(delay (absolute-file-name file (current-source-directory)))
@ -235,12 +242,13 @@ This is the declarative counterpart of the 'interned-file' monadic procedure."
(define-gexp-compiler (local-file-compiler (file local-file?) system target)
;; "Compile" FILE by adding it to the store.
(match file
(($ <local-file> file (= force absolute) name recursive?)
(($ <local-file> file (= force absolute) name recursive? select?)
;; Canonicalize FILE so that if it's a symlink, it is resolved. Failing
;; to do that, when RECURSIVE? is #t, we could end up creating a dangling
;; symlink in the store, and when RECURSIVE? is #f 'add-to-store' would
;; just throw an error, both of which are inconvenient.
(interned-file absolute name #:recursive? recursive?))))
(interned-file absolute name
#:recursive? recursive? #:select? select?))))
(define-record-type <plain-file>
(%plain-file name content references)

View File

@ -33,7 +33,8 @@
#:use-module (rnrs io ports)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 popen))
#:use-module (ice-9 popen)
#:use-module (ice-9 ftw))
;; Test the (guix gexp) module.
@ -132,6 +133,21 @@
(lambda ()
(false-if-exception (delete-file link))))))
(test-assertm "local-file, #:select?"
(mlet* %store-monad ((select? -> (lambda (file stat)
(member (basename file)
'("guix.scm" "tests"
"gexp.scm"))))
(file -> (local-file ".." "directory"
#:recursive? #t
#:select? select?))
(dir (lower-object file)))
(return (and (store-path? dir)
(equal? (scandir dir)
'("." ".." "guix.scm" "tests"))
(equal? (scandir (string-append dir "/tests"))
'("." ".." "gexp.scm"))))))
(test-assert "one plain file"
(let* ((file (plain-file "hi" "Hello, world!"))
(exp (gexp (display (ungexp file))))