diff options
Diffstat (limited to 'guix/store.scm')
| -rw-r--r-- | guix/store.scm | 44 |
1 files changed, 43 insertions, 1 deletions
diff --git a/guix/store.scm b/guix/store.scm index fb4b92e0c4..014d08aaec 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -103,6 +103,7 @@ add-text-to-store add-to-store add-file-tree-to-store + file-mapping->tree binary-file with-build-handler map/accumulate-builds @@ -1237,6 +1238,45 @@ an arbitrary directory layout in the store without creating a derivation." (hash-set! cache tree result) result))))) +(define (file-mapping->tree mapping) + "Convert MAPPING, an alist like: + + ((\"guix/build/utils.scm\" . \"…/utils.scm\")) + +to a tree suitable for 'add-file-tree-to-store' and 'interned-file-tree'." + (let ((mapping (map (match-lambda + ((destination . source) + (cons (string-tokenize destination %not-slash) + source))) + mapping))) + (fold (lambda (pair result) + (match pair + ((destination . source) + (let loop ((destination destination) + (result result)) + (match destination + ((file) + (let* ((mode (stat:mode (stat source))) + (type (if (zero? (logand mode #o100)) + 'regular + 'executable))) + (alist-cons file + `(,type (file ,source)) + result))) + ((file rest ...) + (let ((directory (assoc-ref result file))) + (alist-cons file + `(directory + ,@(loop rest + (match directory + (('directory . entries) entries) + (#f '())))) + (if directory + (alist-delete file result) + result))))))))) + '() + mapping))) + (define current-build-prompt ;; When true, this is the prompt to abort to when 'build-things' is called. (make-parameter #f)) @@ -1859,7 +1899,9 @@ coalesce them into a single call." (values (map/accumulate-builds store (lambda (obj) (run-with-store store - (mproc obj))) + (mproc obj) + #:system (%current-system) + #:target (%current-target-system))) lst) store))) |