module Development.Shake.Derived(
system', systemCwd, systemOutput,
copyFile', copyFileChanged,
readFile', readFileLines,
writeFile', writeFileLines, writeFileChanged,
withTempFile, withTempDir,
getHashedShakeVersion
) where
import Control.Monad.Extra
import Control.Monad.IO.Class
import System.Process
import System.Directory
import System.Exit
import System.IO.Extra hiding (withTempFile, withTempDir, readFile')
import Development.Shake.Core
import Development.Shake.Rules.File
import Development.Shake.FilePath
import Development.Shake.Types
import qualified Data.ByteString as BS
import Data.Hashable
getHashedShakeVersion :: [FilePath] -> IO String
getHashedShakeVersion files = do
hashes <- mapM (fmap (hashWithSalt 0) . BS.readFile) files
return $ "hash-" ++ show (hashWithSalt 0 hashes)
checkExitCode :: String -> ExitCode -> Action ()
checkExitCode cmd ExitSuccess = return ()
checkExitCode cmd (ExitFailure i) = error $ "System command failed (code " ++ show i ++ "):\n" ++ cmd
system' :: FilePath -> [String] -> Action ()
system' path args = do
let path2 = toNative path
let cmd = unwords $ path2 : args
v <- getVerbosity
putLoud cmd
res <- (if v >= Loud then quietly else id) $ traced (takeBaseName path) $ rawSystem path2 args
checkExitCode cmd res
systemCwd :: FilePath -> FilePath -> [String] -> Action ()
systemCwd cwd path args = do
let path2 = toNative path
let cmd = unwords $ path2 : args
putLoud cmd
res <- traced (takeBaseName path) $ do
hdl <- runProcess path2 args (Just cwd) Nothing Nothing Nothing Nothing
waitForProcess hdl
checkExitCode cmd res
systemOutput :: FilePath -> [String] -> Action (String, String)
systemOutput path args = do
let path2 = toNative path
let cmd = unwords $ path2 : args
putLoud cmd
(res,stdout,stderr) <- traced (takeBaseName path) $ readProcessWithExitCode path2 args ""
checkExitCode cmd res
return (stdout, stderr)
copyFile' :: FilePath -> FilePath -> Action ()
copyFile' old new = do
need [old]
putLoud $ "Copying from " ++ old ++ " to " ++ new
liftIO $ copyFile old new
copyFileChanged :: FilePath -> FilePath -> Action ()
copyFileChanged old new = do
need [old]
eq <- liftIO $ doesFileExist new &&^ do
withBinaryFile old ReadMode $ \h1 -> withBinaryFile new ReadMode $ \h2 ->
liftM2 (==) (hFileSize h1) (hFileSize h2) &&^
liftM2 (==) (BS.hGetContents h1) (BS.hGetContents h2)
when (not eq) $ do
putLoud $ "Copying from " ++ old ++ " to " ++ new
liftIO $ copyFile old new
readFile' :: FilePath -> Action String
readFile' x = need [x] >> liftIO (readFile x)
writeFile' :: FilePath -> String -> Action ()
writeFile' name x = liftIO $ writeFile name x
readFileLines :: FilePath -> Action [String]
readFileLines = fmap lines . readFile'
writeFileLines :: FilePath -> [String] -> Action ()
writeFileLines name = writeFile' name . unlines
writeFileChanged :: FilePath -> String -> Action ()
writeFileChanged name x = liftIO $ do
b <- doesFileExist name
if not b then writeFile name x else do
b <- withFile name ReadMode $ \h -> do
src <- hGetContents h
return $! src /= x
when b $ writeFile name x
withTempFile :: (FilePath -> Action a) -> Action a
withTempFile act = do
(file, del) <- liftIO newTempFile
act file `actionFinally` del
withTempDir :: (FilePath -> Action a) -> Action a
withTempDir act = do
(dir,del) <- liftIO newTempDir
act dir `actionFinally` del