1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
module Development.Shake.Derived(
system', systemCwd, systemOutput,
copyFile',
readFile', readFileLines,
writeFile', writeFileLines, writeFileChanged
) where
import Control.Monad
import Control.Monad.IO.Class
import System.Process
import System.Directory
import System.Exit
import System.IO
import Development.Shake.Core
import Development.Shake.Rules.File
import Development.Shake.FilePath
import Development.Shake.Types
checkExitCode :: String -> ExitCode -> Action ()
checkExitCode cmd ExitSuccess = return ()
checkExitCode cmd (ExitFailure i) = error $ "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'" #-}
-- | /Deprecated:/ Please use 'command' or 'cmd' instead.
-- This function will be removed in a future version.
--
-- Execute a system command. This function will raise an error if the exit code is non-zero.
-- Before running 'system'' make sure you 'need' any required files.
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
-- | /Deprecated:/ Please use 'command' or 'cmd' instead, with 'Cwd'.
-- This function will be removed in a future version.
--
-- Execute a system command with a specified current working directory (first argument).
-- This function will raise an error if the exit code is non-zero.
-- Before running 'systemCwd' make sure you 'need' any required files.
--
-- @
-- 'systemCwd' \"\/usr\/MyDirectory\" \"pwd\" []
-- @
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
-- FIXME: Should I be using the non-exported System.Process.syncProcess?
-- That installs/removes signal handlers.
hdl <- runProcess path2 args (Just cwd) Nothing Nothing Nothing Nothing
waitForProcess hdl
checkExitCode cmd res
-- | /Deprecated:/ Please use 'command' or 'cmd' instead, with 'Stdout' or 'Stderr'.
-- This function will be removed in a future version.
--
-- Execute a system command, returning @(stdout,stderr)@.
-- This function will raise an error if the exit code is non-zero.
-- Before running 'systemOutput' make sure you 'need' any required files.
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' old new@ copies the existing file from @old@ to @new@.
-- The @old@ file will be tracked as a dependency.
copyFile' :: FilePath -> FilePath -> Action ()
copyFile' old new = do
need [old]
putLoud $ "Copying from " ++ old ++ " to " ++ new
liftIO $ copyFile old new
-- | Read a file, after calling 'need'. The argument file will be tracked as a dependency.
readFile' :: FilePath -> Action String
readFile' x = need [x] >> liftIO (readFile x)
-- | Write a file, lifted to the 'Action' monad.
writeFile' :: FilePath -> String -> Action ()
writeFile' name x = liftIO $ writeFile name x
-- | A version of 'readFile'' which also splits the result into lines.
-- The argument file will be tracked as a dependency.
readFileLines :: FilePath -> Action [String]
readFileLines = fmap lines . readFile'
-- | A version of 'writeFile'' which writes out a list of lines.
writeFileLines :: FilePath -> [String] -> Action ()
writeFileLines name = writeFile' name . unlines
-- | Write a file, but only if the contents would change.
writeFileChanged :: FilePath -> String -> Action ()
writeFileChanged name x = liftIO $ do
b <- doesFileExist name
if not b then writeFile name x else do
-- Cannot use ByteString here, since it has different line handling
-- semantics on Windows
b <- withFile name ReadMode $ \h -> do
src <- hGetContents h
return $! src /= x
when b $ writeFile name x
|
