summary refs log tree commit diff
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
parentac841750a52e44d68d7f1b02e9507421f3e3824f (diff)
downloadguix-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.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))