#lang scheme/base
(require "depend.ss"
"base.ss"
)
(define (do-it/retry thunk (skips 3) (interval 0.1))
(define (skip++ skip)
(+ interval skip))
(define (helper exn skip count)
(cond ((> count skips)
(raise exn))
(else
(do-it (skip++ skip) (add1 count)))))
(define (do-it skip count)
(sleep skip)
(with-handlers ((exn:fail:filesystem?
(lambda (e)
(helper e skip count))))
(thunk)))
(do-it 0 0))
(define (rename-file from to)
(do-it/retry (lambda ()
(rename-file-or-directory from to #t))
3))
(define (rename-file/ok from to)
(with-handlers ((exn:fail:filesystem?
(lambda (e)
(display (format "file ~a: ~a" to (exn-message e)) (current-error-port)))))
(rename-file-or-directory from to #t)))
(define (delete-file! path)
(do-it/retry (lambda ()
(delete-file path))
3))
(define (delete-directory! path)
(do-it/retry (lambda ()
(delete-directory path))
3))
(define (delete-directory/files! path)
(do-it/retry (lambda ()
(delete-directory/files path))
3))
(provide/contract
(rename-file (-> path-string? path-string? any))
(rename-file/ok (-> path-string? path-string? any))
(delete-file! (-> path-string? any))
(delete-directory! (-> path-string? any))
(delete-directory/files! (-> path-string? any))
)