shake 0.2.8 → 0.2.9
raw patch · 10 files changed
+257/−82 lines, 10 filesdep ~transformersdep ~unordered-containers
Dependency ranges changed: transformers, unordered-containers
Files
- Development/Shake/Core.hs +4/−3
- Development/Shake/Derived.hs +1/−1
- Development/Shake/Files.hs +38/−2
- Development/Shake/Locks.hs +5/−1
- Examples/Test/Basic.hs +61/−0
- Examples/Test/Basic1.hs +0/−61
- Examples/Test/Files.hs +14/−6
- Examples/Test/Random.hs +123/−0
- Main.hs +6/−4
- shake.cabal +5/−4
Development/Shake/Core.hs view
@@ -36,7 +36,7 @@ -- | Options to control the execution of Shake, usually specified by overriding fields in -- 'shakeOptions': ----- @ 'shakeOptions'{'shakeThreads'=4, 'shakeDump'=True}@+-- @ 'shakeOptions'{'shakeThreads'=4, 'shakeReport'=Just "report.html"} @ data ShakeOptions = ShakeOptions {shakeFiles :: FilePath -- ^ Where shall I store the database and journal files (defaults to @.shake@). ,shakeThreads :: Int -- ^ What is the maximum number of rules I should run in parallel (defaults to @1@).@@ -252,7 +252,8 @@ when (isJust shakeReport) $ do let file = fromJust shakeReport json <- showJSON database- output $ "Writing HTML report to " ++ file+ when (shakeVerbosity >= Normal) $+ putStrLn $ "Writing HTML report to " ++ file buildReport json file maybe (return ()) throwIO =<< readVar except @@ -346,7 +347,7 @@ -- | Write an action to the trace list, along with the start/end time of running the IO action. -- The 'Develoment.Shake.system'' command automatically calls 'traced'. The trace list is used for profile reports--- (see 'shakeDump').+-- (see 'shakeReport'). traced :: String -> IO a -> Action a traced msg act = Action $ do s <- get
Development/Shake/Derived.hs view
@@ -34,7 +34,7 @@ putLoud cmd (res,stdout,stderr) <- traced ("system' " ++ cmd) $ readProcessWithExitCode path2 args "" when (res /= ExitSuccess) $- error $ "System command failed:\n" ++ cmd+ error $ "System command failed:\n" ++ cmd ++ "\n" ++ stderr return (stdout, stderr)
Development/Shake/Files.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveDataTypeable #-} module Development.Shake.Files(- (*>>)+ (?>>), (*>>) ) where import Control.DeepSeq@@ -9,6 +9,7 @@ import Control.Monad.IO.Class import Data.Binary import Data.Hashable+import Data.Maybe import Data.Typeable import Development.Shake.Core@@ -16,7 +17,7 @@ import Development.Shake.FilePattern import Development.Shake.FileTime -infix 1 *>>+infix 1 ?>>, *>> newtype Files = Files [FilePath]@@ -57,4 +58,39 @@ return () rule $ \(Files xs) -> if not $ length xs == length ps && and (zipWith (?==) ps xs) then Nothing else Just $ do act xs+ liftIO $ fmap FileTimes $ mapM (getModTimeError "Error, *>> failed to build the file:") xs+++-- | Define a rule for building multiple files at the same time, a more powerful+-- and more dangerous version of '*>>'.+--+-- Given an application @test ?>> ...@, @test@ should return @Just@ if the rule applies, and should+-- return the list of files that will be produced. This list /must/ include the file passed as an argument and should+-- obey the invariant:+--+-- > test x == Just ys ==> x `elem` ys && all ((== Just ys) . test) ys+--+-- As an example of a function satisfying the invariaint:+--+-- > test x | takeExtension x `elem` [".hi",".o"]+-- > = Just [dropExtension x <.> "hi", dropExtension x <.> "o"]+-- > test _ = Nothing+--+-- Regardless of whether @Foo.hi@ or @Foo.o@ is passed, the function always returns @[Foo.hi, Foo.o]@.+(?>>) :: (FilePath -> Maybe [FilePath]) -> ([FilePath] -> Action ()) -> Rules ()+(?>>) test act = do+ let checkedTest x = case test x of+ Nothing -> Nothing+ Just ys | x `elem` ys && all ((== Just ys) . test) ys -> Just ys+ | otherwise -> error $ "Invariant broken in ?>> when trying on " ++ x++ isJust . checkedTest ?> \x -> do+ apply1 $ Files $ fromJust $ test x :: Action FileTimes+ return ()++ rule $ \(Files xs@(x:_)) -> case checkedTest x of+ Just ys | ys == xs -> Just $ do+ act xs liftIO $ fmap FileTimes $ mapM (getModTimeError "Error, multi rule failed to build the file:") xs+ Just ys -> error $ "Error, ?>> is incompatible with " ++ show xs ++ " vs " ++ show ys+ Nothing -> Nothing
Development/Shake/Locks.hs view
@@ -82,7 +82,11 @@ -- @ -- -- Now the two calls to @excel@ will not happen in parallel. Using 'Resource'--- is better than 'MVar' as it will not block any other threads from executing.+-- is better than 'MVar' as it will not block any other threads from executing. Be careful that the+-- actions run within 'Development.Shake.withResource' do not themselves require further quantities of this resource, or+-- you may get a \"thread blocked indefinitely in an MVar operation\" exception. Typically only+-- system commands (such as 'Development.Shake.system'') will be run inside 'Development.Shake.withResource',+-- not commands such as 'Development.Shake.need'. -- -- As another example, calls to compilers are usually CPU bound but calls to linkers are usually -- disk bound. Running 8 linkers will often cause an 8 CPU system to grid to a halt. We can limit
+ Examples/Test/Basic.hs view
@@ -0,0 +1,61 @@++module Examples.Test.Basic(main) where++import Development.Shake+import Examples.Util+import System.Directory+++main = shaken test $ \args obj -> do+ want $ map obj args+ obj "AB.txt" *> \out -> do+ need [obj "A.txt", obj "B.txt"]+ text1 <- readFile' $ obj "A.txt"+ text2 <- readFile' $ obj "B.txt"+ writeFile' out $ text1 ++ text2++ obj "twice.txt" *> \out -> do+ let src = obj "once.txt"+ need [src, src]+ copyFile' src out++ obj "once.txt" *> \out -> do+ src <- readFile' $ obj "zero.txt"+ writeFile' out src+++test build obj = do+ let f b pat file = assert (b == (pat ?== file)) $ show pat ++ " ?== " ++ show file ++ "\nEXPECTED: " ++ show b+ f True "//*.c" "foo/bar/baz.c"+ f True "*.c" "baz.c"+ f True "//*.c" "baz.c"+ f True "test.c" "test.c"+ f False "*.c" "foor/bar.c"+ f False "*/*.c" "foo/bar/baz.c"++ writeFile (obj "A.txt") "AAA"+ writeFile (obj "B.txt") "BBB"+ build ["AB.txt"]+ assertContents (obj "AB.txt") "AAABBB"+ sleepFileTime+ appendFile (obj "A.txt") "aaa"+ build ["AB.txt"]+ assertContents (obj "AB.txt") "AAAaaaBBB"++ writeFile (obj "zero.txt") "xxx"+ build ["twice.txt"]+ assertContents (obj "twice.txt") "xxx"+ sleepFileTime+ writeFile (obj "zero.txt") "yyy"+ build ["once.txt"]+ assertContents (obj "twice.txt") "xxx"+ assertContents (obj "once.txt") "yyy"+ sleepFileTime+ writeFile (obj "zero.txt") "zzz"+ build ["once.txt","twice.txt"]+ assertContents (obj "twice.txt") "zzz"+ assertContents (obj "once.txt") "zzz"++ removeFile $ obj "twice.txt"+ build ["twice.txt"]+ assertContents (obj "twice.txt") "zzz"
− Examples/Test/Basic1.hs
@@ -1,61 +0,0 @@--module Examples.Test.Basic1(main) where--import Development.Shake-import Examples.Util-import System.Directory---main = shaken test $ \args obj -> do- want $ map obj args- obj "AB.txt" *> \out -> do- need [obj "A.txt", obj "B.txt"]- text1 <- readFile' $ obj "A.txt"- text2 <- readFile' $ obj "B.txt"- writeFile' out $ text1 ++ text2-- obj "twice.txt" *> \out -> do- let src = obj "once.txt"- need [src, src]- copyFile' src out-- obj "once.txt" *> \out -> do- src <- readFile' $ obj "zero.txt"- writeFile' out src---test build obj = do- let f b pat file = assert (b == (pat ?== file)) $ show pat ++ " ?== " ++ show file ++ "\nEXPECTED: " ++ show b- f True "//*.c" "foo/bar/baz.c"- f True "*.c" "baz.c"- f True "//*.c" "baz.c"- f True "test.c" "test.c"- f False "*.c" "foor/bar.c"- f False "*/*.c" "foo/bar/baz.c"-- writeFile (obj "A.txt") "AAA"- writeFile (obj "B.txt") "BBB"- build ["AB.txt"]- assertContents (obj "AB.txt") "AAABBB"- sleepFileTime- appendFile (obj "A.txt") "aaa"- build ["AB.txt"]- assertContents (obj "AB.txt") "AAAaaaBBB"-- writeFile (obj "zero.txt") "xxx"- build ["twice.txt"]- assertContents (obj "twice.txt") "xxx"- sleepFileTime- writeFile (obj "zero.txt") "yyy"- build ["once.txt"]- assertContents (obj "twice.txt") "xxx"- assertContents (obj "once.txt") "yyy"- sleepFileTime- writeFile (obj "zero.txt") "zzz"- build ["once.txt","twice.txt"]- assertContents (obj "twice.txt") "zzz"- assertContents (obj "once.txt") "zzz"-- removeFile $ obj "twice.txt"- build ["twice.txt"]- assertContents (obj "twice.txt") "zzz"
Examples/Test/Files.hs view
@@ -4,12 +4,18 @@ import Development.Shake import Development.Shake.FilePattern import Examples.Util+import Control.Monad import Data.List main = shaken test $ \args obj -> do want $ map obj ["even.txt","odd.txt"]- map obj ["even.txt","odd.txt"] *>> \[evens,odds] -> do++ let deps = map obj ["even.txt","odd.txt"]+ let def | "fun" `elem` args = (?>>) (\x -> if x `elem` deps then Just deps else Nothing)+ | otherwise = (*>>) deps++ def $ \[evens,odds] -> do src <- readFileLines $ obj "numbers.txt" let (es,os) = partition even $ map read src writeFileLines evens $ map show es@@ -26,8 +32,10 @@ substitute ["","test","da"] "//*a*.txt" === "testada.txt" substitute ["foo/bar/","test"] "//*a.txt" === "foo/bar/testa.txt" - let nums = unlines . map show- writeFile (obj "numbers.txt") $ nums [1,2,4,5,2,3,1]- build []- assertContents (obj "even.txt") $ nums [2,4,2]- assertContents (obj "odd.txt" ) $ nums [1,5,3,1]+ forM_ [[],["fun"]] $ \args -> do+ sleepFileTime+ let nums = unlines . map show+ writeFile (obj "numbers.txt") $ nums [1,2,4,5,2,3,1]+ build args+ assertContents (obj "even.txt") $ nums [2,4,2]+ assertContents (obj "odd.txt" ) $ nums [1,5,3,1]
+ Examples/Test/Random.hs view
@@ -0,0 +1,123 @@++module Examples.Test.Random(main) where++import Development.Shake+import Examples.Util+import Control.Exception+import Control.Monad+import Data.List+import System.Random+import System.Mem+++inputRange = [1..10]++data Value = Single Int | Multiple [[Value]]+ deriving (Read,Show,Eq)++data Source = Input Int | Output Int | Bang+ deriving (Read,Show)++data Logic = Logic Int [[Source]]+ | Want [Int]+ deriving (Read,Show)+++main = shaken test $ \args obj -> do+ let toFile (Input i) = obj $ "input-" ++ show i ++ ".txt"+ toFile (Output i) = obj $ "output-" ++ show i ++ ".txt"+ toFile Bang = error "BANG"++ let randomSleep = liftIO $ do+ i <- randomRIO (0, 25)+ sleep $ fromInteger i / 100++ forM_ (map read args) $ \x -> case x of+ Want xs -> want $ map (toFile . Output) xs+ Logic out srcs -> toFile (Output out) *> \out -> do+ res <- fmap (show . Multiple) $ forM srcs $ \src -> do+ randomSleep+ need $ map toFile src+ mapM (liftIO . fmap read . readFile . toFile) src+ randomSleep+ writeFileChanged out res+++test build obj = forM_ [1..] $ \count -> do+ putStrLn $ "* PERFORMING RANDOM TEST " ++ show count+ performGC -- close any handles left by crashing+ build ["clean"]+ build [] -- to create the directory+ forM inputRange $ \i ->+ writeFile (obj $ "input-" ++ show i ++ ".txt") $ show $ Single i+ logic <- randomLogic+ runLogic [] logic+ chng <- filterM (const randomIO) inputRange + forM chng $ \i ->+ writeFile (obj $ "input-" ++ show i ++ ".txt") $ show $ Single $ negate i+ runLogic chng logic+ forM inputRange $ \i ->+ writeFile (obj $ "input-" ++ show i ++ ".txt") $ show $ Single i+ logic <- addBang =<< addBang logic+ j <- randomRIO (1::Int,8)+ res <- try $ build $ ("--threads" ++ show j) : map show (logic ++ [Want [i | Logic i _ <- logic]]) + case res of+ Left err+ | "BANG" `isInfixOf` show (err :: SomeException) -> return () -- error I expected+ | otherwise -> error $ "UNEXPECTED ERROR: " ++ show err+ _ -> return () -- occasionally we only put BANG in places with no dependenies that don't get rebuilt+ where+ runLogic :: [Int] -> [Logic] -> IO ()+ runLogic negated xs = do+ let poss = [i | Logic i _ <- xs]+ i <- randomRIO (0, 7)+ wants <- replicateM i $ do+ i <- randomRIO (0, 5)+ replicateM i $ randomElem poss+ sleepFileTime+ j <- randomRIO (1::Int,8)+ build $ ("--threads" ++ show j) : map show (xs ++ map Want wants)++ let value i = case [ys | Logic j ys <- xs, j == i] of+ [ys] -> Multiple $ flip map ys $ map $ \i -> case i of+ Input i -> Single $ if i `elem` negated then negate i else i+ Output i -> value i+ forM_ (concat wants) $ \i -> do+ let wanted = value i+ got <- fmap read $ readFile $ obj $ "output-" ++ show i ++ ".txt"+ when (wanted /= got) $+ error $ "INCORRECT VALUE for " ++ show i+++addBang :: [Logic] -> IO [Logic]+addBang xs = do+ i <- randomRIO (0, length xs - 1)+ let (before,now:after) = splitAt i xs+ now <- f now+ return $ before ++ now : after+ where+ f (Logic log xs) = do+ i <- randomRIO (0, length xs)+ let (before,after) = splitAt i xs+ return $ Logic log $ before ++ [Bang] : after+++randomLogic :: IO [Logic] -- only Logic constructors+randomLogic = do+ rules <- randomRIO (1,100)+ f rules $ map Input inputRange+ where+ f 0 avail = return []+ f i avail = do+ needs <- randomRIO (0,3)+ xs <- replicateM needs $ do+ ns <- randomRIO (0,3)+ replicateM ns $ randomElem avail+ let r = Logic i xs+ fmap (r:) $ f (i-1) (Output i:avail)+++randomElem :: [a] -> IO a+randomElem xs = do+ i <- randomRIO (0, length xs - 1)+ return $ xs !! i
Main.hs view
@@ -7,12 +7,13 @@ import qualified Examples.Tar.Main as Tar import qualified Examples.Self.Main as Self import qualified Examples.C.Main as C-import qualified Examples.Test.Basic1 as Basic1+import qualified Examples.Test.Basic as Basic import qualified Examples.Test.Directory as Directory import qualified Examples.Test.Errors as Errors import qualified Examples.Test.Files as Files import qualified Examples.Test.FilePath as FilePath import qualified Examples.Test.Pool as Pool+import qualified Examples.Test.Random as Random import qualified Examples.Test.Resources as Resources @@ -20,8 +21,9 @@ where (*) = (,) mains = ["tar" * Tar.main, "self" * Self.main, "c" * C.main- ,"basic1" * Basic1.main, "directory" * Directory.main, "errors" * Errors.main- ,"filepath" * FilePath.main, "files" * Files.main, "pool" * Pool.main, "resources" * Resources.main]+ ,"basic" * Basic.main, "directory" * Directory.main, "errors" * Errors.main+ ,"filepath" * FilePath.main, "files" * Files.main, "pool" * Pool.main, "random" * Random.main+ ,"resources" * Resources.main] where (*) = (,) @@ -49,4 +51,4 @@ test :: IO ()-test = sequence_ [withArgs [name,"test"] main | (name,main) <- mains]+test = sequence_ [withArgs [name,"test"] main | (name,main) <- mains, name /= "random"]
shake.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.6 build-type: Simple name: shake-version: 0.2.8+version: 0.2.9 license: BSD3 license-file: LICENSE category: Development@@ -65,10 +65,10 @@ binary, filepath, process,- unordered-containers >= 0.1.4.3 && < 1.2,+ unordered-containers >= 0.2.1 && < 0.3, bytestring, time,- transformers == 0.2.*,+ transformers >= 0.2 && < 0.4, deepseq >= 1.1 && < 1.4 exposed-modules:@@ -107,10 +107,11 @@ Examples.C.Main Examples.Self.Main Examples.Tar.Main- Examples.Test.Basic1+ Examples.Test.Basic Examples.Test.Directory Examples.Test.Errors Examples.Test.FilePath Examples.Test.Files Examples.Test.Pool+ Examples.Test.Random Examples.Test.Resources