Archived
1
0
Fork 0

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. content is directly passed as a string.
@deffn {Scheme Procedure} local-file @var{file} [@var{name}] @ @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 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 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 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 designates a flat file and @var{recursive?} is true, its contents are added, and its
permission bits are kept. 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 This is the declarative counterpart of the @code{interned-file} monadic
procedure (@pxref{The Store Monad, @code{interned-file}}). procedure (@pxref{The Store Monad, @code{interned-file}}).
@end deffn @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 ;; absolute file name. We keep it in a promise to compute it lazily and avoid
;; repeated 'stat' calls. ;; repeated 'stat' calls.
(define-record-type <local-file> (define-record-type <local-file>
(%%local-file file absolute name recursive?) (%%local-file file absolute name recursive? select?)
local-file? local-file?
(file local-file-file) ;string (file local-file-file) ;string
(absolute %local-file-absolute-file-name) ;promise string (absolute %local-file-absolute-file-name) ;promise string
(name local-file-name) ;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)) (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 ;; This intermediate procedure is part of our ABI, but the underlying
;; %%LOCAL-FILE is not. ;; %%LOCAL-FILE is not.
(%%local-file file promise name recursive?)) (%%local-file file promise name recursive? select?))
(define (absolute-file-name file directory) (define (absolute-file-name file directory)
"Return the canonical absolute file name for FILE, which lives in the "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 designates a flat file and RECURSIVE? is true, its contents are added, and its
permission bits are kept. 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." This is the declarative counterpart of the 'interned-file' monadic procedure."
(%local-file file (%local-file file
(delay (absolute-file-name file (current-source-directory))) (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) (define-gexp-compiler (local-file-compiler (file local-file?) system target)
;; "Compile" FILE by adding it to the store. ;; "Compile" FILE by adding it to the store.
(match file (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 ;; 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 ;; 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 ;; symlink in the store, and when RECURSIVE? is #f 'add-to-store' would
;; just throw an error, both of which are inconvenient. ;; 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> (define-record-type <plain-file>
(%plain-file name content references) (%plain-file name content references)

View file

@ -33,7 +33,8 @@
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #: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. ;; Test the (guix gexp) module.
@ -132,6 +133,21 @@
(lambda () (lambda ()
(false-if-exception (delete-file link)))))) (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" (test-assert "one plain file"
(let* ((file (plain-file "hi" "Hello, world!")) (let* ((file (plain-file "hi" "Hello, world!"))
(exp (gexp (display (ungexp file)))) (exp (gexp (display (ungexp file))))