module System.IO.SafeWrite
( withOutputFile
, syncFile
, allocateTempFile
, finalizeTempFile
) where
import System.FilePath (takeDirectory, takeBaseName)
import Control.Monad.Catch (bracket, bracketOnError, MonadMask(..))
import Control.Monad.IO.Class (MonadIO(..))
import System.IO (Handle, hClose, openTempFile)
import System.Directory (renameFile, removeFile)
#ifndef WINDOWS
import System.Posix.IO (defaultFileFlags, closeFd, OpenMode(..))
import qualified System.Posix.IO
import qualified System.Posix.Types
import System.Posix.Unistd (fileSynchronise)
#endif
openFd :: FilePath -> OpenMode -> System.Posix.IO.OpenFileFlags -> IO System.Posix.Types.Fd
#if MIN_VERSION_base (4,18,0)
openFd = System.Posix.IO.openFd
#else
openFd :: FilePath -> OpenMode -> OpenFileFlags -> IO Fd
openFd FilePath
fname OpenMode
mode OpenFileFlags
flags = FilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
System.Posix.IO.openFd FilePath
fname OpenMode
mode forall a. Maybe a
Nothing OpenFileFlags
flags
#endif
syncFile :: FilePath
-> IO ()
#ifndef WINDOWS
syncFile :: FilePath -> IO ()
syncFile FilePath
fname = do
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (FilePath -> OpenMode -> OpenFileFlags -> IO Fd
openFd FilePath
fname OpenMode
ReadWrite OpenFileFlags
defaultFileFlags)
Fd -> IO ()
closeFd
Fd -> IO ()
fileSynchronise
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (FilePath -> OpenMode -> OpenFileFlags -> IO Fd
openFd (FilePath -> FilePath
takeDirectory FilePath
fname) OpenMode
ReadOnly OpenFileFlags
defaultFileFlags)
Fd -> IO ()
closeFd
Fd -> IO ()
fileSynchronise
#else
syncFile fname = return ()
#endif
withOutputFile :: (MonadMask m, MonadIO m) =>
FilePath
-> (Handle -> m a)
-> m a
withOutputFile :: forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
FilePath -> (Handle -> m a) -> m a
withOutputFile FilePath
finalname Handle -> m a
act =
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracketOnError
(forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO (FilePath, Handle)
allocateTempFile FilePath
finalname)
(forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool -> (FilePath, Handle) -> IO ()
finalizeTempFile FilePath
finalname Bool
False)
(\tdata :: (FilePath, Handle)
tdata@(FilePath
_, Handle
th) -> do
a
r <- Handle -> m a
act Handle
th
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> Bool -> (FilePath, Handle) -> IO ()
finalizeTempFile FilePath
finalname Bool
True (FilePath, Handle)
tdata
forall (m :: * -> *) a. Monad m => a -> m a
return a
r)
allocateTempFile :: FilePath -> IO (FilePath, Handle)
allocateTempFile :: FilePath -> IO (FilePath, Handle)
allocateTempFile FilePath
finalname = FilePath -> FilePath -> IO (FilePath, Handle)
openTempFile (FilePath -> FilePath
takeDirectory FilePath
finalname) (FilePath -> FilePath
takeBaseName FilePath
finalname)
finalizeTempFile :: FilePath -> Bool -> (FilePath, Handle) -> IO ()
finalizeTempFile :: FilePath -> Bool -> (FilePath, Handle) -> IO ()
finalizeTempFile FilePath
finalname Bool
ok (FilePath
tname, Handle
th)
| Bool
ok = do
Handle -> IO ()
hClose Handle
th
FilePath -> IO ()
syncFile FilePath
tname
FilePath -> FilePath -> IO ()
renameFile FilePath
tname FilePath
finalname
| Bool
otherwise = do
Handle -> IO ()
hClose Handle
th
FilePath -> IO ()
removeFile FilePath
tname