(zilch vfs): add vfs-to-string

core/src/vfs.sld

@@ -13,6 +13,7 @@
     vfs-dir-filter vfs-dir-filter-all
     vfs-subdir
     vfs-from-directory vfs-from-store
+    vfs-to-string
     vfs-to-store vfs-append-file)
 
   (begin
@@ -133,13 +134,48 @@
         (let ((osdir (store-path-realised store-path)))
          ; TODO(puck): use builtin:fetchurl here instead of reimporting (requires divining a hash first)
          (vfs-from-directory osdir))))
-   
+
+    (define (escape-ifs-string strval)
+      (define output-parts '())
+      (define (find index)
+        (define next-index (string-index-right strval (lambda (ch) (or (char=? ch #\space) (char=? ch #\newline) (char=? ch #\\))) index))
+        (if next-index
+          (begin
+            (set! output-parts (cons "\\" (cons (string-copy strval next-index index) output-parts)))
+            (find next-index))
+          (set! output-parts (cons (string-copy strval 0 index) output-parts))))
+      (find (string-length strval))
+      (string-concatenate output-parts))
+
+    (define (vfs-to-string vfs)
+      (define output '())
+      (mapping-for-each
+        (lambda (k v)
+          (define dirname (car k))
+          (define filename (cdr k))
+          (define path (if (string=? dirname "") filename (string-append dirname "/" filename)))
+          (if (eq? v 'directory)
+            (set! output (cons (cons 'mkdir path) output))
+            (set! output (cons (cons 'copy (cons v path)) output))))
+        (vfs-contents vfs))
+      (define (make-string data)
+       (define new-output '())
+       (for-each
+         (lambda (item)
+           (case (car item)
+             ((mkdir) (set! new-output (cons (string-append "mkdir " (escape-ifs-string (cdr item)) "\n") new-output)))
+             ((copy) (set! new-output (cons (string-append "copy " (escape-ifs-string (cadr item)) " " (escape-ifs-string (cddr item)) "\n") new-output)))))
+         data)
+       (string-concatenate new-output))
+
+      (zexp ,(make-string (zexp-unquote output))))
+
     ;; Returns a new VFS, with one file added.
     (define (vfs-append-file vfs path contents)
       (define split (string-contains-right path "/"))
       (define dirname (if split (string-copy path 0 split) ""))
       (define filename (if split (string-copy path (+ 1 split)) path))
-      
+
       (define new-mapping (mapping-set (vfs-contents vfs) (cons dirname filename) contents))
       (define (add-parent-dir name)
         (define split (string-contains-right name "/"))