A file walker with a glob.

2026-06-18 22:59:35 +02:00
parent 3b61e358dc
commit f175ac69b6
2 changed files with 55 additions and 0 deletions
@@ -15,3 +15,4 @@ compiled/
 # Dependency tracking files
 *.dep

+/private/*.bak
@@ -0,0 +1,54 @@
+#lang racket/base
+
+(require racket/sequence
+         racket/generator
+         racket/string
+         racket/path
+         file/glob)
+
+(provide make-file-walker
+         )
+
+
+(define (make-file-walker base-path glob-pattern callback)
+  (let* ((gen (sequence->generator
+               (sequence-filter
+                (λ (p)
+                  (let ((basename (file-name-from-path p)))
+                    (glob-match? glob-pattern basename)))
+                (in-directory base-path))))
+         (str-base-path* (format "~a" (normalize-path base-path)))
+         (delim (if (eq? (system-path-convention-type) 'windows) "\\" "/"))
+         (str-base-path (if (string-suffix? str-base-path* delim)
+                            str-base-path*
+                            (string-append str-base-path* delim)))
+         (base-path-len (string-length str-base-path))
+         (result #f)
+         )
+    (λ ()
+      (let ((path (gen)))
+        (if (void? path)
+            result
+            (let* ((str-path (path->string path))
+                   (ext* (path-get-extension path))
+                   (ext (substring
+                         (if (eq? ext* #f)
+                             "."
+                             (bytes->string/utf-8 ext*)) 1))
+                   (path-part (substring str-path base-path-len))
+                   (str-n-path (string-replace path-part "\\" "/"))
+                   (info (if (directory-exists? path)
+                             (list 'dir str-n-path ext)
+                             (list 'file str-n-path ext
+                                   (file-size path)
+                                   (file-or-directory-modify-seconds path))
+                             ))
+                   )
+              (set! result (callback (eq? (car info) 'dir)
+                                     base-path
+                                     path
+                                     path-part ext info))
+              'more))))
+    )
+  )
+