#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FILE.plt - file, path, and atomic file operation utilities 
;;
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; file.ss - provides retry semantics for file operations
;; yc 9/21/2009 - first version
(require (planet bzlib/base)
         "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))

;; this rename version is only necessary in windows...
;; in windows it is not possible to guarantee atomic rename... so the question is... what can we do?
;; we can retry multiple times (similar to how tcp works)...
;; and we can also build on top of a transactional filesystem (which can be quite elaborate in windows).
(define (rename-file from to)
  (do-it/retry (lambda ()
                       (rename-file-or-directory from to #t))
               3))

;; this is not a save call in windows for general usage, but works in CAS situation, assuming that
;; the CAS files are never tempered with.
(define (rename-file/ok from to)
  (with-handlers ((exn:fail:filesystem? 
                   ;; the only time we'll encounter this error is in Windows where the file is open for access...
                   ;; on Linux & Macs it'll be okay.
                   ;; but the broader assumption is that the file itself is never tempered with...
                   (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)) 
 )