{-# LANGUAGE CPP #-}
-- | It is recommended to write
--
-- import Prelude hiding (writeFile)
--
-- when importing this module.
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 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

writeFileL :: FilePath -> ByteString -> IO ()
writeFileL :: FilePath -> ByteString -> IO ()
writeFileL = IO () -> FilePath -> ByteString -> IO ()
writeFileWithBackupL forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Backs up the old version of the file with "backup". "backup" must not fail if there is no
-- old version of the file.
writeFileWithBackup :: IO () -> FilePath -> String -> IO ()
writeFileWithBackup :: IO () -> FilePath -> FilePath -> IO ()
writeFileWithBackup IO ()
backup FilePath
fp = IO () -> FilePath -> ByteString -> IO ()
writeFileWithBackupL IO ()
backup FilePath
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
pack

ignoreNotFound :: IO a -> IO (Either () a)
ignoreNotFound :: forall a. IO a -> IO (Either () a)
ignoreNotFound = forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust (forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isDoesNotExistError)

-- | Backs up the old version of the file with "backup". "backup" must not fail if there is no
-- old version of the file.
writeFileWithBackupL :: IO () -> FilePath -> ByteString -> IO ()
writeFileWithBackupL :: IO () -> FilePath -> ByteString -> IO ()
writeFileWithBackupL IO ()
backup FilePath
fp ByteString
bs = do
    FilePath
cfp <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const FilePath
fp) forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. IO a -> IO (Either () a)
ignoreNotFound (FilePath -> IO FilePath
canonicalizePath FilePath
fp)
    (FilePath
tempFP, Handle
handle) <- forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> FilePath -> IO (FilePath, Handle)
openTempFile 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 () ()
_ <- forall a. IO a -> IO (Either () a)
ignoreNotFound forall a b. (a -> b) -> a -> b
$ Fd -> FileMode -> IO ()
setFdMode Fd
fd forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> FileMode
fileMode 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