module Development.Shake.Derived(
system', systemCwd, systemOutput,
copyFile', copyFileChanged,
readFile', readFileLines,
writeFile', writeFileLines, writeFileChanged,
withTempFile, withTempDir,
getHashedShakeVersion,
par, forP
) where
import Control.Applicative
import Control.Exception.Extra
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
import Prelude
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 _ ExitSuccess = return ()
checkExitCode cmd (ExitFailure i) = liftIO $ errorIO $ "System command failed (code " ++ show i ++ "):\n" ++ cmd
{-# DEPRECATED system' "Use 'command' or 'cmd'" #-}
{-# DEPRECATED systemCwd "Use 'command' or 'cmd' with 'Cwd'" #-}
{-# DEPRECATED systemOutput "Use 'command' or 'cmd' with 'Stdout' or 'Stderr'" #-}
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]
unlessM (liftIO $ doesFileExist new &&^ fileEq old new) $ do
putLoud $ "Copying from " ++ old ++ " to " ++ new
liftIO $ copyFile old new
readFile' :: FilePath -> Action String
readFile' x = need [x] >> liftIO (readFile x)
writeFile' :: MonadIO m => FilePath -> String -> m ()
writeFile' name x = liftIO $ writeFile name x
readFileLines :: FilePath -> Action [String]
readFileLines = fmap lines . readFile'
writeFileLines :: MonadIO m => FilePath -> [String] -> m ()
writeFileLines name = writeFile' name . unlines
writeFileChanged :: MonadIO m => FilePath -> String -> m ()
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
forP :: [a] -> (a -> Action b) -> Action [b]
forP xs f = parallel $ map f xs
par :: Action a -> Action b -> Action (a,b)
par a b = do [Left a, Right b] <- parallel [Left <$> a, Right <$> b]; return (a,b)