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 :: FilePath -> IO (FilePath, Handle)
tempFileFor FilePath
targetFilePath =
FilePath -> IO Bool
doesFileExist FilePath
targetFilePath IO Bool -> (Bool -> IO (FilePath, Handle)) -> IO (FilePath, Handle)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
FilePath -> FilePath -> FilePath -> Bool -> IO (FilePath, Handle)
tmpFile FilePath
targetFilePath (FilePath -> FilePath
takeDirectory FilePath
targetFilePath) FilePath
"atomic.write"
where
tmpFile :: FilePath -> FilePath -> String -> Bool -> IO (FilePath, Handle)
tmpFile :: FilePath -> FilePath -> FilePath -> Bool -> IO (FilePath, Handle)
tmpFile FilePath
targetPath FilePath
workingDirectory FilePath
template Bool
previousExisted =
if Bool
previousExisted then
FilePath -> FilePath -> IO (FilePath, Handle)
openTempFile FilePath
workingDirectory FilePath
template IO (FilePath, Handle)
-> ((FilePath, Handle) -> IO (FilePath, Handle))
-> IO (FilePath, Handle)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
\(FilePath
tmpPath, Handle
handle) ->
FilePath -> IO FileStatus
getFileStatus FilePath
targetPath IO FileStatus -> (FileStatus -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> FileMode -> IO ()
setFileMode FilePath
tmpPath (FileMode -> IO ())
-> (FileStatus -> FileMode) -> FileStatus -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> FileMode
fileMode IO () -> IO (FilePath, Handle) -> IO (FilePath, Handle)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
(FilePath, Handle) -> IO (FilePath, Handle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
tmpPath, Handle
handle)
else
FilePath -> FilePath -> IO (FilePath, Handle)
openTempFileWithDefaultPermissions FilePath
workingDirectory FilePath
template
closeAndRename :: Handle -> FilePath -> FilePath -> IO ()
closeAndRename :: Handle -> FilePath -> FilePath -> IO ()
closeAndRename Handle
tmpHandle FilePath
tempFile FilePath
destFile =
Handle -> IO ()
hClose Handle
tmpHandle IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> FilePath -> IO ()
renameFile FilePath
tempFile FilePath
destFile
maybeSetFileMode :: FilePath -> Maybe FileMode -> IO ()
maybeSetFileMode :: FilePath -> Maybe FileMode -> IO ()
maybeSetFileMode FilePath
path =
IO () -> (FileMode -> IO ()) -> Maybe FileMode -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
( () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () )
( \FileMode
mode -> FilePath -> FileMode -> IO ()
setFileMode FilePath
path FileMode
mode )
atomicWriteFileMaybeModeText ::
Maybe FileMode
-> FilePath
-> (Handle -> a -> IO ())
-> a
-> IO ()
atomicWriteFileMaybeModeText :: forall a.
Maybe FileMode -> FilePath -> (Handle -> a -> IO ()) -> a -> IO ()
atomicWriteFileMaybeModeText Maybe FileMode
mmode FilePath
path Handle -> a -> IO ()
hF a
text =
FilePath -> IO (FilePath, Handle)
tempFileFor FilePath
path IO (FilePath, Handle) -> ((FilePath, Handle) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(FilePath
tmpPath, Handle
h) -> Handle -> Bool -> IO ()
hSetBinaryMode Handle
h Bool
False
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> a -> IO ()
hF Handle
h a
text
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> FilePath -> FilePath -> IO ()
closeAndRename Handle
h FilePath
tmpPath FilePath
path
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> Maybe FileMode -> IO ()
maybeSetFileMode FilePath
path Maybe FileMode
mmode
atomicWriteFileMaybeModeBinary ::
Maybe FileMode
-> FilePath
-> (Handle -> a -> IO ())
-> a
-> IO ()
atomicWriteFileMaybeModeBinary :: forall a.
Maybe FileMode -> FilePath -> (Handle -> a -> IO ()) -> a -> IO ()
atomicWriteFileMaybeModeBinary Maybe FileMode
mmode FilePath
path Handle -> a -> IO ()
hF a
text =
FilePath -> IO (FilePath, Handle)
tempFileFor FilePath
path IO (FilePath, Handle) -> ((FilePath, Handle) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(FilePath
tmpPath, Handle
h) -> Handle -> Bool -> IO ()
hSetBinaryMode Handle
h Bool
True
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> a -> IO ()
hF Handle
h a
text
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> FilePath -> FilePath -> IO ()
closeAndRename Handle
h FilePath
tmpPath FilePath
path
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> Maybe FileMode -> IO ()
maybeSetFileMode FilePath
path Maybe FileMode
mmode