packages feed

shake 0.13.1 → 0.13.2

raw patch · 11 files changed

+111/−29 lines, 11 files

Files

CHANGES.txt view
@@ -1,5 +1,10 @@ Changelog for Shake +0.13.2+    #95, ensure progress never gets corrupted+    #124, add a profile report demo+    #128, allow long Ninja command lines+    Fix --report=- for builds with no commands in them 0.13.1     Remove all package upper bounds     #126, Ninja compatibility if Ninja fails to create a file
Development/Ninja/All.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-}
+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, ViewPatterns #-}
 
 module Development.Ninja.All(runNinja) where
 
@@ -10,6 +10,7 @@ import Development.Shake.Errors
 import Development.Shake.Rules.File
 import Development.Shake.Rules.OrderOnly
+import General.Base
 import General.Timing
 import qualified Data.ByteString as BS8
 import qualified Data.ByteString.Char8 as BS
@@ -114,11 +115,12 @@                         Just r -> withResource r 1 act
 
                 when (description /= "") $ putNormal description
+                let (cmdOpts, cmdProg, cmdArgs) = toCommand commandline
                 if deps == "msvc" then do
-                    Stdout stdout <- withPool $ command [Shell] commandline []
+                    Stdout stdout <- withPool $ command cmdOpts cmdProg cmdArgs
                     needDeps build $ map normalise $ parseShowIncludes $ BS.pack stdout
                  else
-                    withPool $ command_ [Shell] commandline []
+                    withPool $ command_ cmdOpts cmdProg cmdArgs
                 when (depfile /= "") $ do
                     when (deps /= "gcc") $ need [depfile]
                     depsrc <- liftIO $ BS.readFile depfile
@@ -214,3 +216,61 @@             ,"    \"file\": " ++ g cdbFile
             ,"  }" ++ (if i == n then "" else ",")]
         g = show
+
+
+toCommand :: String -> ([CmdOption], String, [String])
+toCommand s
+    -- On POSIX, Ninja does a /bin/sh -c, and so does Haskell in Shell mode (easy).
+    | not isWindows = ([Shell], s, [])
+    -- On Windows, Ninja passes the string directly to CreateProcess,
+    -- but Haskell applies some escaping first.
+    -- We try and get back as close to the original as we can, but it's very hacky
+    | length s < 8000 =
+        -- Using the "cmd" program adds overhead (I measure 7ms), and a limit of 8191 characters,
+        -- but is the most robust, requiring no additional escaping.
+        ([Shell], s, [])
+    | (cmd,s) <- word1 s, map toUpper cmd `elem` ["CMD","CMD.EXE"], ("/c",s) <- word1 s =
+        -- Given "cmd.exe /c <something>" we translate to Shell, which adds cmd.exe
+        -- (looked up on the current path) and /c to the front. CMake uses this rule a lot.
+        -- Adding quotes around pieces are /c goes very wrong.
+        ([Shell], s, [])
+    | otherwise =
+        -- It's a long command line which doesn't call "cmd /c". We reverse the escaping
+        -- Haskell applies, but each argument will still gain quotes around it.
+        let xs = splitArgs s in ([], head $ xs ++ [""], drop 1 xs)
+
+
+data State
+    = Gap -- ^ Current in the gap between words
+    | Word -- ^ Currently inside a space-separated argument
+    | Quot -- ^ Currently inside a quote-surrounded argument
+
+-- | The process package contains a translate function, reproduced below. The aim is that after command line
+--   parsing we should get out mostly the same answer.
+splitArgs :: String -> [String]
+splitArgs = f Gap
+    where
+        f Gap (x:xs) | isSpace x = f Gap xs
+        f Gap ('\"':xs) = f Quot xs
+        f Gap [] = []
+        f Gap xs = f Word xs
+        f Word (x:xs) | isSpace x = [] : f Gap xs
+        f Quot ('\"':xs) = [] : f Gap xs
+        f s ('\\':xs) | (length -> a, b) <- span (== '\\') xs = case b of
+            '\"':xs | even a -> add (replicate (a `div` 2) '\\' ++ "\"") $ f s xs
+                    | otherwise -> add (replicate ((a+1) `div` 2) '\\') $ f s ('\"':xs)
+            xs -> add (replicate (a+1) '\\') $ f s xs
+        f s (x:xs) = add [x] $ f s xs
+        f s [] = [] : []
+
+        add a (b:c) = (a++b):c
+        add a [] = a:[]
+
+{-
+translate (cmd,args) = unwords $ f cmd : map f args
+    where
+        f x = '"' : snd (foldr escape (True,"\"") xs)
+        escape '"'  (_,     str) = (True,  '\\' : '"'  : str)
+        escape '\\' (True,  str) = (True,  '\\' : '\\' : str)
+        escape c    (_,     str) = (False, c : str)
+-}
Development/Shake/Progress.hs view
@@ -21,6 +21,7 @@ import Data.Maybe import Data.Monoid import qualified Data.ByteString.Char8 as BS+import General.Base import System.IO.Unsafe  #ifdef mingw32_HOST_OS@@ -119,6 +120,8 @@ --      ------------- --      b + f*(b'-b) -- when f == 1, r == r'+--+-- both streams must only ever increase decay :: Double -> Mealy i Double -> Mealy i Double -> Mealy i Double decay f a b = scanMealy step 0 $ (,) <$> oldMealy 0 a <*> oldMealy 0 b     where step r ((a,a'),(b,b')) =((r*b) + f*(a'-a)) / (b + f*(b'-b))@@ -134,37 +137,41 @@ message :: Double -> Mealy Progress Progress -> Mealy Progress String message sample progress = (\time perc -> time ++ " (" ++ perc ++ "%)") <$> time <*> perc     where-        -- Number of seconds work completed+        -- Number of seconds work completed in this build run         -- Ignores timeSkipped which would be more truthful, but it makes the % drop sharply         -- which isn't what users want-        done = fmap timeBuilt progress+        done = timeBuilt <$> progress +        -- Work done per second, don't divide by 0 and don't update if 'done' doesn't change+        donePerSec = iff ((==) 0 <$> done) (pure 1) perSecStable+            where perSecStable = latch $ liftA2 (,) (uncurry (==) <$> oldMealy 0 done) perSecRaw+                  perSecRaw = decay 1.2 done secs+                  secs = ((*) sample . fromInt) <$> posMealy+         -- Predicted build time for a rule that has never been built before         -- The high decay means if a build goes in "phases" - lots of source files, then lots of compiling         -- we reach a reasonable number fairly quickly, without bouncing too much-        guess = iff ((==) 0 <$> samples) (pure 0) $ decay 10 time $ fmap fromInt samples+        ruleTime = liftA2 weightedAverage+            (f (decay 10) timeBuilt countBuilt)+            (f (liftA2 (/)) (fst . timeTodo) (\Progress{..} -> countTodo - snd timeTodo))+            -- don't call decay on todo, since it goes up and down (as things get done)             where-                time = flip fmap progress $ \Progress{..} -> timeBuilt + fst timeTodo-                samples = flip fmap progress $ \Progress{..} -> countBuilt + countTodo - snd timeTodo--        -- Number of seconds work remaining, ignoring multiple threads-        todo = f <$> progress <*> guess-            where f Progress{..} guess = fst timeTodo + (fromIntegral (snd timeTodo) * guess)+                weightedAverage (w1,x1) (w2,x2)+                    | w1 == 0 && w2 == 0 = 0+                    | otherwise = ((fromInt w1 * x1) + (fromInt w2 * x2)) / fromInt (w1+w2) -        -- Number of seconds we have been going-        step = fmap ((*) sample . fromInt) posMealy-        work = decay 1.2 done step+                f divide time count = let xs = count <$> progress in liftA2 (,) xs $ divide (time <$> progress) (fromInt <$> xs) -        -- Work value to use, don't divide by 0 and don't update work if done doesn't change-        realWork = iff ((==) 0 <$> done) (pure 1) $-            latch $ (,) <$> (uncurry (==) <$> oldMealy 0 done) <*> work+        -- Number of seconds work remaining, ignoring multiple threads+        todo = f <$> progress <*> ruleTime+            where f Progress{..} ruleTime = fst timeTodo + (fromIntegral (snd timeTodo) * ruleTime)          -- Display information-        time = flip fmap ((/) <$> todo <*> realWork) $ \guess ->+        time = flip fmap (liftA2 (/) todo donePerSec) $ \guess ->             let (mins,secs) = divMod (ceiling guess) (60 :: Int)             in (if mins == 0 then "" else show mins ++ "m" ++ ['0' | secs < 10]) ++ show secs ++ "s"         perc = iff ((==) 0 <$> done) (pure "0") $-            (\done todo -> show (floor (100 * done / (done + todo)) :: Int)) <$> done <*> todo+            liftA2' done todo $ \done todo -> show (floor (100 * done / (done + todo)) :: Int)   ---------------------------------------------------------------------
Development/Shake/Report.hs view
@@ -37,7 +37,7 @@     ,let f = show . sum . map (length . repTraces) in "* Building required " ++ f xs ++ " traced commands (" ++ f ls ++ " in the last run)."     ,"* The total (unparallelised) build time is " ++ showTime (sum $ map repExecution xs) ++         " of which " ++ showTime (sum $ map repTime $ concatMap repTraces xs) ++ " is traced commands."-    ,let f = (\(a,b) -> showTime a ++ " (" ++ b ++ ")") . maximumBy (compare `on` fst) in+    ,let f xs = if null xs then "0s" else (\(a,b) -> showTime a ++ " (" ++ b ++ ")") $ maximumBy (compare `on` fst) xs in         "* The longest rule takes " ++ f (map (repExecution &&& repName) xs) ++         ", and the longest traced command takes " ++ f (map (repTime &&& repCommand) $ concatMap repTraces xs) ++ "."     ,let sumLast = sum $ map repTime $ concatMap repTraces ls
Examples/Test/Files.hs view
@@ -35,4 +35,5 @@         assertContents (obj "even.txt") $ nums [2,4,2]         assertContents (obj "odd.txt" ) $ nums [1,5,3,1]         build ["clean"]+        build ["--no-build","--report=-"]         build ["dir1/out.txt"]
General/Base.hs view
@@ -9,11 +9,12 @@     readFileUCS2, getEnvMaybe, captureOutput,     showDP, showTime,     modifyIORef'', writeIORef'',-    whenJust, loopM, whileM, partitionM, concatMapM, mapMaybeM,-    fastNub, showQuote,+    whenJust, loopM, whileM, partitionM, concatMapM, mapMaybeM, liftA2',+    fastNub, showQuote, word1,     withBufferMode, withCapabilities     ) where +import Control.Applicative import Control.Arrow import Control.Concurrent import Control.Exception@@ -159,6 +160,10 @@              | otherwise = xs  +word1 :: String -> (String, String)+word1 x = second (dropWhile isSpace) $ break isSpace $ dropWhile isSpace x++ --------------------------------------------------------------------- -- Data.String @@ -206,6 +211,9 @@  mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b] mapMaybeM f xs = liftM catMaybes $ mapM f xs++liftA2' :: Applicative m => m a -> m b -> (a -> b -> c) -> m c+liftA2' a b f = liftA2 f a b   ---------------------------------------------------------------------
README.md view
@@ -9,6 +9,7 @@ * [Generated documentation](http://hackage.haskell.org/packages/archive/shake/latest/doc/html/Development-Shake.html) for all functions, includes lots of examples. * [Running Ninja builds](https://github.com/ndmitchell/shake/blob/master/docs/Ninja.md#readme) using Shake. * [Blog posts](http://neilmitchell.blogspot.co.uk/search/label/shake) detailing ongoing development work.+* [Profile report demo](https://cdn.rawgit.com/ndmitchell/shake/35fbe03c8d3bafeae17b58af89497ff3fdd54b22/html/demo.html) explaining what the profile reports mean. * [Academic paper](http://community.haskell.org/~ndm/downloads/paper-shake_before_building-10_sep_2012.pdf) on the underlying principles behind Shake. * [Video](http://www.youtube.com/watch?v=xYCPpXVlqFM) of a talk introducing Shake. 
docs/Manual.md view
@@ -329,9 +329,9 @@  #### Profiling -Shake features an advanced profiling mode. To build with profiling run `build --report` which will generate an interactive HTML profile at `report.html`. This report lets you examine what happened in that run, what takes more time to run, what rules depend on what etc. There is a help page as part of the profiling output.+Shake features an advanced profiling feature. To build with profiling run `build --report`, which will generate an interactive HTML profile named `report.html`. This report lets you examine what happened in that run, what takes most time to run, what rules depend on what etc. There is a help page included in the profiling output, and a [profiling tutorial/demo](https://cdn.rawgit.com/ndmitchell/shake/35fbe03c8d3bafeae17b58af89497ff3fdd54b22/html/demo.html). -To view profiling information for the _previous_ program run, you can run `build --no-build --report`. This feature is useful if you have a build execution where a file unexpectedly rebuilds, you can generate a profiling report afterwards.+To view profiling information for the _previous_ build, you can run `build --no-build --report`. This feature is useful if you have a build execution where a file unexpectedly rebuilds, you can generate a profiling report afterwards and see why. To generate a lightweight report (about 5 lines) printed to the console run `build --report=-`.   #### Tracing and debugging 
html/report.html view
@@ -104,7 +104,7 @@ 		The drop-down box, currently displaying 'Help', let's you pick the type of report. The best way to learn about the report types is to try them out (all work with the empty query). The types are: 	</p> 	<ul class="space">-		<li><b>Summary:</b> Display summary statistics about the Shake database. The term 'rule' refers to any Shake rule, and there will be one rule for everything that gets built or tracked, including source files. The term 'traced command' refers to any call to <a class="shake">traced</a>, which is automatically inserted by the <a class="shake">system'</a> function. The reported parallelism refers to the average number of traced commands executing during the last build - for example, a parallelism of 4.0 when using <a class="shake">shakeThreads</a>=4 would be a perfect speedup. The time spent not executing traced commands includes time when Shake was checking dependencies and any Haskell operations performed by the rules.</li>+		<li><b>Summary:</b> Display summary statistics about the Shake database. The term 'rule' refers to any Shake rule, and there will be one rule for everything that gets built or tracked, including source files. The term 'traced command' refers to any call to <a class="shake">traced</a>, which is automatically inserted by the <a class="shake">command</a> function. The reported parallelism refers to the average number of traced commands executing during the last build - for example, a parallelism of 4.0 when using <a class="shake">shakeThreads</a>=4 would be a perfect speedup. The time spent not executing traced commands includes time when Shake was checking dependencies and any Haskell operations performed by the rules.</li> 		<li><b>Help:</b> This help document.</li> 		<li><b>Command plot:</b> This plot shows which traced commands were executing at any time. The Y axis is the number of simultaneous traced commands and the X axis is the progress through the last run of the build system that executed any rules. Some useful queries are: 			<ul>@@ -139,7 +139,7 @@ 	</ul> 	<h3>Query language</h3> 	<p>-		The query language takes is a Javascript expression which produces <code>true</code> to include the row, and may call <code>group</code> to indicate grouping. The standard Javascript operators (e.g. <code>==</code> and <code>&amp;&amp;</code>). Anything which takes a <code>RegExp</code> can also accept a <code>string</code>, which is then treated as a literal unanchored regular expression. The following functions are available:+		The query language is a Javascript expression which produces <code>true</code> to include the row, and may call <code>group</code> to indicate grouping. You can use the standard Javascript operators (e.g. <code>==</code> and <code>&amp;&amp;</code>). Anything which takes a <code>RegExp</code> can also accept a <code>string</code>, which is then treated as a literal unanchored regular expression. The following functions are available: 	</p> 	<ul class="space"> 		<li><code>group(x : string) : true</code> - assign this item the given group. Multiple calls to <code>group</code> result in a space-separated name. The group name can also be set using <code>name</code> or <code>command</code> with captured regular expressions.</li>
html/shake-ui.js view
@@ -29,7 +29,7 @@ function reportURL(report) // :: Report -> URL {     return "?mode=" + report.mode +-           (report.query === defaultQuery ? "" : "&query=" + escape(report.query).replace("+","%2B")) ++           (report.query === defaultQuery ? "" : "&query=" + escape(report.query).replace(/\+/g,"%2B")) +            (report.sort === undefined || (!report.sortRev && report.sort === defaultSort) ? "" :                "&sort=" + (report.sortRev ? "!" : "") + report.sort); }
shake.cabal view
@@ -1,7 +1,7 @@ cabal-version:      >= 1.10 build-type:         Simple name:               shake-version:            0.13.1+version:            0.13.2 license:            BSD3 license-file:       LICENSE category:           Development