{-# 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 = forall a.
Streamable a =>
(FilePath -> FilePath -> IO ()) -> (a -> a) -> FilePath -> IO ()
modifyWith (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 = 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 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 =
    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 forall a b. (a -> b) -> a -> b
$ \Handle
ih -> do
        (FilePath
tmpPath, Handle
oh) <- FilePath -> IO (FilePath, Handle)
mkstemp (FilePath
path forall a. [a] -> [a] -> [a]
++ FilePath
"XXXXXX")
        let ignore :: IO ()
ignore = forall (m :: * -> *) a. Monad m => a -> m a
return ()
            nukeTmp :: IO ()
nukeTmp = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
_::IOException) -> IO ()
ignore) (FilePath -> IO ()
removeFile FilePath
tmpPath)
        forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
e::IOException) -> IO ()
nukeTmp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a e. Exception e => e -> a
throw IOException
e) forall a b. (a -> b) -> a -> b
$ do
            forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ IO ()
ignore (Handle -> IO ()
hClose Handle
oh) forall a b. (a -> b) -> a -> b
$
                forall a. Streamable a => Handle -> IO a
readAll Handle
ih forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
transform forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Streamable a => Handle -> a -> IO ()
writeAll Handle
oh
            forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
_::IOException) -> IO ()
nukeTmp) forall a b. (a -> b) -> a -> b
$ do
                FileMode
mode <- FileStatus -> FileMode
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 forall a. Bits a => a -> a -> a
.&. FileMode
0777)
                FilePath -> FilePath -> IO ()
after FilePath
path FilePath
tmpPath