module Language.Haskell.Modules.Util.DryIO
( MonadDryRun(..)
, dryIO
, dryIO'
, tildeBackup
, noBackup
, readFileMaybe
, replaceFile
, replaceFileIfDifferent
, removeFileIfPresent
, createDirectoryIfMissing
, writeFile
) where
import Control.Applicative ((<$>))
import Control.Exception (catch, throw)
import Control.Monad.Trans (liftIO, MonadIO)
import Prelude hiding (writeFile)
import System.Directory (removeFile, renameFile)
import qualified System.Directory as IO (createDirectoryIfMissing)
import qualified System.IO as IO (writeFile)
import System.IO.Error (isDoesNotExistError)
tildeBackup :: FilePath -> Maybe FilePath
tildeBackup = Just . (++ "~")
noBackup :: FilePath -> Maybe FilePath
noBackup = const Nothing
readFileMaybe :: FilePath -> IO (Maybe String)
readFileMaybe path = (Just <$> readFile path) `catch` (\ (e :: IOError) -> if isDoesNotExistError e then return Nothing else throw e)
removeFileIfPresent :: MonadDryRun m => FilePath -> m ()
removeFileIfPresent path = dryIO' (putStrLn $ "dry run: removeFileIfPresent " ++ path) (removeFile path `catch` (\ (e :: IOError) -> if isDoesNotExistError e then return () else throw e))
replaceFileIfDifferent :: MonadDryRun m => FilePath -> String -> m Bool
replaceFileIfDifferent path newText =
do oldText <- liftIO $ readFileMaybe path
if oldText == Just newText then return False else replaceFile tildeBackup path newText >> return True
replaceFile :: MonadDryRun m => (FilePath -> Maybe FilePath) -> FilePath -> String -> m ()
replaceFile backup path text =
dryIO' (putStrLn $ "dry run: replaceFile " ++ path) (remove >> rename >> write)
where
remove = maybe (return ()) removeFile (backup path) `catch` (\ (e :: IOError) -> if isDoesNotExistError e then return () else throw e)
rename = maybe (return ()) (renameFile path) (backup path) `catch` (\ (e :: IOError) -> if isDoesNotExistError e then return () else throw e)
write = IO.writeFile path text
createDirectoryIfMissing :: MonadDryRun m => Bool -> String -> m ()
createDirectoryIfMissing flag path =
dryIO' (putStrLn $ "dry run: createDirectoryIfMissing " ++ show flag ++ " " ++ path) (IO.createDirectoryIfMissing flag path)
writeFile :: MonadDryRun m => FilePath -> String -> m ()
writeFile path text =
dryIO' (putStrLn $ "dry run: writeFIle " ++ path) (IO.writeFile path text)
class MonadIO m => MonadDryRun m where
dry :: m Bool
putDry :: Bool -> m ()
dryIO :: MonadDryRun m => IO () -> m ()
dryIO action = dryIO' (return ()) action
dryIO' :: MonadDryRun m => IO a -> IO a -> m a
dryIO' d action =
do flag <- dry
if flag then liftIO d else liftIO action