diff options
author | Ludovic Courtès <ludo@gnu.org> | 2016-06-17 15:48:27 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2016-06-17 15:48:27 +0200 |
commit | c0eeccbc2486572de1ef88249c63bc71c28dfef6 (patch) | |
tree | a265eb0b77b3b876844662da5bc9b32c549209e0 /guix/gexp.scm | |
parent | 56501d3b1727cbafed25be4268c4e6c9387088d9 (diff) | |
parent | a1b484654af07303813a215d4e04c0e4e7b199e5 (diff) |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/gexp.scm')
-rw-r--r-- | guix/gexp.scm | 33 |
1 files changed, 14 insertions, 19 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm index b4d737ecae..2bf1013b3c 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -189,31 +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?)) - -(define (extract-directory properties) - "Extract the directory name from source location PROPERTIES." - (match (assq 'filename properties) - (('filename . (? string? file-name)) - (dirname file-name)) - (_ - #f))) - -(define-syntax-rule (current-source-directory) - "Expand to the directory of the current source file or #f if it could not -be determined." - (extract-directory (current-source-location))) + (%%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 @@ -235,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))) @@ -248,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) |