shake 0.13.3 → 0.13.4

raw patch · 12 files changed

+69/−48 lines, 12 files

Files

• CHANGES.txt +2/−0
• Development/Shake/Args.hs +1/−1
• Development/Shake/Command.hs +1/−1
• Development/Shake/Core.hs +1/−1
• Development/Shake/Database.hs +8/−9
• Development/Shake/Demo.hs +16/−8
• Development/Shake/Progress.hs +5/−9
• Development/Shake/Resource.hs +2/−2
• General/Base.hs +21/−4
• General/Timing.hs +1/−1
• Test/Random.hs +4/−5
• shake.cabal +7/−7

@@ -1,5 +1,7 @@ Changelog for Shake +0.13.4+    #171, fix the --demo mode on Linux 0.13.3     Ensure you wait until the progress thread cleans up     Add --demo mode

@@ -134,7 +134,7 @@      else if NumericVersion `elem` flagsExtra then         putStrLn $ showVersion version      else if Demo `elem` flagsExtra then-        demo+        demo $ shakeStaunch shakeOpts      else if not $ null progressReplays then do         dat <- forM progressReplays $ \file -> do             src <- readFile file

@@ -50,7 +50,7 @@     = Cwd FilePath -- ^ Change the current directory in the spawned process. By default uses this processes current directory.     | 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 no @stdin@ is given.+    | Stdin String -- ^ Given as the @stdin@ of the spawned process. By default the @stdin@ is inherited.     | 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 streams use text encoding.     | Traced String -- ^ Name to use with 'traced', or @\"\"@ for no tracing. By default traces using the name of the executable.

@@ -510,7 +510,7 @@     putNormal $ "# " ++ msg ++ " (for " ++ showTopStack stack ++ ")"     res <- liftIO act     stop <- liftIO globalTimestamp-    Action $ modifyRW $ \s -> s{localTraces = Trace (pack msg) start stop : localTraces s}+    Action $ modifyRW $ \s -> s{localTraces = Trace (pack msg) (doubleToFloat start) (doubleToFloat stop) : localTraces s}     return res  

@@ -1,9 +1,9 @@-{-# LANGUAGE RecordWildCards, ScopedTypeVariables, PatternGuards #-}+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, PatternGuards, ViewPatterns #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}  module Development.Shake.Database(-    Time, offsetTime, Duration, duration, Trace(..),+    Trace(..),     Database, withDatabase,     listDepends, lookupDependencies,     Ops(..), build, Depends,@@ -79,7 +79,7 @@ --------------------------------------------------------------------- -- CENTRAL TYPES -data Trace = Trace BS Time Time -- (message, start, end)+data Trace = Trace BS Float Float -- (message, start, end)     deriving Show  instance NFData Trace where@@ -109,7 +109,7 @@     ,built :: {-# UNPACK #-} !Step -- when it was actually run     ,changed :: {-# UNPACK #-} !Step -- the step for deciding if it's valid     ,depends :: [[Id]] -- dependencies-    ,execution :: {-# UNPACK #-} !Duration -- how long it took when it was last run (seconds)+    ,execution :: {-# UNPACK #-} !Float -- how long it took when it was last run (seconds)     ,traces :: [Trace] -- a trace of the expensive operations (start/end in seconds since beginning of run)     } deriving Show @@ -284,7 +284,7 @@                 let norm = execute (addStack i k stack) k $ \res ->                         reply $ case res of                             Left err -> Error err-                            Right (v,deps,execution,traces) ->+                            Right (v,deps,(doubleToFloat -> execution),traces) ->                                 let c | Just r <- r, result r == v = changed r                                       | otherwise = step                                 in Ready Result{result=v,changed=c,built=step,depends=map fromDepends deps,..}@@ -338,7 +338,7 @@     s <- readIORef status     return $ foldl' f mempty $ map snd $ Map.elems s     where-        g = fromRational . toRational+        g = floatToDouble          f s (Ready Result{..}) = if step == built             then s{countBuilt = countBuilt s + 1, timeBuilt = timeBuilt s + g execution}@@ -410,12 +410,11 @@             ,prfBuilt = fromStep built             ,prfChanged = fromStep changed             ,prfDepends = mapMaybe (`Map.lookup` ids) (concat depends)-            ,prfExecution = fromFloat execution+            ,prfExecution = floatToDouble execution             ,prfTraces = map fromTrace traces             }             where fromStep i = fromJust $ Map.lookup i steps-                  fromTrace (Trace a b c) = ProfileTrace (unpack a) (fromFloat b) (fromFloat c)-                  fromFloat = fromRational . toRational+                  fromTrace (Trace a b c) = ProfileTrace (unpack a) (floatToDouble b) (floatToDouble c)     return [maybe (err "toReport") f $ Map.lookup i status | i <- order]  

@@ -20,8 +20,8 @@ import System.IO  -demo :: IO ()-demo = do+demo :: Bool -> IO ()+demo auto = do     hSetBuffering stdout NoBuffering     putStrLn $ "% Welcome to the Shake v" ++ showVersion version ++ " demo mode!"     putStr $ "% Detecting machine configuration... "@@ -57,16 +57,21 @@      putStrLn $ "% The Shake demo uses an empty directory, OK to use:"     putStrLn $ "%     " ++ dir-    b <- yesNo+    b <- yesNo auto     require b "% Please create an empty directory to run the demo from, then run 'shake --demo' again."      putStr "% Copying files... "     createDirectoryIfMissing True dir     forM_ ["Build.hs","main.c","constants.c","constants.h","build" <.> if isWindows then "bat" else "sh"] $ \file ->         copyFile (manual </> file) (dir </> file)+    when (not isWindows) $ do+         p <- getPermissions $ dir </> "build.sh"+         setPermissions (dir </> "build.sh") p{executable=True}     putStrLn "done" -    let pause = putStr "% Press ENTER to continue: " >> getLine+    let pause = do+            putStr "% Press ENTER to continue: "+            if auto then putLine "" else getLine     let execute x = do             putStrLn $ "% RUNNING: " ++ x             cmd (Cwd dir) Shell x :: IO ()@@ -105,16 +110,19 @@   -- | Require the user to press @y@ before continuing.-yesNo :: IO Bool-yesNo = do+yesNo :: Bool -> IO Bool+yesNo auto = do     putStr $ "% [Y/N] (then ENTER): "-    x <- fmap (map toLower) getLine+    x <- if auto then putLine "y" else fmap (map toLower) getLine     if "y" `isPrefixOf` x then         return True      else if "n" `isPrefixOf` x then         return False      else-        yesNo+        yesNo auto++putLine :: String -> IO String+putLine x = putStrLn x >> return x   -- | Replace exceptions with 'False'.

@@ -130,10 +130,6 @@     where step r ((a,a'),(b,b')) =((r*b) + f*(a'-a)) / (b + f*(b'-b))  -fromInt :: Int -> Double-fromInt = fromInteger . toInteger-- --------------------------------------------------------------------- -- MESSAGE GENERATOR @@ -180,10 +176,10 @@             where                 weightedAverage (w1,x1) (w2,x2)                     | w1 == 0 && w2 == 0 = 0-                    | otherwise = ((w1 *. x1) + (w2 *. x2)) / fromInt (w1+w2)-                    where i *. d = if i == 0 then 0 else fromInt i * d -- since d might be NaN+                    | otherwise = ((w1 *. x1) + (w2 *. x2)) / intToDouble (w1+w2)+                    where i *. d = if i == 0 then 0 else intToDouble i * d -- since d might be NaN -                f divide time count = let xs = count <$> progress in liftA2 (,) xs $ divide (time <$> progress) (fromInt <$> xs)+                f divide time count = let xs = count <$> progress in liftA2 (,) xs $ divide (time <$> progress) (intToDouble <$> xs)          -- Number of seconds work remaining, ignoring multiple threads         todo = f <$> progress <*> ruleTime@@ -216,12 +212,12 @@ progressDisplay :: Double -> (String -> IO ()) -> IO Progress -> IO () progressDisplay sample disp prog = do     disp "Starting..." -- no useful info at this stage-    time <- fmap (fromRational . toRational) <$> offsetTime+    time <- offsetTime     catchJust (\x -> if x == ThreadKilled then Just () else Nothing) (loop time $ message echoMealy) (const $ disp "Finished")     where         loop :: IO Double -> Mealy (Double, Progress) (Double, Double, String) -> IO ()         loop time mealy = do-            sleep $ fromRational $ toRational sample+            sleep sample             p <- prog             t <- time             ((secs,perc,debug), mealy) <- return $ runMealy mealy (t, p)

@@ -104,9 +104,9 @@   -- call a function after a certain delay-waiter :: Double -> IO () -> IO ()+waiter :: Duration -> IO () -> IO () waiter period act = void $ forkIO $ do-    sleep $ fromRational $ toRational period+    sleep period     act  -- Make sure the pool cannot run try until after you have finished with it

@@ -1,7 +1,8 @@ {-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-}  module General.Base(-    Duration, duration, Time, offsetTime, offsetTimeIncrease, sleep,+    Duration, duration, Time, diffTime, offsetTime, offsetTimeIncrease, sleep,+    intToDouble, floatToDouble, doubleToFloat,     isWindows, getProcessorCount,     readFileStrict, readFileUCS2, getEnvMaybe, captureOutput, getExePath,     randomElem,@@ -41,15 +42,18 @@ --------------------------------------------------------------------- -- Data.Time -type Time = Float -- how far you are through this run, in seconds+type Time = Double -- how far you are through this run, in seconds +diffTime :: UTCTime -> UTCTime -> Duration+diffTime end start = fromRational $ toRational $ end `diffUTCTime` start+ -- | Call once at the start, then call repeatedly to get Time values out offsetTime :: IO (IO Time) offsetTime = do     start <- getCurrentTime     return $ do         end <- getCurrentTime-        return $ fromRational $ toRational $ end `diffUTCTime` start+        return $ diffTime end start  -- | Like offsetTime, but results will never decrease (though they may stay the same) offsetTimeIncrease :: IO (IO Time)@@ -61,7 +65,7 @@         atomicModifyIORef ref $ \o -> let m = max t o in m `seq` (m, m)  -type Duration = Float -- duration in seconds+type Duration = Double -- duration in seconds  duration :: IO a -> IO (Duration, a) duration act = do@@ -73,6 +77,19 @@  sleep :: Duration -> IO () sleep x = threadDelay $ ceiling $ x * 1000000+++---------------------------------------------------------------------+-- Numeric++intToDouble :: Int -> Double+intToDouble = fromInteger . toInteger++floatToDouble :: Float -> Double+floatToDouble = fromRational . toRational++doubleToFloat :: Double -> Float+doubleToFloat = fromRational . toRational   ---------------------------------------------------------------------

@@ -43,7 +43,7 @@         progress x = let i = floor $ x * 25 // mx in replicate i '=' ++ replicate (25-i) ' '         mx = maximum $ map snd xs         sm = sum $ map snd xs-        xs = [ (name, fromRational $ toRational $ stop `diffUTCTime` start)+        xs = [ (name, stop `diffTime` start)              | ((start, name), stop) <- zip times $ map fst (drop 1 times) ++ [stop]]  

@@ -8,7 +8,6 @@ import Control.Monad import Data.List import Data.Maybe-import Data.Time import System.Environment import System.Exit import System.Random@@ -35,7 +34,7 @@      let randomSleep = liftIO $ do             i <- randomRIO (0, 25)-            sleep $ fromInteger i / 100+            sleep $ intToDouble i / 100      forM_ (map read $ filter (isNothing . asDuration) args) $ \x -> case x of         Want xs -> want $ map (toFile . Output) xs@@ -59,10 +58,10 @@     limit <- do         args <- getArgs         let bound = listToMaybe $ reverse $ mapMaybe asDuration args-        start <- getCurrentTime+        time <- offsetTime         return $ when (isJust bound) $ do-            now <- getCurrentTime-            when (fromRational (toRational $ now `diffUTCTime` start) > fromJust bound) exitSuccess+            now <- time+            when (now > fromJust bound) exitSuccess      forM_ [1..] $ \count -> do         limit

@@ -1,7 +1,7 @@ cabal-version:      >= 1.10 build-type:         Simple name:               shake-version:            0.13.3+version:            0.13.4 license:            BSD3 license-file:       LICENSE category:           Development@@ -51,12 +51,6 @@     docs/Ninja.md     docs/Why.md     docs/shake-progress.png-    docs/manual/build.bat-    docs/manual/Build.hs-    docs/manual/build.sh-    docs/manual/constants.c-    docs/manual/constants.h-    docs/manual/main.c     js-src/jquery-1.8.3.js     js-src/flot-0.8.0.zip @@ -71,6 +65,12 @@     html/shake-progress.js     html/shake-ui.js     html/shake-util.js+    docs/manual/build.bat+    docs/manual/Build.hs+    docs/manual/build.sh+    docs/manual/constants.c+    docs/manual/constants.h+    docs/manual/main.c  source-repository head     type:     git