Hello community, here is the log from the commit of package shake for openSUSE:Factory checked in at 2016-06-14 23:08:37 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/shake (Old) and /work/SRC/openSUSE:Factory/.shake.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "shake" Changes: -------- --- /work/SRC/openSUSE:Factory/shake/shake.changes 2016-06-07 23:48:14.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.shake.new/shake.changes 2016-06-14 23:08:39.000000000 +0200 @@ -1,0 +2,8 @@ +Mon Jun 13 12:56:31 UTC 2016 - [email protected] + +- update to 0.15.9 +* Documentation tweaks +* Optimise the thread pool +* Fix progress output through wget + +------------------------------------------------------------------- Old: ---- shake-0.15.8.tar.gz New: ---- shake-0.15.9.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ shake.spec ++++++ --- /var/tmp/diff_new_pack.rJw2om/_old 2016-06-14 23:08:40.000000000 +0200 +++ /var/tmp/diff_new_pack.rJw2om/_new 2016-06-14 23:08:40.000000000 +0200 @@ -19,7 +19,7 @@ %global pkg_name shake %bcond_with tests Name: shake -Version: 0.15.8 +Version: 0.15.9 Release: 0 Summary: Build system library, like Make, but more accurate dependencies Group: Development/Languages/Other ++++++ shake-0.15.8.tar.gz -> shake-0.15.9.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/shake-0.15.8/CHANGES.txt new/shake-0.15.9/CHANGES.txt --- old/shake-0.15.8/CHANGES.txt 2016-06-01 19:58:04.000000000 +0200 +++ new/shake-0.15.9/CHANGES.txt 2016-06-12 14:05:32.000000000 +0200 @@ -1,5 +1,9 @@ Changelog for Shake +0.15.9 + Documentation tweaks + Optimise the thread pool + Fix progress output through wget 0.15.8 Extra base bounds to rule out building on GHC 7.4 0.15.7 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/shake-0.15.8/docs/Manual.md new/shake-0.15.9/docs/Manual.md --- old/shake-0.15.8/docs/Manual.md 2016-06-01 19:58:04.000000000 +0200 +++ new/shake-0.15.9/docs/Manual.md 2016-06-12 14:05:33.000000000 +0200 @@ -288,7 +288,7 @@ This script creates a folder named `_shake` for the build system objects to live in, then runs `ghc --make Build.hs` to produce `_shake/build`, then executes `_shake/build` with all arguments it was given. The `-with-rtsopts` flag instructs the Haskell compiler to disable "idle garbage collection", making more CPU available for the commands you are running, as [explained here](http://stackoverflow.com/questions/34588057/why-does-shake-recommend-disabling-idle-garbage-collection/). -Now you can run a build by simply typing `./build.sh` on Linux, or `build` on Windows. On Linux you may want to alias `build` to `./build.sh`. For the rest of this document we will assume `build` runs the build system. +Now you can run a build by simply typing `stack exec ./build.sh` on Linux, or `stack exec build.bat` on Windows. On Linux you may want to alias `build` to `stack exec ./build.sh`. For the rest of this document we will assume `build` runs the build system. _Warning:_ You should not use the `-threaded` for GHC 7.6 or below because of a [GHC bug](https://ghc.haskell.org/trac/ghc/ticket/7646). If you do turn on `-threaded`, you should include `-qg -qb` in `-with-rtsopts`. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/shake-0.15.8/shake.cabal new/shake-0.15.9/shake.cabal --- old/shake-0.15.8/shake.cabal 2016-06-01 19:58:04.000000000 +0200 +++ new/shake-0.15.9/shake.cabal 2016-06-12 14:05:32.000000000 +0200 @@ -1,7 +1,7 @@ cabal-version: >= 1.10 build-type: Simple name: shake -version: 0.15.8 +version: 0.15.9 license: BSD3 license-file: LICENSE category: Development, Shake @@ -232,6 +232,7 @@ Development.Shake.Profile Development.Shake.Progress Development.Shake.Resource + Development.Shake.Rule Development.Shake.Rules.Directory Development.Shake.Rules.File Development.Shake.Rules.Files diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/shake-0.15.8/src/Development/Shake/Command.hs new/shake-0.15.9/src/Development/Shake/Command.hs --- old/shake-0.15.8/src/Development/Shake/Command.hs 2016-06-01 19:58:03.000000000 +0200 +++ new/shake-0.15.9/src/Development/Shake/Command.hs 2016-06-12 14:05:32.000000000 +0200 @@ -410,6 +410,7 @@ -- suitable for user diagnostics, but not for direct execution. newtype CmdLine = CmdLine {fromCmdLine :: String} +-- | The allowable 'String'-like values that can be captured. class CmdString a where cmdString :: (Str, Str -> a) instance CmdString () where cmdString = (Unit, \Unit -> ()) instance CmdString String where cmdString = (Str "", \(Str x) -> x) @@ -560,6 +561,7 @@ cmd :: CmdArguments args => args :-> Action r cmd = cmdArguments [] +-- | The arguments to 'cmd' - see 'cmd' for examples and semantics. class CmdArguments t where cmdArguments :: [Either CmdOption String] -> t instance (Arg a, CmdArguments r) => CmdArguments (a -> r) where cmdArguments xs x = cmdArguments $ xs ++ arg x diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/shake-0.15.8/src/Development/Shake/Database.hs new/shake-0.15.9/src/Development/Shake/Database.hs --- old/shake-0.15.8/src/Development/Shake/Database.hs 2016-06-01 19:58:03.000000000 +0200 +++ new/shake-0.15.9/src/Development/Shake/Database.hs 2016-06-12 14:05:32.000000000 +0200 @@ -81,38 +81,41 @@ --------------------------------------------------------------------- -- CENTRAL TYPES -data Trace = Trace BS Float Float -- (message, start, end) +data Trace = Trace BS Float Float -- ^ (message, start, end) deriving Show instance NFData Trace where rnf (Trace a b c) = rnf a `seq` rnf b `seq` rnf c +type StatusDB = IORef (Map Id (Key, Status)) +type InternDB = IORef (Intern Key) + -- | Invariant: The database does not have any cycles where a Key depends on itself data Database = Database {lock :: Lock - ,intern :: IORef (Intern Key) - ,status :: IORef (Map Id (Key, Status)) + ,intern :: InternDB + ,status :: StatusDB ,step :: Step ,journal :: Id -> (Key, Status {- Loaded or Missing -}) -> IO () - ,diagnostic :: String -> IO () -- logging function + ,diagnostic :: String -> IO () -- ^ logging function ,assume :: Maybe Assume } data Status - = Ready Result -- I have a value - | Error SomeException -- I have been run and raised an error - | Loaded Result -- Loaded from the database - | Waiting Pending (Maybe Result) -- Currently checking if I am valid or building - | Missing -- I am only here because I got into the Intern table + = Ready Result -- ^ I have a value + | Error SomeException -- ^ I have been run and raised an error + | Loaded Result -- ^ Loaded from the database + | Waiting Pending (Maybe Result) -- ^ Currently checking if I am valid or building + | Missing -- ^ I am only here because I got into the Intern table deriving Show data Result = Result - {result :: Value -- the result associated with the Key - ,built :: {-# UNPACK #-} !Step -- when it was actually run - ,changed :: {-# UNPACK #-} !Step -- the step for deciding if it's valid - ,depends :: [[Id]] -- dependencies (outer list is a strict ordered series, inner list is parallel) - ,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) + {result :: Value -- ^ the result associated with the Key + ,built :: {-# UNPACK #-} !Step -- ^ when it was actually run + ,changed :: {-# UNPACK #-} !Step -- ^ the step for deciding if it's valid + ,depends :: [[Id]] -- ^ dependencies (don't run them early) + ,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 @@ -146,9 +149,9 @@ runWaiting :: Waiting -> IO () runWaiting (Waiting (Pending p) _) = join $ readIORef p --- Wait for a set of actions to complete --- If the action returns True, the function will not be called again --- If the first argument is True, the thing is ended +-- | Wait for a set of actions to complete. +-- If the action returns True, the function will not be called again. +-- If the first argument is True, the thing is ended. waitFor :: [(a, Waiting)] -> (Bool -> a -> IO Bool) -> IO () waitFor ws@(_:_) act = do todo <- newIORef $ length ws @@ -183,19 +186,25 @@ } +internKey :: InternDB -> StatusDB -> Key -> IO Id +internKey intern status k = do + is <- readIORef intern + case Intern.lookup k is of + Just i -> return i + Nothing -> do + (is, i) <- return $ Intern.add k is + writeIORef' intern is + modifyIORef' status $ Map.insert i (k,Missing) + return i + +queryKey :: StatusDB -> Id -> IO (Maybe (Key, Status)) +queryKey status i = Map.lookup i <$> readIORef status + -- | Return either an exception (crash), or (how much time you spent waiting, the value) build :: Pool -> Database -> Ops -> Stack -> [Key] -> Capture (Either SomeException (Seconds,Depends,[Value])) build pool database@Database{..} Ops{..} stack ks continue = join $ withLock lock $ do - is <- forM ks $ \k -> do - is <- readIORef intern - case Intern.lookup k is of - Just i -> return i - Nothing -> do - (is, i) <- return $ Intern.add k is - writeIORef' intern is - modifyIORef' status $ Map.insert i (k,Missing) - return i + is <- forM ks $ internKey intern status whenJust (checkStack is stack) $ \bad -> do -- everything else gets thrown via Left and can be Staunch'd @@ -245,8 +254,8 @@ reduce :: Stack -> Id -> IO Status reduce stack i = do - s <- readIORef status - case Map.lookup i s of + s <- queryKey status i + case s of Nothing -> err $ "interned value missing from database, " ++ show i Just (k, Missing) -> run stack i k Nothing Just (k, Loaded r) -> do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/shake-0.15.8/src/Development/Shake/FilePattern.hs new/shake-0.15.9/src/Development/Shake/FilePattern.hs --- old/shake-0.15.8/src/Development/Shake/FilePattern.hs 2016-06-01 19:58:03.000000000 +0200 +++ new/shake-0.15.9/src/Development/Shake/FilePattern.hs 2016-06-12 14:05:32.000000000 +0200 @@ -207,7 +207,7 @@ -- but @file.h@ and @dir\/file.c@ don't. -- -- * @\/\/*.c@ matches all @.c@ files anywhere on the filesystem, ---- so @file.c@, @dir\/file.c@, @dir1\/dir2\/file.c@ and @/path/to/file.c@ all match, +-- so @file.c@, @dir\/file.c@, @dir1\/dir2\/file.c@ and @\/path\/to\/file.c@ all match, -- but @file.h@ and @dir\/file.h@ don't. -- -- * @dir\/*\/*@ matches all files one level below @dir@, so @dir\/one\/file.c@ and diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/shake-0.15.8/src/Development/Shake/Pool.hs new/shake-0.15.9/src/Development/Shake/Pool.hs --- old/shake-0.15.8/src/Development/Shake/Pool.hs 2016-06-01 19:58:03.000000000 +0200 +++ new/shake-0.15.9/src/Development/Shake/Pool.hs 2016-06-12 14:05:32.000000000 +0200 @@ -7,7 +7,6 @@ ) where import Control.Concurrent.Extra -import Development.Shake.Errors import System.Time.Extra import Control.Exception import Control.Monad @@ -24,25 +23,27 @@ type NonDet a = IO a -- Left = deterministic list, Right = non-deterministic tree -data Queue a = Queue [a] (Either [a] (Maybe (Tree a))) +data Queue a = Queue [a] (Either [a] (Tree a)) newQueue :: Bool -> Queue a -newQueue deterministic = Queue [] $ if deterministic then Left [] else Right Nothing +newQueue deterministic = Queue [] $ if deterministic then Left [] else Right emptyTree enqueuePriority :: a -> Queue a -> Queue a enqueuePriority x (Queue p t) = Queue (x:p) t enqueue :: a -> Queue a -> Queue a enqueue x (Queue p (Left xs)) = Queue p $ Left $ x:xs -enqueue x (Queue p (Right Nothing)) = Queue p $ Right $ Just $ singleTree x -enqueue x (Queue p (Right (Just t))) = Queue p $ Right $ Just $ insertTree x t +enqueue x (Queue p (Right t)) = Queue p $ Right $ insertTree x t -dequeue :: Queue a -> Maybe (NonDet (a, Queue a)) -dequeue (Queue (p:ps) t) = Just $ return (p, Queue ps t) -dequeue (Queue [] (Left (x:xs))) = Just $ return (x, Queue [] $ Left xs) -dequeue (Queue [] (Left [])) = Nothing -dequeue (Queue [] (Right (Just t))) = Just $ do bs <- randomIO; (x,t) <- return $ removeTree bs t; return (x, Queue [] $ Right t) -dequeue (Queue [] (Right Nothing)) = Nothing +dequeue :: Queue a -> NonDet (Maybe (a, Queue a)) +dequeue (Queue (p:ps) t) = return $ Just (p, Queue ps t) +dequeue (Queue [] (Left (x:xs))) = return $ Just (x, Queue [] $ Left xs) +dequeue (Queue [] (Left [])) = return Nothing +dequeue (Queue [] (Right t)) = do + bs <- randomIO + return $ case removeTree bs t of + Nothing -> Nothing + Just (x,t) -> Just (x, Queue [] $ Right t) --------------------------------------------------------------------- @@ -51,19 +52,20 @@ -- A tree where removal is random. Nodes are stored at indicies 0..n-1 data Tree a = Tree {-# UNPACK #-} !Int (Map.HashMap Int a) -singleTree :: a -> Tree a -singleTree x = Tree 1 $ Map.singleton 0 x + +emptyTree :: Tree a +emptyTree = Tree 0 Map.empty insertTree :: a -> Tree a -> Tree a insertTree x (Tree n mp) = Tree (n+1) $ Map.insert n x mp -- Remove an item at random, put the n-1 item to go in it's place -removeTree :: Int -> Tree a -> (a, Maybe (Tree a)) +removeTree :: Int -> Tree a -> Maybe (a, Tree a) removeTree rnd (Tree n mp) - | n == 0 = err "removeTree, tree is empty" - | n == 1 = (mp Map.! 0, Nothing) - | i == n-1 = (mp Map.! i, Just $ Tree (n-1) $ Map.delete i mp) - | otherwise = (mp Map.! i, Just $ Tree (n-1) $ Map.insert i (mp Map.! (n-1)) $ Map.delete (n-1) mp) + | n == 0 = Nothing + | n == 1 = Just (mp Map.! 0, emptyTree) + | i == n-1 = Just (mp Map.! i, Tree (n-1) $ Map.delete i mp) + | otherwise = Just (mp Map.! i, Tree (n-1) $ Map.insert i (mp Map.! (n-1)) $ Map.delete (n-1) mp) where i = abs rnd `mod` n @@ -97,7 +99,7 @@ worker pool@(Pool var done) = do let onVar act = modifyVar var $ maybe (return (Nothing, return ())) act join $ onVar $ \s -> do - res <- maybe (return Nothing) (fmap Just) $ dequeue $ todo s + res <- dequeue $ todo s case res of Nothing -> return (Just s, return ()) Just (now, todo2) -> return (Just s{todo = todo2}, now >> worker pool) @@ -110,7 +112,7 @@ let onVar act = modifyVar_ var $ maybe (return Nothing) act onVar $ \s -> do s <- op s - res <- maybe (return Nothing) (fmap Just) $ dequeue $ todo s + res <- dequeue $ todo s case res of Just (now, todo2) | Set.size (threads s) < threadsLimit s -> do -- spawn a new worker diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/shake-0.15.8/src/Development/Shake/Rules/Directory.hs new/shake-0.15.9/src/Development/Shake/Rules/Directory.hs --- old/shake-0.15.8/src/Development/Shake/Rules/Directory.hs 2016-06-01 19:58:03.000000000 +0200 +++ new/shake-0.15.9/src/Development/Shake/Rules/Directory.hs 2016-06-12 14:05:32.000000000 +0200 @@ -228,6 +228,7 @@ -- | Get the directories in a directory, not including @.@ or @..@. -- All directories are relative to the argument directory. The result is tracked as a -- dependency, and if it changes the rule will rerun in subsequent builds. +-- The rules about creating entries described in 'getDirectoryFiles' also apply here. -- -- > getDirectoryDirs "/Users" -- > -- Return all directories in the /Users directory diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/shake-0.15.8/src/Development/Shake/Rules/File.hs new/shake-0.15.9/src/Development/Shake/Rules/File.hs --- old/shake-0.15.8/src/Development/Shake/Rules/File.hs 2016-06-01 19:58:03.000000000 +0200 +++ new/shake-0.15.9/src/Development/Shake/Rules/File.hs 2016-06-12 14:05:32.000000000 +0200 @@ -237,7 +237,7 @@ -- | Infix operator alias for 'phony', for sake of consistency with normal -- rules. (~>) :: String -> Action () -> Rules () -(~>) = phony +(~>) = phony -- | Define a rule to build files. If the first argument returns 'True' for a given file, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/shake-0.15.8/src/Development/Shake/Types.hs new/shake-0.15.9/src/Development/Shake/Types.hs --- old/shake-0.15.8/src/Development/Shake/Types.hs 2016-06-01 19:58:03.000000000 +0200 +++ new/shake-0.15.9/src/Development/Shake/Types.hs 2016-06-12 14:05:32.000000000 +0200 @@ -111,7 +111,7 @@ ,shakeLintInside :: [FilePath] -- ^ Directories in which the files will be tracked by the linter. ,shakeLintIgnore :: [FilePattern] - -- ^ File patterns which are ignored from linter tracking, a bit like calling 'trackAllow' in every rule. + -- ^ File patterns which are ignored from linter tracking, a bit like calling 'Development.Shake.trackAllow' in every rule. ,shakeCommandOptions :: [CmdOption] -- ^ Defaults to @[]@. Additional options to be passed to all command invocations. ,shakeFlush :: Maybe Double diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/shake-0.15.8/src/General/Process.hs new/shake-0.15.9/src/General/Process.hs --- old/shake-0.15.8/src/General/Process.hs 2016-06-01 19:58:03.000000000 +0200 +++ new/shake-0.15.9/src/General/Process.hs 2016-06-12 14:05:32.000000000 +0200 @@ -163,7 +163,8 @@ let streams = [(outh, stdout, poStdout) | Just outh <- [outh], CreatePipe <- [std_out cp]] ++ [(errh, stderr, poStderr) | Just errh <- [errh], CreatePipe <- [std_err cp]] wait <- forM streams $ \(h, hh, dest) -> do - let isTied = not $ poStdout `disjoint` poStderr + -- no point tying the streams together if one is being streamed directly + let isTied = not (poStdout `disjoint` poStderr) && length streams == 2 let isBinary = not $ any isDestString dest && not (any isDestBytes dest) when isTied $ hSetBuffering h LineBuffering when (DestEcho `elem` dest) $ do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/shake-0.15.8/src/Test/Docs.hs new/shake-0.15.9/src/Test/Docs.hs --- old/shake-0.15.8/src/Test/Docs.hs 2016-06-01 19:58:03.000000000 +0200 +++ new/shake-0.15.9/src/Test/Docs.hs 2016-06-12 14:05:32.000000000 +0200 @@ -68,7 +68,7 @@ ,"import System.Time.Extra" ,"import Data.Maybe" ,"import Data.Monoid" - ,"import Development.Shake hiding ((*>))" + ,"import Development.Shake hiding ((*>),trackAllow)" ,"import Development.Shake.Classes" ,"import Development.Shake.Rule hiding (trackAllow)" ,"import Development.Shake.Util" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/shake-0.15.8/src/Test/Tup.hs new/shake-0.15.9/src/Test/Tup.hs --- old/shake-0.15.8/src/Test/Tup.hs 2016-06-01 19:58:03.000000000 +0200 +++ new/shake-0.15.9/src/Test/Tup.hs 2016-06-12 14:05:32.000000000 +0200 @@ -17,7 +17,7 @@ action $ do keys <- getConfigKeys - need [x -<.> exe | x <- keys, takeExtension x == ".exe"] + need [obj $ x -<.> exe | x <- keys, takeExtension x == ".exe"] let objects dir key = do let f x | takeExtension x == ".c" = obj $ dir </> x -<.> "o"
