hans/audio-library-manager
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Full conversion done

Browse Source
This commit is contained in:
Hans Dijkema
2026-06-25 21:52:17 +02:00
parent f175ac69b6
commit 7a742fcda9
8 changed files with 637 additions and 331 deletions
Download Patch File Download Diff File Expand all files Collapse all files
private/file-walker.rkt
+112 -18
View File
@@ -7,10 +7,16 @@
file/glob)
(provide make-file-walker
make-file-admin
fw-add-filter
os-path
)
(define (os-path str)
(let ((delim (if (eq? (system-path-convention-type) 'windows) "\\" "/")))
(string-replace str "/" delim)))
(define (make-file-walker base-path glob-pattern callback)
(define (make-file-walker base-path glob-pattern filter-func)
(let* ((gen (sequence->generator
(sequence-filter
(λ (p)
@@ -28,27 +34,115 @@
(λ ()
(let ((path (gen)))
(if (void? path)
result
(values #f #f #f)
(let* ((str-path (path->string path))
(ext* (path-get-extension path))
(ext (substring
(if (eq? ext* #f)
"."
(bytes->string/utf-8 ext*)) 1))
(ext (string->symbol
(substring
(if (eq? ext* #f)
"."
(let ((e (string-downcase (bytes->string/utf-8 ext*))))
(if (string-contains? e " ")
"."
e))) 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))
))
(info (let ((h (make-hash (list
(cons 'type 'dir)
(cons 'path str-n-path)
(cons 'ext ext)))))
(when (file-exists? path)
(hash-set! h 'type 'file)
(hash-set! h 'size (file-size path))
(hash-set! h 'mtime (file-or-directory-modify-seconds path))
)
h))
)
(set! result (callback (eq? (car info) 'dir)
base-path
path
path-part ext info))
'more))))
(filter-func base-path path info)))
)
)
)
)
(define (make-file-admin base-path db-hash)
(define (file-info-equal? i1 i2)
(if (eq? (hash-ref i1 'type) (hash-ref i2 'type))
(if (eq? (hash-ref i1 'type) 'file)
(and
(string=? (hash-ref i1 'path) (hash-ref i2 'path))
(= (hash-ref i1 'size) (hash-ref i2 'size))
(= (hash-ref i1 'mtime) (hash-ref i2 'mtime)))
(string=? (hash-ref i1 'path) (hash-ref i2 'path))
)
#f))
(define (file-admin base-path path info)
(let* ((normalized-sub-path (hash-ref info 'path))
(in-db (hash-ref db-hash normalized-sub-path #f))
)
(cond
((eq? in-db #f)
(hash-set! info 'file-db 'new)
(hash-set! db-hash normalized-sub-path info)
)
(else
(if (file-info-equal? info in-db)
(hash-set! info 'file-db 'unchanged)
(hash-set! info 'file-db 'changed))
(hash-set! db-hash normalized-sub-path info)
)
)
(values base-path path info)
))
(define (init-db-sweep)
(hash-for-each db-hash
(λ (key value)
(if (eq? (hash-ref value 'file-db #f) 'deleted)
(hash-remove! db-hash key)
(hash-set! value 'file-db 'unknown)))))
(define (get-deleted)
(let ((keys (hash-keys db-hash)))
(map (λ (key)
(let ((info (hash-ref db-hash key)))
(hash-set! info 'file-db 'deleted)
info))
(filter (λ (key)
(let ((v (hash-ref db-hash key)))
(eq? (hash-ref v 'file-db) 'unknown)))
keys))))
(let* ((fw (make-file-walker base-path "*" file-admin))
(deleted #f))
(init-db-sweep)
(letrec ((f (λ ()
(if (list? deleted)
(if (null? deleted)
(values #f #f #f)
(let ((r (car deleted)))
(set! deleted (cdr deleted))
(values base-path (build-path base-path (os-path (hash-ref r 'path))) r))
)
(let-values (((base-path path info) (fw)))
(if (eq? info #f)
(begin
(set! deleted (get-deleted))
(f))
(values base-path path info))
)
)
)
))
f))
)
(define (fw-add-filter fw filter-func)
(λ ()
(let-values (((base-path path info) (fw)))
(if (eq? info #f)
(values #f #f #f)
(filter-func base-path path info))))
)