diff --git a/CHANGES.txt b/CHANGES.txt
--- a/CHANGES.txt
+++ b/CHANGES.txt
@@ -1,5 +1,16 @@
Changelog for Shake
+0.15.1
+ If you have Shakefile.hs, pass it all arguments without interp
+ Add shakeArgsPrune and shakeArgsPruneWith
+ #228, allow running cmd async by collecting the ProcessHandle
+ Make getShakeOptions/processorCount of 0 return the used value
+ #212, document how to get a full terminal with cmd
+ #225, warn if there are no want/action statements
+ #232, don't ignore phony order-only dependencies in Ninja
+ #226, add escaping for GraphViz labels
+ #227, add StdinBS for passing a bytestring as Stdin
+ Make cmd Timeout call terminateProcess as well
0.15
#203, make shakeFiles a directory rather than a file prefix
#220, add getHashedShakeVersion helper
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,6 +1,6 @@
# Shake [](https://hackage.haskell.org/package/shake) [](https://travis-ci.org/ndmitchell/shake)
-Shake is a tool for writing build systems - an alternative to make, Scons, Ant etc. Shake has been used commercially for over five years, running thousands of builds per day.
+Shake is a tool for writing build systems - an alternative to make, Scons, Ant etc. Shake has been used commercially for over five years, running thousands of builds per day. The website for Shake users is at [shakebuild.com](http://shakebuild.com).
#### Documentation
@@ -22,18 +22,4 @@
* [Source code](http://github.com/ndmitchell/shake) in a git repo, stored at GitHub.
* Continuous integration with [Travis](https://travis-ci.org/ndmitchell/shake) and [Hydra](http://hydra.cryp.to/jobset/shake/master).
-#### Companies using Shake
-
-* [Standard Chartered](http://www.standardchartered.com/) have been using Shake since 2009, as described in the section 6 of the [academic paper](http://community.haskell.org/~ndm/downloads/paper-shake_before_building-10_sep_2012.pdf).
-* [factis research GmbH](http://www.factisresearch.com/), as described in their [blog post](http://funktionale-programmierung.de/2014/01/16/build-system-haskell.html).
-* [Samplecount](http://samplecount.com/) have been using Shake since 2012, as mentioned in their [tweet](https://twitter.com/samplecount/status/491581551730511872).
-* [CovenantEyes](http://samplecount.com/) use Shake to build their Windows client, as mentioned in their [tweet](https://twitter.com/eacameron88/status/543219899599163392).
-* At least 10 other companies are using Shake internally.
-
-Is your company using Shake? Write something public (even just a [tweet to `@ndm_haskell`](https://twitter.com/ndm_haskell)) and I'll include a link.
-
-#### Projects using Shake
-
-* [Kansas Lava build rules](https://github.com/gergoerdi/kansas-lava-shake).
-* [shake-language-c](http://hackage.haskell.org/package/shake-language-c) is a small library on top of Shake that allows cross-compiling C, C++ and Objective-C code to various target platforms.
-* [shake-cabal-build](http://hackage.haskell.org/package/shake-cabal-build) is a small script that uses Cabal sandboxes for initialising and updating build systems based on Shake.
+Is your company using Shake? Write something public (even just a [tweet to `@ndm_haskell`](https://twitter.com/ndm_haskell)) and I'll include a link at [on the website](http://shakebuild.com/#who-uses-shake).
diff --git a/docs/Manual.md b/docs/Manual.md
--- a/docs/Manual.md
+++ b/docs/Manual.md
@@ -38,7 +38,7 @@
1. Install the [Haskell Platform](http://www.haskell.org/platform/), which provides a Haskell compiler and standard libraries.
2. Type `cabal update`, to download information about the latest versions of all Haskell packages.
3. Type `cabal install shake`, to build and install Shake and all its dependencies.
-4. Type `shake --demo`, which will create a directory containing a sample project, the above Shake script, and execute it. For more details see a [trace of `shake --demo`](Demo.md).
+4. Type `shake --demo`, which will create a directory containing a sample project, the above Shake script (named `Build.hs`), and execute it (which can be done by `runhaskell Build.hs`). For more details see a [trace of `shake --demo`](Demo.md).
## Basic syntax
@@ -264,7 +264,7 @@
putNormal "Cleaning files in _build"
removeFilesAfter "_build" ["//*"]
-Running the build system with the `clean` argument, e.g. `runhaskell _build/run clean` will remove all files under the `_build` directory. This clean command is formed from two separate pieces. Firstly, we can define `phony` commands as:
+Running the build system with the `clean` argument, e.g. `runhaskell Build.hs clean` will remove all files under the `_build` directory. This clean command is formed from two separate pieces. Firstly, we can define `phony` commands as:
phony "name" $ do
@@ -273,7 +273,7 @@
Where name is the name used on the command line to invoke the actions, and actions are the list of things to do in response. These names are not dependency tracked and are simply run afresh each time they are requested.
-The actions can be any standard build actions, although for a `clean` rule, `removeFilesAfter` is typical. This function waits until after any files have finished building (which will be none, if you do `runhaskell _build/run clean`) then deletes all files matching `//*` in the `_build` directory. The `putNormal` function writes out a message to the console, as long as `--quiet` was not passed.
+The actions can be any standard build actions, although for a `clean` rule, `removeFilesAfter` is typical. This function waits until after any files have finished building (which will be none, if you do `runhaskell Build.hs clean`) then deletes all files matching `//*` in the `_build` directory. The `putNormal` function writes out a message to the console, as long as `--quiet` was not passed.
## Running
@@ -281,7 +281,7 @@
#### Compiling the build system
-As shown before, we can use `runhaskell _build/run` to execute our build system, but doing so causes the build script to be compiled afresh each time. A more common approach is to add a shell script that compiles the build system and runs it. In the example directory you will find `build.sh` (Linux) and `build.bat` (Windows), both of which execute the same interesting commands. Looking at `build.sh`:
+As shown before, we can use `runhaskell Build.hs` to execute our build system, but doing so causes the build script to be compiled afresh each time. A more common approach is to add a shell script that compiles the build system and runs it. In the example directory you will find `build.sh` (Linux) and `build.bat` (Windows), both of which execute the same interesting commands. Looking at `build.sh`:
#!/bin/sh
mkdir -p _shake
diff --git a/html/shake-progress.js b/html/shake-progress.js
--- a/html/shake-progress.js
+++ b/html/shake-progress.js
@@ -14,7 +14,7 @@
// }
$(function(){
- $(".version").html("Generated by Shake " + version + ".");
+ $(".version").html("Generated by Shake " + version + ".");
$("#output").html("");
for (var i = 0; i < shake.length; i++)
{
diff --git a/html/shake-ui.js b/html/shake-ui.js
--- a/html/shake-ui.js
+++ b/html/shake-ui.js
@@ -204,7 +204,7 @@
for (var i = 0; i < res.length; i++)
s += "" + res[i] + "";
s += "";
- s += "Generated by Shake " + version + ".
";
+ s += "Generated by Shake " + version + ".
";
$("#output").html(s);
break;
@@ -260,7 +260,7 @@
res += "edge[penwidth=0.5,arrowsize=0.5];";
for (var i = 0; i < xs.length; i++)
{
- res += "a" + i + "[label=\"" + xs[i].name + "\"";
+ res += "a" + i + "[label=\"" + xs[i].name.split("\\").join("\\\\").split("\"").join("\\\"") + "\"";
if (xs[i].back) res += ",style=filled,color=\"" + xs[i].back + "\"";
if (xs[i].text) res += ",fontcolor=\"" + xs[i].text + "\"";
res += "];";
diff --git a/shake.cabal b/shake.cabal
--- a/shake.cabal
+++ b/shake.cabal
@@ -1,7 +1,7 @@
cabal-version: >= 1.10
build-type: Simple
name: shake
-version: 0.15
+version: 0.15.1
license: BSD3
license-file: LICENSE
category: Development, Shake
@@ -15,7 +15,7 @@
including an example. Further examples are included in the Cabal tarball,
under the @Examples@ directory. The homepage contains links to a user
manual, an academic paper and further information:
-
+
.
To use Shake the user writes a Haskell program
that imports "Development.Shake", defines some build rules, and calls
@@ -29,7 +29,7 @@
Shake also provides more accurate dependency tracking, including seamless
support for generated files, and dependencies on system information
(e.g. compiler version).
-homepage: http://www.shakebuild.com/
+homepage: http://shakebuild.com
bug-reports: https://github.com/ndmitchell/shake/issues
tested-with: GHC==7.10.1, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2
extra-source-files:
diff --git a/src/Development/Ninja/Parse.hs b/src/Development/Ninja/Parse.hs
--- a/src/Development/Ninja/Parse.hs
+++ b/src/Development/Ninja/Parse.hs
@@ -35,7 +35,7 @@
let (normal,implicit,orderOnly) = splitDeps deps
let build = Build rule env normal implicit orderOnly binds
return $
- if rule == BS.pack "phony" then ninja{phonys = [(x, normal) | x <- outputs] ++ phonys}
+ if rule == BS.pack "phony" then ninja{phonys = [(x, normal ++ implicit ++ orderOnly) | x <- outputs] ++ phonys}
else if length outputs == 1 then ninja{singles = (head outputs, build) : singles}
else ninja{multiples = (outputs, build) : multiples}
LexRule name ->
diff --git a/src/Development/Ninja/Type.hs b/src/Development/Ninja/Type.hs
--- a/src/Development/Ninja/Type.hs
+++ b/src/Development/Ninja/Type.hs
@@ -44,7 +44,7 @@
{rules :: [(Str,Rule)]
,singles :: [(FileStr,Build)]
,multiples :: [([FileStr], Build)]
- ,phonys :: ([(Str, [FileStr])])
+ ,phonys :: [(Str, [FileStr])]
,defaults :: [FileStr]
,pools :: [(Str, Int)]
}
diff --git a/src/Development/Shake/Command.hs b/src/Development/Shake/Command.hs
--- a/src/Development/Shake/Command.hs
+++ b/src/Development/Shake/Command.hs
@@ -11,7 +11,7 @@
-- You should only need to import this module if you are using the 'cmd' function in the 'IO' monad.
module Development.Shake.Command(
command, command_, cmd, unit, CmdArguments,
- Stdout(..), Stderr(..), Stdouterr(..), Exit(..), CmdTime(..), CmdLine(..),
+ Stdout(..), Stderr(..), Stdouterr(..), Exit(..), Process(..), CmdTime(..), CmdLine(..),
CmdResult, CmdString, CmdOption(..),
addPath, addEnv,
) where
@@ -21,7 +21,7 @@
import Control.Exception.Extra
import Control.Monad.Extra
import Control.Monad.IO.Class
-import Data.Either
+import Data.Either.Extra
import Data.List.Extra
import Data.Maybe
import System.Directory
@@ -52,6 +52,7 @@
| Env [(String,String)] -- ^ Change the environment variables in the spawned process. By default uses this processes environment.
-- Use 'addPath' to modify the @$PATH@ variable, or 'addEnv' to modify other variables.
| Stdin String -- ^ Given as the @stdin@ of the spawned process. By default the @stdin@ is inherited.
+ | StdinBS LBS.ByteString -- ^ Given as the @stdin@ of the spawned process.
| Shell -- ^ Pass the command to the shell without escaping - any arguments will be joined with spaces. By default arguments are escaped properly.
| BinaryPipes -- ^ Treat the @stdin@\/@stdout@\/@stderr@ messages as binary. By default 'String' results use text encoding and 'ByteString' results use binary encoding.
| Traced String -- ^ Name to use with 'traced', or @\"\"@ for no tracing. By default traces using the name of the executable.
@@ -108,9 +109,13 @@
| ResultCode ExitCode
| ResultTime Double
| ResultLine String
+ | ResultProcess Pid
deriving Eq
+data Pid = Pid0 | Pid ProcessHandle
+instance Eq Pid where _ == _ = True
+
---------------------------------------------------------------------
-- ACTION EXPLICIT OPERATION
@@ -191,9 +196,10 @@
let optCwd = let x = last $ "" : [x | Cwd x <- opts] in if x == "" then Nothing else Just x
let optEnv = let x = [x | Env x <- opts] in if null x then Nothing else Just $ concat x
- let optStdin = concat [x | Stdin x <- opts]
+ let optStdin = flip mapMaybe opts $ \x -> case x of Stdin x -> Just $ Left x; StdinBS x -> Just $ Right x; _ -> Nothing
let optShell = Shell `elem` opts
let optBinary = BinaryPipes `elem` opts
+ let optAsync = ResultProcess Pid0 `elem` results
let optTimeout = listToMaybe $ reverse [x | Timeout x <- opts]
let optWithStdout = last $ False : [x | WithStdout x <- opts]
let optWithStderr = last $ True : [x | WithStderr x <- opts]
@@ -205,26 +211,28 @@
let cmdline = saneCommandForUser exe args
let bufLBS f = do (a,b) <- buf $ LBS LBS.empty; return (a, (\(LBS x) -> f x) <$> b)
buf Str{} | optBinary = bufLBS (Str . LBS.unpack)
- buf Str{} = do x <- newBuffer; return ([DestString x], Str . concat <$> readBuffer x)
- buf LBS{} = do x <- newBuffer; return ([DestBytes x], LBS . LBS.fromChunks <$> readBuffer x)
+ buf Str{} = do x <- newBuffer; return ([DestString x | not optAsync], Str . concat <$> readBuffer x)
+ buf LBS{} = do x <- newBuffer; return ([DestBytes x | not optAsync], LBS . LBS.fromChunks <$> readBuffer x)
buf BS {} = bufLBS (BS . BS.concat . LBS.toChunks)
buf Unit = return ([], return Unit)
- (dStdout, dStderr, resultBuild) :: ([[Destination]], [[Destination]], [Double -> ExitCode -> IO Result]) <-
+ (dStdout, dStderr, resultBuild) :: ([[Destination]], [[Destination]], [Double -> ProcessHandle -> ExitCode -> IO Result]) <-
fmap unzip3 $ forM results $ \r -> case r of
- ResultCode _ -> return ([], [], \dur ex -> return $ ResultCode ex)
- ResultTime _ -> return ([], [], \dur ex -> return $ ResultTime dur)
- ResultLine _ -> return ([], [], \dur ex -> return $ ResultLine cmdline)
- ResultStdout s -> do (a,b) <- buf s; return (a , [], \_ _ -> fmap ResultStdout b)
- ResultStderr s -> do (a,b) <- buf s; return ([], a , \_ _ -> fmap ResultStderr b)
- ResultStdouterr s -> do (a,b) <- buf s; return (a , a , \_ _ -> fmap ResultStdouterr b)
+ ResultCode _ -> return ([], [], \dur pid ex -> return $ ResultCode ex)
+ ResultTime _ -> return ([], [], \dur pid ex -> return $ ResultTime dur)
+ ResultLine _ -> return ([], [], \dur pid ex -> return $ ResultLine cmdline)
+ ResultProcess _ -> return ([], [], \dur pid ex -> return $ ResultProcess $ Pid pid)
+ ResultStdout s -> do (a,b) <- buf s; return (a , [], \_ _ _ -> fmap ResultStdout b)
+ ResultStderr s -> do (a,b) <- buf s; return ([], a , \_ _ _ -> fmap ResultStderr b)
+ ResultStdouterr s -> do (a,b) <- buf s; return (a , a , \_ _ _ -> fmap ResultStdouterr b)
exceptionBuffer <- newBuffer
po <- resolvePath $ ProcessOpts
{poCommand = if optShell then ShellCommand $ unwords $ exe:args else RawCommand exe args
,poCwd = optCwd, poEnv = optEnv, poTimeout = optTimeout
- ,poStdin = if optBinary then Right $ LBS.pack optStdin else Left optStdin
- ,poStdout = [DestEcho | optEchoStdout] ++ map DestFile optFileStdout ++ [DestString exceptionBuffer | optWithStdout] ++ concat dStdout
- ,poStderr = [DestEcho | optEchoStderr] ++ map DestFile optFileStderr ++ [DestString exceptionBuffer | optWithStderr] ++ concat dStderr
+ ,poStdin = if optBinary || any isRight optStdin then Right $ LBS.concat $ map (either LBS.pack id) optStdin else Left $ concatMap fromLeft optStdin
+ ,poStdout = [DestEcho | optEchoStdout] ++ map DestFile optFileStdout ++ [DestString exceptionBuffer | optWithStdout && not optAsync] ++ concat dStdout
+ ,poStderr = [DestEcho | optEchoStderr] ++ map DestFile optFileStderr ++ [DestString exceptionBuffer | optWithStderr && not optAsync] ++ concat dStderr
+ ,poAsync = optAsync
}
res <- try_ $ duration $ process po
@@ -240,7 +248,7 @@
cwd ++ extra
case res of
Left err -> failure $ show err
- Right (dur,ex) | ex /= ExitSuccess && ResultCode ExitSuccess `notElem` results -> do
+ Right (dur,(pid,ex)) | ex /= ExitSuccess && ResultCode ExitSuccess `notElem` results -> do
exceptionBuffer <- readBuffer exceptionBuffer
let captured = ["Stderr" | optWithStderr] ++ ["Stdout" | optWithStdout]
failure $
@@ -248,7 +256,7 @@
if null captured then "Stderr not captured because WithStderr False was used\n"
else if null exceptionBuffer then intercalate " and " captured ++ " " ++ (if length captured == 1 then "was" else "were") ++ " empty"
else intercalate " and " captured ++ ":\n" ++ unlines (dropWhile null $ lines $ concat exceptionBuffer)
- Right (dur,ex) -> mapM (\f -> f dur ex) resultBuild
+ Right (dur,(pid,ex)) -> mapM (\f -> f dur pid ex) resultBuild
-- | If the user specifies a custom $PATH, and not Shell, then try and resolve their exe ourselves.
@@ -315,6 +323,11 @@
-- If you do not collect the exit code, any 'ExitFailure' will cause an exception.
newtype Exit = Exit {fromExit :: ExitCode}
+-- | Collect the 'ProcessHandle' of the process.
+-- If you do collect the process handle, the command will run asyncronously and the call to 'cmd'/'command'
+-- will return as soon as the process is spawned. Any 'Stdout'\/'Stderr' captures will return empty strings.
+newtype Process = Process {fromProcess :: ProcessHandle}
+
-- | Collect the time taken to execute the process. Can be used in conjunction with 'CmdLine' to
-- write helper functions that print out the time of a result.
--
@@ -353,6 +366,12 @@
instance CmdResult ExitCode where
cmdResult = ([ResultCode ExitSuccess], \[ResultCode x] -> x)
+instance CmdResult Process where
+ cmdResult = ([ResultProcess Pid0], \[ResultProcess (Pid x)] -> Process x)
+
+instance CmdResult ProcessHandle where
+ cmdResult = ([ResultProcess Pid0], \[ResultProcess (Pid x)] -> x)
+
instance CmdResult CmdLine where
cmdResult = ([ResultLine ""], \[ResultLine x] -> CmdLine x)
@@ -410,6 +429,10 @@
--
-- If you use 'command' inside a @do@ block and do not use the result, you may get a compile-time error about being
-- unable to deduce 'CmdResult'. To avoid this error, use 'command_'.
+--
+-- By default the @stderr@ stream will be captured for use in error messages, and also echoed. To only echo
+-- pass @'WithStderr' 'False'@, which causes no streams to be captured by Shake, and certain programs (e.g. @gcc@)
+-- to detect they are running in a terminal.
command :: CmdResult r => [CmdOption] -> String -> [String] -> Action r
command opts x xs = fmap b $ commandExplicit "command" opts a x xs
where (a,b) = cmdResult
diff --git a/src/Development/Shake/Core.hs b/src/Development/Shake/Core.hs
--- a/src/Development/Shake/Core.hs
+++ b/src/Development/Shake/Core.hs
@@ -391,6 +391,8 @@
-- | Internal main function (not exported publicly)
run :: ShakeOptions -> Rules () -> IO ()
run opts@ShakeOptions{..} rs = (if shakeLineBuffering then lineBuffering else id) $ do
+ opts@ShakeOptions{..} <- if shakeThreads /= 0 then return opts else do p <- getProcessorCount; return opts{shakeThreads=p}
+
start <- offsetTime
rs <- getRules rs
registerWitnesses rs
@@ -427,7 +429,6 @@
after <- newIORef []
absent <- newIORef []
- shakeThreads <- if shakeThreads == 0 then getProcessorCount else return shakeThreads
withCleanup $ \cleanup -> do
_ <- addCleanup cleanup $ do
when shakeTimings printTimings
@@ -451,6 +452,9 @@
let s1 = Local emptyStack shakeVerbosity Nothing [] 0 [] [] []
forM_ (actions rs) $ \act -> do
addPool pool $ runAction s0 s1 act $ \x -> staunch $ either throwIO return x
+
+ when (null $ actions rs) $ do
+ when (shakeVerbosity >= Normal) $ output Normal "Warning: No want/action statements, nothing to do"
when (isJust shakeLint) $ do
addTiming "Lint checking"
diff --git a/src/Development/Shake/Demo.hs b/src/Development/Shake/Demo.hs
--- a/src/Development/Shake/Demo.hs
+++ b/src/Development/Shake/Demo.hs
@@ -101,10 +101,10 @@
putStrLn "\n% Demo complete - all the examples can be run from:"
putStrLn $ "% " ++ dir
- putStrLn "% For more info see http://www.shakebuild.com/"
+ putStrLn "% For more info see http://shakebuild.com"
when (isJust ninja) $ do
putStrLn "\n% PS. Shake can also execute Ninja build files"
- putStrLn "% For more info see http://www.shakebuild.com/ninja"
+ putStrLn "% For more info see http://shakebuild.com/ninja"
diff --git a/src/Development/Shake/Rules/File.hs b/src/Development/Shake/Rules/File.hs
--- a/src/Development/Shake/Rules/File.hs
+++ b/src/Development/Shake/Rules/File.hs
@@ -177,7 +177,8 @@
-- This function is defined in terms of 'action' and 'need', use 'action' if you need more complex
-- targets than 'want' allows.
want :: [FilePath] -> Rules ()
-want = action . need
+want [] = return ()
+want xs = action $ need xs
root :: String -> (FilePath -> Bool) -> (FilePath -> Action ()) -> Rules ()
@@ -223,6 +224,9 @@
-- let src = 'Development.Shake.FilePath.replaceBaseName' out $ map toLower $ takeBaseName out
-- 'Development.Shake.writeFile'' out . map toUpper =<< 'Development.Shake.readFile'' src
-- @
+--
+-- If the 'Action' completes successfully the file is considered up-to-date, even if the file
+-- has not changed.
(?>) :: (FilePath -> Bool) -> (FilePath -> Action ()) -> Rules ()
(?>) test act = priority 0.5 $ root "with ?>" test act
@@ -257,5 +261,8 @@
-- I.e., the file @foo.cpp@ produces object file @foo.cpp.o@.
--
-- Note that matching is case-sensitive, even on Windows.
+--
+-- If the 'Action' completes successfully the file is considered up-to-date, even if the file
+-- has not changed.
(%>) :: FilePattern -> (FilePath -> Action ()) -> Rules ()
(%>) test act = (if simple test then id else priority 0.5) $ root (show test) (test ?==) act
diff --git a/src/Development/Shake/Types.hs b/src/Development/Shake/Types.hs
--- a/src/Development/Shake/Types.hs
+++ b/src/Development/Shake/Types.hs
@@ -84,7 +84,8 @@
,shakeThreads :: Int
-- ^ Defaults to @1@. Maximum number of rules to run in parallel, similar to @make --jobs=/N/@.
-- For many build systems, a number equal to or slightly less than the number of physical processors
- -- works well. Use @0@ to match the detected number of processors.
+ -- works well. Use @0@ to match the detected number of processors (when @0@, 'getShakeOptions' will
+ -- return the number of threads used).
,shakeVersion :: String
-- ^ Defaults to @"1"@. The version number of your build rules.
-- Change the version number to force a complete rebuild, such as when making
diff --git a/src/Development/Shake/Util.hs b/src/Development/Shake/Util.hs
--- a/src/Development/Shake/Util.hs
+++ b/src/Development/Shake/Util.hs
@@ -2,7 +2,7 @@
-- | A module for useful utility functions for Shake build systems.
module Development.Shake.Util(
parseMakefile, needMakefileDependencies, neededMakefileDependencies,
- shakeArgsAccumulate
+ shakeArgsAccumulate, shakeArgsPrune, shakeArgsPruneWith,
) where
import Development.Shake
@@ -10,8 +10,14 @@
import qualified Data.ByteString.Char8 as BS
import qualified Development.Shake.ByteString as BS
import Data.Tuple.Extra
+import Control.Applicative
import Data.List
import System.Console.GetOpt
+import Data.IORef
+import Data.Maybe
+import Control.Monad.Extra
+import Prelude
+import System.IO.Extra as IO
-- | Given the text of a Makefile, extract the list of targets and dependencies. Assumes a
@@ -58,3 +64,38 @@
-- Now you can pass @--distcc@ to use the @distcc@ compiler.
shakeArgsAccumulate :: ShakeOptions -> [OptDescr (Either String (a -> a))] -> a -> (a -> [String] -> IO (Maybe (Rules ()))) -> IO ()
shakeArgsAccumulate opts flags def f = shakeArgsWith opts flags $ \flags targets -> f (foldl' (flip ($)) def flags) targets
+
+
+-- | Like 'shakeArgs' but also takes a pruning function. If @--prune@ is passed, then after the build has completed,
+-- the second argument is called with a list of the files that the build checked were up-to-date.
+shakeArgsPrune :: ShakeOptions -> ([FilePath] -> IO ()) -> Rules () -> IO ()
+shakeArgsPrune opts prune rules = shakeArgsPruneWith opts prune [] f
+ where f _ files = return $ Just $ if null files then rules else want files >> withoutActions rules
+
+
+-- | A version of 'shakeArgsPrune' that also takes a list of extra options to use.
+shakeArgsPruneWith :: ShakeOptions -> ([FilePath] -> IO ()) -> [OptDescr (Either String a)] -> ([a] -> [String] -> IO (Maybe (Rules ()))) -> IO ()
+shakeArgsPruneWith opts prune flags act = do
+ let flags2 = Option "P" ["prune"] (NoArg $ Right Nothing) "Remove stale files" : map (fmapOptDescr $ fmap Just) flags
+ pruning <- newIORef False
+ shakeArgsWith opts flags2 $ \opts args ->
+ if any isNothing opts then do
+ writeIORef pruning True
+ return Nothing
+ else
+ act (map fromJust opts) args
+ whenM (readIORef pruning) $ do
+ IO.withTempFile $ \file -> do
+ shakeArgsWith opts{shakeLiveFiles=file : shakeLiveFiles opts} flags2 $ \opts args ->
+ act (catMaybes opts) args
+ src <- lines <$> IO.readFile' file
+ prune src
+
+-- fmap is only an instance in later GHC versions, so fake our own version
+fmapOptDescr :: (a -> b) -> OptDescr a -> OptDescr b
+fmapOptDescr f (Option a b argDescr c) = Option a b (fmapArgDescr f argDescr) c
+
+fmapArgDescr :: (a -> b) -> ArgDescr a -> ArgDescr b
+fmapArgDescr f (NoArg a) = NoArg (f a)
+fmapArgDescr f (ReqArg g s) = ReqArg (f . g) s
+fmapArgDescr f (OptArg g s) = OptArg (f . g) s
diff --git a/src/General/Process.hs b/src/General/Process.hs
--- a/src/General/Process.hs
+++ b/src/General/Process.hs
@@ -67,6 +67,7 @@
,poStdin :: Either String LBS.ByteString
,poStdout :: [Destination]
,poStderr :: [Destination]
+ ,poAsync :: Bool
}
@@ -113,6 +114,13 @@
return $ takeMVar res >>= either throwIO return
+abort :: ProcessHandle -> IO ()
+abort pid = do
+ interruptProcessGroupOf pid
+ sleep 5 -- give the process a few seconds grace period to die nicely
+ -- seems to happen with some GHC 7.2 compiled binaries with FFI etc
+ terminateProcess pid
+
withCreateProcess :: CreateProcess -> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO a) -> IO a
withCreateProcess cp act = mask $ \restore -> do
ans@(inh, outh, errh, pid) <- createProcess cp
@@ -126,7 +134,7 @@
-- General approach taken from readProcessWithExitCode
-process :: ProcessOpts -> IO ExitCode
+process :: ProcessOpts -> IO (ProcessHandle, ExitCode)
process po = do
(ProcessOpts{..}, flushBuffers) <- optimiseBuffers po
let files = nubOrd [x | DestFile x <- poStdout ++ poStderr]
@@ -136,7 +144,7 @@
,std_in = fst $ stdIn poStdin
,std_out = stdStream fileHandle poStdout poStderr, std_err = stdStream fileHandle poStderr poStdout}
withCreateProcess cp $ \(inh, outh, errh, pid) -> do
- withTimeout poTimeout (interruptProcessGroupOf pid) $ do
+ withTimeout poTimeout (abort pid) $ do
let streams = [(outh, stdout, poStdout) | Just outh <- [outh], CreatePipe <- [std_out cp]] ++
[(errh, stderr, poStderr) | Just errh <- [errh], CreatePipe <- [std_err cp]]
@@ -181,12 +189,16 @@
return $ sequence_ $ wait1 : waits
whenJust inh $ snd $ stdIn poStdin
- sequence_ wait
- flushBuffers
- res <- waitForProcess pid
- whenJust outh hClose
- whenJust errh hClose
- return res
+ if poAsync then
+ return (pid, ExitSuccess)
+ else do
+ sequence_ wait
+ flushBuffers
+ res <- waitForProcess pid
+ whenJust outh hClose
+ whenJust errh hClose
+ return (pid, res)
+
---------------------------------------------------------------------
-- COMPATIBILITY
diff --git a/src/Run.hs b/src/Run.hs
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -7,7 +7,6 @@
import Development.Shake
import Development.Shake.FilePath
import General.Timing
-import Data.List.Extra
import Control.Monad.Extra
import Control.Exception.Extra
import Data.Maybe
@@ -22,21 +21,30 @@
main = do
resetTimings
args <- getArgs
- withArgs ("--no-time":args) $
- shakeArgsWith shakeOptions{shakeCreationCheck=False} flags $ \opts targets -> do
- let tool = listToMaybe [x | Tool x <- opts]
- (mode, makefile) <- case reverse [x | UseMakefile x <- opts] of
- x:_ -> return (modeMakefile x, x)
- _ -> findMakefile
- case mode of
- Ninja -> runNinja makefile targets tool
- _ | isJust tool -> error "--tool flag is not supported without a .ninja Makefile"
- Exe -> do exitOnFailure =<< rawSystem (toNative makefile) args; return Nothing
- Haskell -> do exitOnFailure =<< rawSystem "runhaskell" (makefile:args); return Nothing
- Make -> fmap Just $ runMakefile makefile targets
-
-exitOnFailure :: ExitCode -> IO ()
-exitOnFailure x = when (x /= ExitSuccess) $ exitWith x
+ hsExe <- findFile
+ [".shake" "shake" <.> exe
+ ,"Shakefile.hs","Shakefile.lhs"]
+ case hsExe of
+ Just file -> do
+ (prog,args) <- return $
+ if takeExtension file `elem` [".hs",".lhs"] then ("runhaskell", file:args) else (toNative file, args)
+ e <- rawSystem prog args
+ when (e /= ExitSuccess) $ exitWith e
+ Nothing -> do
+ withArgs ("--no-time":args) $
+ shakeArgsWith shakeOptions{shakeCreationCheck=False} flags $ \opts targets -> do
+ let tool = listToMaybe [x | Tool x <- opts]
+ makefile <- case reverse [x | UseMakefile x <- opts] of
+ x:_ -> return x
+ _ -> do
+ res <- findFile ["makefile","Makefile","build.ninja"]
+ case res of
+ Just x -> return x
+ Nothing -> errorIO "Could not find `makefile', `Makefile' or `build.ninja'"
+ case () of
+ _ | takeExtension makefile == ".ninja" -> runNinja makefile targets tool
+ _ | isJust tool -> error "--tool flag is not supported without a .ninja Makefile"
+ _ -> fmap Just $ runMakefile makefile targets
data Flag = UseMakefile FilePath
@@ -46,23 +54,5 @@
,Option "t" ["tool"] (ReqArg (Right . Tool) "TOOL") "Ninja-compatible tools."
]
-data Mode = Make | Ninja | Haskell | Exe
-
-modeMakefile :: FilePath -> Mode
-modeMakefile x | takeExtension x == ".ninja" = Ninja
- | takeExtension x `elem` [".hs",".lhs"] = Haskell
- | otherwise = Make
-
-
-findMakefile :: IO (Mode, FilePath)
-findMakefile = do
- let files = [(Exe,".shake" "shake" <.> exe)
- ,(Haskell,"Shakefile.hs"),(Haskell,"Shakefile.lhs")
- ,(Make,"makefile"),(Make,"Makefile")
- ,(Ninja,"build.ninja")]
- res <- findM (fmap (either (const False) id) . try_ . IO.doesFileExist . snd) files
- case res of
- Just x -> return x
- Nothing -> do
- let Just (p1,p2) = unsnoc ["`" ++ x ++ "'" | (_,x) <- files]
- errorIO $ "Could not find " ++ intercalate ", " p1 ++ " or " ++ p2
+findFile :: [FilePath] -> IO (Maybe FilePath)
+findFile = findM (fmap (either (const False) id) . try_ . IO.doesFileExist)
diff --git a/src/Test/Basic.hs b/src/Test/Basic.hs
--- a/src/Test/Basic.hs
+++ b/src/Test/Basic.hs
@@ -44,6 +44,10 @@
phony "dummy" $ do
liftIO $ appendFile (obj "dummy") "1"
+ phony "threads" $ do
+ x <- getShakeOptions
+ writeFile' (obj "threads.txt") $ show $ shakeThreads x
+
obj "dummer.txt" %> \out -> do
need ["dummy","dummy"]
need ["dummy"]
@@ -124,12 +128,19 @@
build ["3.par","4.par","-j2"]
assertContents (obj ".log") "[[]]"
writeFile (obj ".log") ""
- i <- getProcessorCount
- putStrLn $ "getProcessorCount returned " ++ show i
- when (i > 1) $ do
+ processors <- getProcessorCount
+ putStrLn $ "getProcessorCount returned " ++ show processors
+ when (processors > 1) $ do
build ["5.par","6.par","-j0"]
assertContents (obj ".log") "[[]]"
writeFile (obj ".log") ""
build ["unsafe1.par","unsafe2.par","-j2"]
assertContents (obj ".log") "[[]]"
+
+ build ["!threads","-j3"]
+ assertContents (obj "threads.txt") "3"
+ build ["!threads","-j0"]
+ assertContents (obj "threads.txt") (show processors)
+
+ build [] -- should say "no want/action statements, nothing to do" (checked manually)
diff --git a/src/Test/Command.hs b/src/Test/Command.hs
--- a/src/Test/Command.hs
+++ b/src/Test/Command.hs
@@ -10,6 +10,7 @@
import System.Directory
import Test.Type
import System.Exit
+import System.Process
import Data.Tuple.Extra
import Data.List.Extra
import Control.Monad.IO.Class
@@ -43,6 +44,7 @@
," 'v' -> putStrLn =<< getEnv rg"
," 'w' -> threadDelay $ floor $ 1000000 * (read rg :: Double)"
," 'r' -> LBS.putStr $ LBS.replicate (read rg) 'x'"
+ ," 'i' -> putStr =<< getContents"
," hFlush stdout"
," hFlush stderr"
]
@@ -113,6 +115,17 @@
t3 <- withTempFile $ \file -> fromCmdTime <$> cmd helper "r10000000" (FileStdout file)
liftIO $ putStrLn $ "Capturing 10Mb takes: " ++ intercalate ","
[s ++ " = " ++ showDuration d | (s,d) <- [("String",t1),("ByteString",t2),("File",t3)]]
+
+ "stdin" !> do
+ Stdout (x :: String) <- cmd helper "i" (Stdin "hello ") (StdinBS $ LBS.pack "world")
+ liftIO $ x === "hello world"
+
+ "async" !> do
+ let file = obj "async.txt"
+ pid <- cmd helper (FileStdout file) "w2" "ohello"
+ Nothing <- liftIO $ getProcessExitCode pid
+ ExitSuccess <- liftIO $ waitForProcess pid
+ liftIO $ assertContents file "hello\n"
test build obj = do
diff --git a/src/Test/Docs.hs b/src/Test/Docs.hs
--- a/src/Test/Docs.hs
+++ b/src/Test/Docs.hs
@@ -214,7 +214,7 @@
"-threaded -rtsopts -I0 Function extension $OUT $C_LINK_FLAGS $PATH xterm $TERM main opts result flagValues argValues " ++
"HEADERS_DIR /path/to/dir CFLAGS let -showincludes -MMD gcc.version linkFlags temp pwd touch code out err " ++
"_metadata/.shake.database _shake _shake/build ./build.sh build.sh build.bat [out] manual " ++
- "docs/manual _build _build/run ninja depfile build.ninja ByteString " ++
+ "docs/manual _build _build/run ninja depfile build.ninja ByteString ProcessHandle " ++
"Rule CmdResult ShakeValue Monoid Monad Eq Typeable Data " ++ -- work only with constraint kinds
"@ndm_haskell file-name " ++
"*> "
@@ -254,8 +254,8 @@
,"build -j8"
,"cabal update && cabal install shake"
,"shake-build-system"
- ,"runhaskell _build/run"
- ,"runhaskell _build/run clean"
+ ,"runhaskell Build.hs"
+ ,"runhaskell Build.hs clean"
,"gcc -c main.c -o main.o -MMD -MF main.m"
,"\"_build\" x -<.> \"o\""
,"cmd \"gcc -o\" [out] os"
diff --git a/src/Test/Ninja.hs b/src/Test/Ninja.hs
--- a/src/Test/Ninja.hs
+++ b/src/Test/Ninja.hs
@@ -88,3 +88,5 @@
config <- Config.readConfigFileWithEnv [("v1", test6)] $ test6 ++ ".ninja"
-- The file included by subninja should have a separate variable scope
Map.lookup "v2" config === Just "g2"
+
+ run "-f../../src/Test/Ninja/phonyorder.ninja bar.txt"
diff --git a/src/Test/Ninja/phonyorder.ninja b/src/Test/Ninja/phonyorder.ninja
new file mode 100644
--- /dev/null
+++ b/src/Test/Ninja/phonyorder.ninja
@@ -0,0 +1,13 @@
+
+rule create
+ command = touch $out
+
+rule copy
+ command = cp $from $out
+
+build Foo2: phony || foo.txt
+
+build bar.txt: copy || Foo2
+ from = foo.txt
+
+build foo.txt: create