shake 0.15 → 0.15.1

raw patch · 21 files changed

+215/−101 lines, 21 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES.txt +11/−0
• README.md +2/−16
• docs/Manual.md +4/−4
• html/shake-progress.js +1/−1
• html/shake-ui.js +2/−2
• shake.cabal +3/−3
• src/Development/Ninja/Parse.hs +1/−1
• src/Development/Ninja/Type.hs +1/−1
• src/Development/Shake/Command.hs +40/−17
• src/Development/Shake/Core.hs +5/−1
• src/Development/Shake/Demo.hs +2/−2
• src/Development/Shake/Rules/File.hs +8/−1
• src/Development/Shake/Types.hs +2/−1
• src/Development/Shake/Util.hs +42/−1
• src/General/Process.hs +20/−8
• src/Run.hs +26/−36
• src/Test/Basic.hs +14/−3
• src/Test/Command.hs +13/−0
• src/Test/Docs.hs +3/−3
• src/Test/Ninja.hs +2/−0
• src/Test/Ninja/phonyorder.ninja +13/−0

@@ -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

@@ -1,6 +1,6 @@ # Shake [![Hackage version](https://img.shields.io/hackage/v/shake.svg?style=flat)](https://hackage.haskell.org/package/shake) [![Build Status](https://img.shields.io/travis/ndmitchell/shake.svg?style=flat)](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).

@@ -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:  <pre> phony "<i>name</i>" $ do@@ -273,7 +273,7 @@  Where <tt><i>name</i></tt> is the name used on the command line to invoke the actions, and <tt><i>actions</i></tt> 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 <tt><i>actions</i></tt> 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 <tt><i>actions</i></tt> 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

@@ -14,7 +14,7 @@ //     }  $(function(){-    $(".version").html("Generated by <a href='http://www.shakebuild.com/'>Shake " + version + "</a>.");+    $(".version").html("Generated by <a href='http://shakebuild.com'>Shake " + version + "</a>.");     $("#output").html("");     for (var i = 0; i < shake.length; i++)     {

@@ -204,7 +204,7 @@             for (var i = 0; i < res.length; i++)                 s += "<li>" + res[i] + "</li>";             s += "</ul>";-            s += "<p class='version'>Generated by <a href='http://www.shakebuild.com/'>Shake " + version + "</a>.</p>";+            s += "<p class='version'>Generated by <a href='http://shakebuild.com'>Shake " + version + "</a>.</p>";             $("#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 += "];";

@@ -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:-    <http://www.shakebuild.com/>+    <http://shakebuild.com>     .     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:

@@ -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 ->

@@ -44,7 +44,7 @@     {rules :: [(Str,Rule)]     ,singles :: [(FileStr,Build)]     ,multiples :: [([FileStr], Build)]-    ,phonys :: ([(Str, [FileStr])])+    ,phonys :: [(Str, [FileStr])]     ,defaults :: [FileStr]     ,pools :: [(Str, Int)]     }

@@ -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

@@ -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"

@@ -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"   

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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)

@@ -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)

@@ -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

@@ -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"

@@ -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"

@@ -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