{-# 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 (IO () -> FilePath -> FilePath -> IO ())
-> IO () -> FilePath -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
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 a. a -> IO a
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 (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 :: forall a. 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)

-- | 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
    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 a b. (a -> b) -> IO a -> IO b
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, handle) <- uncurry openTempFile $ splitFileName cfp
#ifdef _POSIX
    fd <- handleToFd handle
    writeAllL fd bs
    _ <- ignoreNotFound $ setFdMode fd . fileMode =<< getFileStatus cfp
    fsync fd
    closeFd fd
#else
    hPut handle bs
    hClose handle
#endif
    backup
    renameFile tempFP cfp