#lang scheme/base
(require (planet bzlib/base)
(planet bzlib/port/port)
"path.ss"
"base.ss"
"file.ss"
scheme/file
(planet bzlib/os)
)
(define (open-output-atomic-file path)
(let* ((temp (make-temporary-file ".gzlib-temp.~a" #f (parent-path path)))
(out (open-output-file temp #:exists 'replace)))
(make-output-port path
always-evt
(lambda (bytes-out start end block? break?)
(if (= start end)
(flush-output out)
(write-bytes bytes-out out start end)))
(lambda ()
(begin0 (close-output-port out)
(+:windows (rename-file temp path) (rename temp path #t))
)))))
(define call-with-output-atomic-file
(make-call-with-output-port open-output-atomic-file path))
(provide/contract
(open-output-atomic-file (-> path-string? output-port?))
(call-with-output-atomic-file
(-> path-string? (-> output-port? any) any))
)