module ProjectM36.Persist (writeFileSync,
writeBSFileSync,
renameSync,
DiskSync(..)) where
import qualified Data.Text.IO as TIO
import Data.Text
#if defined(mingw32_HOST_OS)
import qualified System.Win32 as Win32
#else
import qualified System.Posix as Posix
#if defined(linux_HOST_OS)
import System.Posix.Unistd (fileSynchroniseDataOnly)
#else
import System.Posix.Unistd (fileSynchronise)
#endif
import System.Posix.IO (handleToFd)
import Foreign.C
#endif
import System.IO (withFile, IOMode(WriteMode), Handle)
import qualified Data.ByteString.Lazy as BS
#if defined(mingw32_HOST_OS)
import ProjectM36.Win32Handle
#else
foreign import ccall unsafe "cDirectoryFsync" cHSDirectoryFsync :: CString -> IO CInt
#endif
data DiskSync = NoDiskSync | FsyncDiskSync
writeFileSync :: DiskSync -> FilePath -> Text -> IO()
writeFileSync sync path strOut = withFile path WriteMode handler
where
handler handle = do
TIO.hPutStr handle strOut
syncHandle sync handle
renameSync :: DiskSync -> FilePath -> FilePath -> IO ()
renameSync sync srcPath dstPath = do
atomicRename srcPath dstPath
syncDirectory sync dstPath
atomicRename :: FilePath -> FilePath -> IO ()
atomicRename srcPath dstPath = do
#if defined(mingw32_HOST_OS)
Win32.moveFileEx srcPath dstPath Win32.mOVEFILE_REPLACE_EXISTING
#else
Posix.rename srcPath dstPath
#endif
syncHandle :: DiskSync -> Handle -> IO ()
syncHandle FsyncDiskSync handle = do
#if defined(mingw32_HOST_OS)
withHandleToHANDLE handle (\h -> Win32.flushFileBuffers h)
#elif defined(linux_HOST_OS)
handleToFd handle >>= fileSynchroniseDataOnly
#else
handleToFd handle >>= fileSynchronise
#endif
syncHandle NoDiskSync _ = pure ()
syncDirectory :: DiskSync -> FilePath -> IO ()
syncDirectory FsyncDiskSync path = directoryFsync path
syncDirectory NoDiskSync _ = pure ()
writeBSFileSync :: DiskSync -> FilePath -> BS.ByteString -> IO ()
writeBSFileSync sync path bstring = do
withFile path WriteMode $ \handle -> do
BS.hPut handle bstring
syncHandle sync handle
directoryFsync :: FilePath -> IO ()
#if defined(mingw32_HOST_OS)
directoryFsync _ = pure ()
#else
directoryFsync path = throwErrnoIfMinus1Retry_ "directoryFsync" (withCString path $ \cpath -> cHSDirectoryFsync cpath)
#endif