summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-01-30 01:17:54 +0100
committerLudovic Courtès <ludo@gnu.org>2020-01-30 01:17:54 +0100
commit68dbd5c9de78ad803cc33973db40d22e29c532ec (patch)
tree4cfe8830d58218d4b0ea23cd722386c4c97df520 /guix
parentac841750a52e44d68d7f1b02e9507421f3e3824f (diff)
downloadpatches-68dbd5c9de78ad803cc33973db40d22e29c532ec.tar
patches-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.
Diffstat (limited to 'guix')
-rw-r--r--guix/gexp.scm43
-rw-r--r--guix/store.scm40
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))