diff --git a/.gitignore b/.gitignore index 39a4f9c..6bd7bf8 100644 --- a/.gitignore +++ b/.gitignore @@ -15,3 +15,4 @@ compiled/ # Dependency tracking files *.dep +/private/*.bak diff --git a/private/file-walker.rkt b/private/file-walker.rkt new file mode 100644 index 0000000..8e078ad --- /dev/null +++ b/private/file-walker.rkt @@ -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)))) + ) + ) + \ No newline at end of file