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

-- | Sync a file to disk
--
-- On Windows, this is a fake function.
syncFile :: FilePath -- ^ File to sync
            -> 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
    -- The code below will not work on Windows
    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

-- | Variation of 'withFile' for output files.
--
-- Output is written to a temporary file. Once the action has completed, this
-- file is then sync'ed to disk (see |syncFile|) and renamed to its final
-- destination. In Posix, this is an atomic operation. If an exception is
-- raised, then the temporary output file will be deleted and not saved to
-- disk. Thus, the result file will either contain the complete result or will
-- be empty.
withOutputFile :: (MonadMask m, MonadIO m) =>
            FilePath -- ^ Final desired file path
            -> (Handle -> m a) -- ^ action to execute
            -> 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