diff options
author | Ludovic Courtès <ludo@gnu.org> | 2020-01-30 01:17:54 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2020-01-30 01:17:54 +0100 |
commit | 68dbd5c9de78ad803cc33973db40d22e29c532ec (patch) | |
tree | 4cfe8830d58218d4b0ea23cd722386c4c97df520 | |
parent | ac841750a52e44d68d7f1b02e9507421f3e3824f (diff) | |
download | guix-68dbd5c9de78ad803cc33973db40d22e29c532ec.tar.gz |
gexp: Move 'file-mapping->tree' to (guix store).
* guix/gexp.scm (%not-slash): Remove. (file-mapping->tree): Move to... * guix/store.scm (file-mapping->tree): ... here.
-rw-r--r-- | guix/gexp.scm | 43 | ||||
-rw-r--r-- | guix/store.scm | 40 |
2 files changed, 40 insertions, 43 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm index 8fea42c757..0a9d56c0e8 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1239,49 +1239,6 @@ execution environment." ;;; Module handling. ;;; -(define %not-slash - (char-set-complement (char-set #\/))) - -(define (file-mapping->tree mapping) - "Convert MAPPING, an alist like: - - ((\"guix/build/utils.scm\" . \"…/utils.scm\")) - -to a tree suitable for '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 %utils-module ;; This file provides 'mkdir-p', needed to implement 'imported-files' and ;; other primitives below. Note: We give the file name relative to this diff --git a/guix/store.scm b/guix/store.scm index f99fa581a8..77ee23fdd8 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 build-things build @@ -1220,6 +1221,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 build-things (let ((build (operation (build-things (string-list things) (integer mode)) |