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:
parent
07c8a98c3b
commit
0687fc9cd9
3 changed files with 37 additions and 8 deletions
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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))))
|
||||||
|
|
Reference in a new issue