store: Add #:select? parameter to 'add-to-store'.

* guix/store.scm (write-arg): Remove 'file' case.
(true): New procedure.
(add-to-store): Add #:select? parameter and honor it.  Use hand-coded
stub instead of 'operation'.
(interned-file): Add #:select? parameter and honor it.
* doc/guix.texi (The Store Monad): Adjust 'interned-file' documentation
accordingly.

1 files changed, 42 insertions, 18 deletions

diff --git a/guix/store.scm b/guix/store.scm
index e3033ee61a..a64016611d 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -263,14 +263,12 @@
     (path-info deriver hash refs registration-time nar-size)))
 
 (define-syntax write-arg
-  (syntax-rules (integer boolean file string string-list string-pairs
+  (syntax-rules (integer boolean string string-list string-pairs
                  store-path store-path-list base16)
     ((_ integer arg p)
      (write-int arg p))
     ((_ boolean arg p)
      (write-int (if arg 1 0) p))
-    ((_ file arg p)
-     (write-file arg p))
     ((_ string arg p)
      (write-string arg p))
     ((_ string-list arg p)
@@ -653,30 +651,51 @@ path."
               (hash-set! cache args path)
               path))))))
 
+(define true
+  ;; Define it once and for all since we use it as a default value for
+  ;; 'add-to-store' and want to make sure two default values are 'eq?' for the
+  ;; purposes or memoization.
+  (lambda (file stat)
+    #t))
+
 (define add-to-store
   ;; A memoizing version of `add-to-store'.  This is important because
   ;; `add-to-store' leads to huge data transfers to the server, and
   ;; because it's often called many times with the very same argument.
-  (let ((add-to-store (operation (add-to-store (string basename)
-                                               (boolean fixed?) ; obsolete, must be #t
-                                               (boolean recursive?)
-                                               (string hash-algo)
-                                               (file file-name))
-                                 #f
-                                 store-path)))
-    (lambda (server basename recursive? hash-algo file-name)
+  (let ((add-to-store
+         (lambda* (server basename recursive? hash-algo file-name
+                          #:key (select? true))
+           ;; We don't use the 'operation' macro so we can pass SELECT? to
+           ;; 'write-file'.
+           (let ((port (nix-server-socket server)))
+             (write-int (operation-id add-to-store) port)
+             (write-string basename port)
+             (write-int 1 port)                   ;obsolete, must be #t
+             (write-int (if recursive? 1 0) port)
+             (write-string hash-algo port)
+             (write-file file-name port #:select? select?)
+             (let loop ((done? (process-stderr server)))
+               (or done? (loop (process-stderr server))))
+             (read-store-path port)))))
+    (lambda* (server basename recursive? hash-algo file-name
+                     #:key (select? true))
       "Add the contents of FILE-NAME under BASENAME to the store.  When
 RECURSIVE? is false, FILE-NAME must designate a regular file--not a directory
 nor a symlink.  When RECURSIVE? is true and FILE-NAME designates a directory,
 the contents of FILE-NAME are added recursively; if FILE-NAME designates a
 flat file and RECURSIVE? is true, its contents are added, and its permission
-bits are kept.  HASH-ALGO must be a string such as \"sha256\"."
+bits are kept.  HASH-ALGO must be a string such as \"sha256\".
+
+When RECURSIVE? is true, call (SELECT?  FILE STAT) for each directory entry,
+where FILE is the entry's absolute file name and STAT is the result of
+'lstat'; exclude entries for which SELECT? does not return true."
       (let* ((st    (false-if-exception (lstat file-name)))
-             (args  `(,st ,basename ,recursive? ,hash-algo))
+             (args  `(,st ,basename ,recursive? ,hash-algo ,select?))
              (cache (nix-server-add-to-store-cache server)))
         (or (and st (hash-ref cache args))
-            (let ((path (add-to-store server basename #t recursive?
-                                      hash-algo file-name)))
+            (let ((path (add-to-store server basename recursive?
+                                      hash-algo file-name
+                                      #:select? select?)))
               (hash-set! cache args path)
               path))))))
 
@@ -1111,16 +1130,21 @@ resulting text file refers to; it defaults to the empty list."
             store)))
 
 (define* (interned-file file #:optional name
-                        #:key (recursive? #t))
+                        #:key (recursive? #t) (select? true))
   "Return the name of FILE once interned in the store.  Use NAME as its store
 name, or the basename of FILE if NAME is omitted.
 
 When RECURSIVE? is true, the contents of FILE are added recursively; if FILE
 designates a flat file and RECURSIVE? is true, its contents are added, and its
-permission bits are kept."
+permission bits are kept.
+
+When RECURSIVE? is true, call (SELECT?  FILE STAT) for each directory entry,
+where FILE is the entry's absolute file name and STAT is the result of
+'lstat'; exclude entries for which SELECT? does not return true."
   (lambda (store)
     (values (add-to-store store (or name (basename file))
-                          recursive? "sha256" file)
+                          recursive? "sha256" file
+                          #:select? select?)
             store)))
 
 (define build