{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances #-}
module System.FilePath.Manip (
Streamable(..)
, renameWith
, modifyWith
, modifyWithBackup
, modifyInPlace
) where
import Control.Exception
import Control.Monad (liftM)
import Data.Bits ((.&.))
import System.Directory (removeFile)
import System.IO (Handle, IOMode(..), hClose, openFile)
import System.PosixCompat.Files (fileMode, getFileStatus, rename, setFileMode)
import System.PosixCompat.Temp (mkstemp)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as L
import qualified System.IO as I
renameWith :: (FilePath -> FilePath)
-> FilePath
-> IO ()
renameWith :: (FilePath -> FilePath) -> FilePath -> IO ()
renameWith FilePath -> FilePath
f FilePath
path = FilePath -> FilePath -> IO ()
rename FilePath
path (FilePath -> FilePath
f FilePath
path)
class Streamable a where
readAll :: Handle -> IO a
writeAll :: Handle -> a -> IO ()
instance Streamable B.ByteString where
readAll :: Handle -> IO ByteString
readAll = Handle -> IO ByteString
B.hGetContents
writeAll :: Handle -> ByteString -> IO ()
writeAll = Handle -> ByteString -> IO ()
B.hPut
instance Streamable L.ByteString where
readAll :: Handle -> IO ByteString
readAll = Handle -> IO ByteString
L.hGetContents
writeAll :: Handle -> ByteString -> IO ()
writeAll = Handle -> ByteString -> IO ()
L.hPut
instance Streamable String where
readAll :: Handle -> IO FilePath
readAll = Handle -> IO FilePath
I.hGetContents
writeAll :: Handle -> FilePath -> IO ()
writeAll = Handle -> FilePath -> IO ()
I.hPutStr
modifyInPlace :: Streamable a => (a -> a)
-> FilePath
-> IO ()
modifyInPlace :: (a -> a) -> FilePath -> IO ()
modifyInPlace = (FilePath -> FilePath -> IO ()) -> (a -> a) -> FilePath -> IO ()
forall a.
Streamable a =>
(FilePath -> FilePath -> IO ()) -> (a -> a) -> FilePath -> IO ()
modifyWith ((FilePath -> FilePath -> IO ()) -> FilePath -> FilePath -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> FilePath -> IO ()
rename)
modifyWithBackup :: Streamable a =>
(FilePath -> FilePath)
-> (a -> a)
-> FilePath
-> IO ()
modifyWithBackup :: (FilePath -> FilePath) -> (a -> a) -> FilePath -> IO ()
modifyWithBackup FilePath -> FilePath
f = (FilePath -> FilePath -> IO ()) -> (a -> a) -> FilePath -> IO ()
forall a.
Streamable a =>
(FilePath -> FilePath -> IO ()) -> (a -> a) -> FilePath -> IO ()
modifyWith FilePath -> FilePath -> IO ()
backup
where backup :: FilePath -> FilePath -> IO ()
backup FilePath
path FilePath
tmpPath = (FilePath -> FilePath) -> FilePath -> IO ()
renameWith FilePath -> FilePath
f FilePath
path IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> FilePath -> IO ()
rename FilePath
tmpPath FilePath
path
modifyWith :: Streamable a =>
(FilePath -> FilePath -> IO ())
-> (a -> a)
-> FilePath
-> IO ()
modifyWith :: (FilePath -> FilePath -> IO ()) -> (a -> a) -> FilePath -> IO ()
modifyWith FilePath -> FilePath -> IO ()
after a -> a
transform FilePath
path =
IO Handle -> (Handle -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FilePath -> IOMode -> IO Handle
openFile FilePath
path IOMode
ReadMode) Handle -> IO ()
hClose ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
ih -> do
(FilePath
tmpPath, Handle
oh) <- FilePath -> IO (FilePath, Handle)
mkstemp (FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"XXXXXX")
let ignore :: IO ()
ignore = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
nukeTmp :: IO ()
nukeTmp = (IOException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
_::IOException) -> IO ()
ignore) (FilePath -> IO ()
removeFile FilePath
tmpPath)
(IOException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
e::IOException) -> IO ()
nukeTmp IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IOException -> IO ()
forall a e. Exception e => e -> a
throw IOException
e) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> IO () -> IO () -> IO ()
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ IO ()
ignore (Handle -> IO ()
hClose Handle
oh) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Handle -> IO a
forall a. Streamable a => Handle -> IO a
readAll Handle
ih IO a -> (a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> (a -> a) -> a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
transform IO a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> a -> IO ()
forall a. Streamable a => Handle -> a -> IO ()
writeAll Handle
oh
(IOException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
_::IOException) -> IO ()
nukeTmp) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
FileMode
mode <- FileStatus -> FileMode
fileMode (FileStatus -> FileMode) -> IO FileStatus -> IO FileMode
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FilePath -> IO FileStatus
getFileStatus FilePath
path
FilePath -> FileMode -> IO ()
setFileMode FilePath
tmpPath (FileMode
mode FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.&. FileMode
0777)
FilePath -> FilePath -> IO ()
after FilePath
path FilePath
tmpPath