{-# LANGUAGE CPP #-}
module System.IO.Cautious
( writeFile
, writeFileL
, writeFileWithBackup
, writeFileWithBackupL
) where
import Prelude hiding (writeFile)
import Control.Exception (tryJust)
import Control.Monad (guard)
import Data.ByteString.Lazy.Char8 (ByteString, pack)
import System.Directory (canonicalizePath, renameFile)
import System.FilePath (splitFileName)
import System.IO (openTempFile)
import System.IO.Error (isDoesNotExistError)
#ifdef _POSIX
import System.Posix.ByteLevel (writeAllL)
import System.Posix.Files (fileMode, getFileStatus, setFdMode)
import System.Posix.Fsync (fsync)
import System.Posix.IO (closeFd, handleToFd)
#else
import Data.ByteString.Lazy (hPut)
import System.IO (hClose)
#endif
writeFile :: FilePath -> String -> IO ()
writeFile :: FilePath -> FilePath -> IO ()
writeFile = IO () -> FilePath -> FilePath -> IO ()
writeFileWithBackup (IO () -> FilePath -> FilePath -> IO ())
-> IO () -> FilePath -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
writeFileL :: FilePath -> ByteString -> IO ()
writeFileL :: FilePath -> ByteString -> IO ()
writeFileL = IO () -> FilePath -> ByteString -> IO ()
writeFileWithBackupL (IO () -> FilePath -> ByteString -> IO ())
-> IO () -> FilePath -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
writeFileWithBackup :: IO () -> FilePath -> String -> IO ()
writeFileWithBackup :: IO () -> FilePath -> FilePath -> IO ()
writeFileWithBackup backup :: IO ()
backup fp :: FilePath
fp = IO () -> FilePath -> ByteString -> IO ()
writeFileWithBackupL IO ()
backup FilePath
fp (ByteString -> IO ())
-> (FilePath -> ByteString) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
pack
ignoreNotFound :: IO a -> IO (Either () a)
ignoreNotFound :: IO a -> IO (Either () a)
ignoreNotFound = (IOError -> Maybe ()) -> IO a -> IO (Either () a)
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isDoesNotExistError)
writeFileWithBackupL :: IO () -> FilePath -> ByteString -> IO ()
writeFileWithBackupL :: IO () -> FilePath -> ByteString -> IO ()
writeFileWithBackupL backup :: IO ()
backup fp :: FilePath
fp bs :: ByteString
bs = do
FilePath
cfp <- (() -> FilePath)
-> (FilePath -> FilePath) -> Either () FilePath -> FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> () -> FilePath
forall a b. a -> b -> a
const FilePath
fp) FilePath -> FilePath
forall a. a -> a
id (Either () FilePath -> FilePath)
-> IO (Either () FilePath) -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO FilePath -> IO (Either () FilePath)
forall a. IO a -> IO (Either () a)
ignoreNotFound (FilePath -> IO FilePath
canonicalizePath FilePath
fp)
(tempFP :: FilePath
tempFP, handle :: Handle
handle) <- (FilePath -> FilePath -> IO (FilePath, Handle))
-> (FilePath, FilePath) -> IO (FilePath, Handle)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> FilePath -> IO (FilePath, Handle)
openTempFile ((FilePath, FilePath) -> IO (FilePath, Handle))
-> (FilePath, FilePath) -> IO (FilePath, Handle)
forall a b. (a -> b) -> a -> b
$ FilePath -> (FilePath, FilePath)
splitFileName FilePath
cfp
#ifdef _POSIX
Fd
fd <- Handle -> IO Fd
handleToFd Handle
handle
Fd -> ByteString -> IO ()
writeAllL Fd
fd ByteString
bs
Either () ()
_ <- IO () -> IO (Either () ())
forall a. IO a -> IO (Either () a)
ignoreNotFound (IO () -> IO (Either () ())) -> IO () -> IO (Either () ())
forall a b. (a -> b) -> a -> b
$ Fd -> FileMode -> IO ()
setFdMode Fd
fd (FileMode -> IO ())
-> (FileStatus -> FileMode) -> FileStatus -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> FileMode
fileMode (FileStatus -> IO ()) -> IO FileStatus -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO FileStatus
getFileStatus FilePath
cfp
Fd -> IO ()
fsync Fd
fd
Fd -> IO ()
closeFd Fd
fd
#else
hPut handle bs
hClose handle
#endif
IO ()
backup
FilePath -> FilePath -> IO ()
renameFile FilePath
tempFP FilePath
cfp