{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances #-}

-- |
-- Module:      System.FilePath.Manip
-- Copyright:   Bryan O'Sullivan
-- License:     BSD3
-- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>
-- Stability:   unstable
-- Portability: Unix-like systems (requires flexible instances)

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

-- | Use a renaming function to generate a new name for a file, then
-- rename it.
renameWith :: (FilePath -> FilePath) -- ^ function to rename with
           -> FilePath -- ^ file to rename
           -> IO ()

renameWith :: (FilePath -> FilePath) -> FilePath -> IO ()
renameWith FilePath -> FilePath
f FilePath
path = FilePath -> FilePath -> IO ()
rename FilePath
path (FilePath -> FilePath
f FilePath
path)

-- | Type class for string manipulation over files.
class Streamable a where
    -- | Read the entire contents of a 'Handle'.
    readAll :: Handle -> IO a
    -- | Write an entire string to a 'Handle'.
    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

-- | Modify a file in place using the given function.  This is
-- performed by writing to a temporary file, then renaming it on top of
-- the existing file when done.
modifyInPlace :: Streamable a => (a -> a) -- ^ transformation function
              -> FilePath -- ^ name of file to modify
              -> IO ()

modifyInPlace :: forall a. Streamable a => (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)

-- | Modify a file in place using the given function.  The original
-- copy of the file is saved under a new name.  This is performed by
-- writing to a temporary file; renaming the original file to its new
-- name; then renaming the temporary file to the original name.
--
-- Example:
--
-- @
--     -- save original file with a \".bak\" extension
--     'modifyWithBackup' (\<.\> \"bak\")
-- @ 
modifyWithBackup :: Streamable a =>
                    (FilePath -> FilePath) -- ^ chooses new name for original file
                 -> (a -> a) -- ^ transformation function
                 -> FilePath -- ^ name of file to modify
                 -> IO ()

modifyWithBackup :: forall a.
Streamable a =>
(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 a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> FilePath -> IO ()
rename FilePath
tmpPath FilePath
path

-- | Modify a file in place using the given function.  The new content
-- is written to a temporary file.  Once this is complete, the file
-- manipulation action is called.  Its arguments are the names of the
-- original and temporary files.
--
-- Example:
--
-- @
--     'modifyInPlace' = 'modifyWith' (flip rename)
-- @ 
modifyWith :: Streamable a =>
                (FilePath -> FilePath -> IO ()) -- ^ file manipulation action
             -> (a -> a) -- ^ transformation function
             -> FilePath
             -> IO ()

modifyWith :: forall a.
Streamable a =>
(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 a. a -> IO a
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 a b. IO a -> IO b -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO a
forall a. 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 a b. IO a -> (a -> IO b) -> IO b
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