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

Handle renames

Browse Source
This commit is contained in:
Hans Dijkema
2026-07-01 13:36:11 +02:00
parent 800392541e
commit 84680e8e6e
1 changed files with 68 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files
private/file-walker.rkt
+25 -7
View File
@@ -19,14 +19,19 @@
(let ((delim (if (eq? (system-path-convention-type) 'windows) "\\" "/"))) (let ((delim (if (eq? (system-path-convention-type) 'windows) "\\" "/")))
(string-replace str "/" delim))) (string-replace str "/" delim)))
(define (make-file-walker base-path glob-pattern filter-func (define (make-next-gen base-path glob-pattern)
#:filename-cleaner [filename-cleaner-func (λ (f) f)]) (sequence->generator
(let* ((gen (sequence->generator
(sequence-filter (sequence-filter
(λ (p) (λ (p)
(let ((basename (file-name-from-path p))) (let ((basename (file-name-from-path p)))
(glob-match? glob-pattern basename))) (glob-match? glob-pattern basename)))
(in-directory base-path)))) (in-directory base-path))))
(define (make-file-walker base-path glob-pattern filter-func
#:filename-cleaner [filename-cleaner-func (λ (f) f)])
(let* ((gen (make-next-gen base-path glob-pattern))
(next-gens '())
(str-base-path* (format "~a" (normalize-path base-path))) (str-base-path* (format "~a" (normalize-path base-path)))
(delim (if (eq? (system-path-convention-type) 'windows) "\\" "/")) (delim (if (eq? (system-path-convention-type) 'windows) "\\" "/"))
(str-base-path (if (string-suffix? str-base-path* delim) (str-base-path (if (string-suffix? str-base-path* delim)
@@ -35,10 +40,17 @@
(base-path-len (string-length str-base-path)) (base-path-len (string-length str-base-path))
(result #f) (result #f)
) )
(letrec ((walker-func
(λ () (λ ()
(let ((path (gen))) (let ((path (gen)))
(if (void? path) (if (void? path)
(if (null? next-gens)
(values #f #f #f) (values #f #f #f)
(let ((n (car next-gens)))
(set! gen (cadr n))
(info-am "Walking ~a..." (car n))
(set! next-gens (cdr next-gens))
(walker-func)))
(let* ((bd (basedir path)) (let* ((bd (basedir path))
(bn (format "~a" (basename path))) (bn (format "~a" (basename path)))
(nbn (filename-cleaner-func (clean-os-basename bn))) (nbn (filename-cleaner-func (clean-os-basename bn)))
@@ -51,6 +63,12 @@
(rename-file-or-directory (build-path bd bn) (rename-file-or-directory (build-path bd bn)
(build-path bd nbn) #f) (build-path bd nbn) #f)
(set! path (build-path bd nbn)) (set! path (build-path bd nbn))
(when (directory-exists? path)
(info-am "Adding directory ~a to next gens" nbn)
(set! next-gens (cons (list
nbn
(make-next-gen path glob-pattern))
next-gens)))
)) ))
(let* ((str-path (path->string path)) (let* ((str-path (path->string path))
@@ -76,11 +94,11 @@
) )
h)) h))
) )
(filter-func base-path path info)))) (filter-func base-path path info)))
) )))))
) walker-func
)
) )
))
(define (make-file-admin base-path db-store #:filename-cleaner [fc-f (λ (f) f)]) (define (make-file-admin base-path db-store #:filename-cleaner [fc-f (λ (f) f)])