module System.AtomicWrite.Internal where
import System.Directory (doesFileExist, renameFile)
import System.FilePath (takeDirectory)
import System.IO (Handle, hClose, hSetBinaryMode,
openTempFile,
openTempFileWithDefaultPermissions)
import System.Posix.Types (FileMode)
import System.PosixCompat.Files (fileMode, getFileStatus, setFileMode)
tempFileFor ::
FilePath
-> IO (FilePath, Handle)
tempFileFor targetFilePath =
doesFileExist targetFilePath >>=
tmpFile targetFilePath (takeDirectory targetFilePath) "atomic.write"
where
tmpFile :: FilePath -> FilePath -> String -> Bool -> IO (FilePath, Handle)
tmpFile targetPath workingDirectory template previousExisted =
if previousExisted then
openTempFile workingDirectory template >>=
\(tmpPath, handle) ->
getFileStatus targetPath >>= setFileMode tmpPath . fileMode >>
return (tmpPath, handle)
else
openTempFileWithDefaultPermissions workingDirectory template
closeAndRename :: Handle -> FilePath -> FilePath -> IO ()
closeAndRename tmpHandle tempFile destFile =
hClose tmpHandle >> renameFile tempFile destFile
maybeSetFileMode :: FilePath -> Maybe FileMode -> IO ()
maybeSetFileMode path =
maybe
( return () )
( \mode -> setFileMode path mode )
atomicWriteFileMaybeModeText ::
Maybe FileMode
-> FilePath
-> (Handle -> a -> IO ())
-> a
-> IO ()
atomicWriteFileMaybeModeText mmode path hF text =
tempFileFor path >>= \(tmpPath, h) -> hSetBinaryMode h False
>> hF h text
>> closeAndRename h tmpPath path
>> maybeSetFileMode path mmode
atomicWriteFileMaybeModeBinary ::
Maybe FileMode
-> FilePath
-> (Handle -> a -> IO ())
-> a
-> IO ()
atomicWriteFileMaybeModeBinary mmode path hF text =
tempFileFor path >>= \(tmpPath, h) -> hSetBinaryMode h True
>> hF h text
>> closeAndRename h tmpPath path
>> maybeSetFileMode path mmode