Re: Streams: add stream-delay and streams of directory files

[Michael Heerdegen <michael_heerdegen@web.de>]

[-- Attachment #1: Type: text/plain, Size: 359 bytes --]

Nicolas Petton <nicolas@petton.fr> writes:

> Would you mind adding tests for `stream-delay' and
> `stream-of-directory-files'?  (A regression test for the stream
> implementation of `seq-copy' would be great too!)

I've added some tests to the last patch.

But I can't image how a test for `stream-of-directory-files' could look
like that is not nonsense.



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: stream.patch --]
[-- Type: text/x-diff, Size: 5957 bytes --]

diff --git a/packages/stream/stream.el b/packages/stream/stream.el
index 567a9e3..4d61cf1 100644
--- a/packages/stream/stream.el
+++ b/packages/stream/stream.el
@@ -152,7 +152,7 @@ range is infinite."
        (eq (car stream) stream--identifier)))
 
 (defun stream-empty ()
-  "Return an empty stream."
+  "Return a new empty stream."
   (list stream--identifier (thunk-delay nil)))
 
 (defun stream-empty-p (stream)
@@ -317,10 +317,69 @@ kind of nonlocal exit."
        (cons (stream-first stream)
              (seq-filter pred (stream-rest stream)))))))
 
+(defmacro stream-delay (expr)
+  "Return a new stream to be obtained by evaluating EXPR.
+EXPR will be evaluated once when an element of the resulting
+stream is requested for the first time, and must return a stream.
+EXPR will be evaluated in the lexical environment present when
+calling this function."
+  (let ((stream (make-symbol "stream")))
+    `(stream-make (let ((,stream ,expr))
+                    (if (stream-empty-p ,stream)
+                        nil
+                      (cons (stream-first ,stream)
+                            (stream-rest ,stream)))))))
+
 (cl-defmethod seq-copy ((stream stream))
   "Return a shallow copy of STREAM."
-  (stream-cons (stream-first stream)
-               (stream-rest stream)))
+  (stream-delay stream))
+
+(defun stream-of-directory-files-1 (directory &optional nosort recurse follow-links)
+  "Helper for `stream-of-directory-files'."
+  (stream-delay
+   (if (file-accessible-directory-p directory)
+       (let (files dirs (reverse-fun (if nosort #'identity #'nreverse)))
+         (dolist (file (directory-files directory t nil nosort))
+           (let ((is-dir (file-directory-p file)))
+             (unless (and is-dir
+                          (member (file-name-nondirectory (directory-file-name file))
+                                  '("." "..")))
+               (push file files)
+               (when (and is-dir
+                          (or follow-links (not (file-symlink-p file)))
+                          (if (functionp recurse) (funcall recurse file) recurse))
+                 (push file dirs)))))
+         (apply #'stream-append
+                (stream (funcall reverse-fun files))
+                (mapcar
+                 (lambda (dir) (stream-of-directory-files-1 dir nosort recurse follow-links))
+                 (funcall reverse-fun dirs))))
+     (stream-empty))))
+
+(defun stream-of-directory-files (directory &optional full nosort recurse follow-links filter)
+  "Return a stream of names of files in DIRECTORY.
+Call `directory-files' to list file names in DIRECTORY and make
+the result a stream.  Don't include files named \".\" or \"..\".
+The arguments FULL and NOSORT are directly passed to
+`directory-files'.
+
+Third optional argument RECURSE non-nil means recurse on
+subdirectories.  If RECURSE is a function, it should be a
+predicate accepting one argument, an absolute file name of a
+directory, and return non-nil when the returned stream should
+recurse into that directory.  Any other non-nil value means
+recurse into every readable subdirectory.
+
+Even with recurse non-nil, don't descent into directories by
+following symlinks unless FOLLOW-LINKS is non-nil.
+
+If FILTER is non-nil, it should be a predicate accepting one
+argument, an absolute file name.  It is used to limit the
+resulting stream to the files fulfilling this predicate."
+  (let* ((stream (stream-of-directory-files-1 directory nosort recurse follow-links))
+         (filtered-stream (if filter (seq-filter filter stream) stream)))
+    (if full filtered-stream
+      (seq-map (lambda (file) (file-relative-name file directory)) filtered-stream))))
 
 (provide 'stream)
 ;;; stream.el ends here
diff --git a/packages/stream/tests/stream-tests.el b/packages/stream/tests/stream-tests.el
index 88edf91..400f2ee 100644
--- a/packages/stream/tests/stream-tests.el
+++ b/packages/stream/tests/stream-tests.el
@@ -171,10 +171,40 @@
   (should (= 3 (stream-first (stream-rest (seq-filter #'cl-oddp (stream-range 0 4))))))
   (should (stream-empty-p (stream-rest (stream-rest (seq-filter #'cl-oddp (stream-range 0 4)))))))
 
+(ert-deftest stream-delay-test ()
+  (should (streamp (stream-delay (stream-range))))
+  (should (= 0 (stream-first (stream-delay (stream-range)))))
+  (should (= 1 (stream-first (stream-rest (stream-delay (stream-range))))))
+  (should (let ((stream (stream-range 3 7)))
+            (equal (seq-into (stream-delay stream) 'list)
+                   (seq-into               stream  'list))))
+  (should (null (seq-into (stream-delay (stream-empty)) 'list)))
+  (should (let* ((evaluated nil)
+                 (one-plus (lambda (el)
+                             (setq evaluated t)
+                             (1+ el)))
+                 (stream (seq-map one-plus (stream '(1)))))
+            (equal '(nil 2 t)
+                   (list evaluated (stream-first stream) evaluated))))
+  (should (let* ((a 0)
+                 (set-a (lambda (x) (setq a x)))
+                 (s (stream-delay (stream (list a))))                 
+                 res1 res2)
+            (funcall set-a 5)
+            (setq res1 (stream-first s))
+            (funcall set-a 11)
+            (setq res2 (stream-first s))
+            (and (equal res1 5)
+                 (equal res2 5)))))
+
 (ert-deftest stream-seq-copy-test ()
   (should (streamp (seq-copy (stream-range))))
   (should (= 0 (stream-first (seq-copy (stream-range)))))
-  (should (= 1 (stream-first (stream-rest (seq-copy (stream-range)))))))
+  (should (= 1 (stream-first (stream-rest (seq-copy (stream-range))))))
+  (should (let ((stream (stream-range 3 7)))
+            (equal (seq-into (seq-copy stream) 'list)
+                   (seq-into           stream  'list))))
+  (should (null (seq-into (seq-copy (stream-empty)) 'list))))
 
 (ert-deftest stream-range-test ()
   (should (stream-empty-p (stream-range 0 0)))

[-- Attachment #3: Type: text/plain, Size: 21 bytes --]



Regards,

Michael.