shake 0.2 → 0.2.1
raw patch · 8 files changed
+90/−7 lines, 8 filesdep +random
Dependencies added: random
Files
- Development/Shake/Core.hs +1/−0
- Development/Shake/Database.hs +15/−2
- Development/Shake/Derived.hs +1/−1
- Examples/C/Main.hs +28/−0
- Examples/Self/Main.hs +1/−1
- Examples/Util.hs +37/−0
- Main.hs +2/−1
- shake.cabal +5/−2
Development/Shake/Core.hs view
@@ -39,6 +39,7 @@ 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@).+ -- To enable parallelism you may need to compile with @-threaded@. ,shakeVersion :: Int -- ^ What is the version of your build system, increment to force a complete rebuild (defaults to @1@). ,shakeVerbosity :: Verbosity -- ^ What messages to print out (defaults to 'Normal'). ,shakeStaunch :: Bool -- ^ Operate in staunch mode, where building continues even after errors (defaults to 'False').
Development/Shake/Database.hs view
@@ -212,6 +212,8 @@ isReady Ready{} = True isReady _ = False + atom x = let s = show x in if ' ' `elem` s then "(" ++ s ++ ")" else s+ -- Rules for each eval* function -- * Must NOT lock -- * Must have an equal return to what is stored in the db at that point@@ -241,7 +243,9 @@ join $ readIORef pend return ans case ans of- Ready r -> appendJournal journal k r -- leave the DB lock before appending+ Ready r -> do+ logger $ "result " ++ atom k ++ " = " ++ atom (value r)+ appendJournal journal k r -- leave the DB lock before appending _ -> return () k #= Building (Pending pend) r @@ -253,6 +257,7 @@ Nothing -> evalB stack k Nothing Just (Loaded r) -> do b <- valid k (value r)+ logger $ "valid " ++ show b ++ " for " ++ atom k ++ " " ++ atom (value r) if not b then evalB stack k $ Just r else checkREDCB stack k r (depends r) Just res -> return res @@ -353,27 +358,35 @@ jfile = filename <.> "journal" lock <- newLock+ logger $ "readDatabase " ++ dbfile (step, status) <- readDatabase dbfile version step <- return $ incStep step b <- doesFileExist jfile (status,step) <- if not b then return (status,step) else do+ logger $ "replayJournal " ++ jfile status <- replayJournal jfile version status removeFile_ jfile -- the journal potentially things at the current step, so increment my step writeDatabase dbfile version step status+ logger $ "rewriteDatabase " ++ jfile return (status, incStep step) status <- newIORef status journal <- openJournal jfile version+ logger "openDatabase complete" return Database{..} closeDatabase :: Database -> IO () closeDatabase Database{..} = do status <- readIORef status- writeDatabase (filename <.> "database") version step status+ let dbfile = filename <.> "database"+ logger $ "writeDatabase " ++ dbfile+ writeDatabase dbfile version step status+ logger $ "closeJournal" closeJournal journal+ logger "closeDatabase complete" writeDatabase :: FilePath -> Int -> Step -> Map Key Status -> IO ()
Development/Shake/Derived.hs view
@@ -26,7 +26,7 @@ -- | Execute a system command, returning @(stdout,stderr)@. -- This function will raise an error if the exit code is non-zero.--- Before running 'systemOutput'' make sure you 'need' any required files.+-- Before running 'systemOutput' make sure you 'need' any required files. systemOutput :: FilePath -> [String] -> Action (String, String) systemOutput path args = do let path2 = toNative path
+ Examples/C/Main.hs view
@@ -0,0 +1,28 @@++module Examples.C.Main(main) where++import Development.Shake+import Development.Shake.FilePath+import Examples.Util++main = shaken noTest $ \args obj -> do+ let src = "Examples/C"+ want [obj "Main.exe"]++ obj "Main.exe" *> \out -> do+ cs <- getDirectoryFiles src "*.c"+ let os = map (obj . flip replaceExtension "o") cs+ need os+ system' "gcc" $ ["-o",out] ++ os++ obj "*.o" *> \out -> do+ let c = src </> takeBaseName out <.> "c"+ need [c]+ headers <- cIncludes c+ need $ map ((</>) src . takeFileName) headers+ system' "gcc" ["-o",out,"-c",c]++cIncludes :: FilePath -> Action [FilePath]+cIncludes x = do+ (stdout,_) <- systemOutput "gcc" ["-MM",x]+ return $ drop 2 $ words stdout
Examples/Self/Main.hs view
@@ -74,4 +74,4 @@ cabalBuildDepends :: String -> [String] cabalBuildDepends _ = words $ "base transformers binary unordered-containers hashable time old-time bytestring " ++- "filepath directory process deepseq"+ "filepath directory process deepseq random"
Examples/Util.hs view
@@ -9,6 +9,7 @@ import Data.List import System.Directory as IO import System.Environment+import System.Random shaken@@ -37,6 +38,13 @@ when b $ renameFile tempfile dbfile shake shakeOptions{shakeFiles=out, shakeLint=True} $ rules args (out++) -}++ "perturb":args -> forever $ do+ del <- removeFilesRandom out+ threads <- randomRIO (1,4)+ putStrLn $ "## TESTING PERTURBATION (" ++ show del ++ " files, " ++ show threads ++ " threads)"+ shake shakeOptions{shakeFiles=out, shakeThreads=threads, shakeVerbosity=Quiet} $ rules args (out++)+ args -> do (flags,args) <- return $ partition ("-" `isPrefixOf`) args let f o x = let x2 = dropWhile (== '-') x in case lookup x2 flagList of@@ -93,4 +101,33 @@ -- | Sleep long enough for the modification time resolution to catch up sleepFileTime :: IO () sleepFileTime = sleep 1+++removeFilesRandom :: FilePath -> IO Int+removeFilesRandom x = do+ files <- getDirectoryContentsRecursive x+ n <- randomRIO (0,length files)+ rs <- replicateM (length files) (randomIO :: IO Double)+ mapM_ (removeFile . snd) $ sort $ zip rs files+ return n+++getDirectoryContentsRecursive :: FilePath -> IO [FilePath]+getDirectoryContentsRecursive dir = do+ xs <- IO.getDirectoryContents dir+ (dirs,files) <- partitionM doesDirectoryExist [dir </> x | x <- xs, not $ isBadDir x]+ rest <- concatMapM getDirectoryContentsRecursive dirs+ return $ files++rest+ where+ isBadDir x = "." `isPrefixOf` x || "_" `isPrefixOf` x++partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])+partitionM f [] = return ([], [])+partitionM f (x:xs) = do+ res <- f x+ (as,bs) <- partitionM f xs+ return ([x|res]++as, [x|not res]++bs)++concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]+concatMapM f = liftM concat . mapM f
Main.hs view
@@ -7,6 +7,7 @@ import Examples.Util(flags) 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.Directory as Directory import qualified Examples.Test.Errors as Errors@@ -18,7 +19,7 @@ fakes = ["clean" * clean, "test" * test] where (*) = (,) -mains = ["tar" * Tar.main, "self" * Self.main+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] where (*) = (,)
shake.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.6 build-type: Simple name: shake-version: 0.2+version: 0.2.1 license: BSD3 license-file: LICENSE category: Development@@ -87,6 +87,8 @@ executable shake main-is: Main.hs+ build-depends:+ random if flag(testprog) buildable: True else@@ -94,11 +96,12 @@ other-modules: Examples.Util+ Examples.C.Main Examples.Self.Main+ Examples.Tar.Main Examples.Test.Basic1 Examples.Test.Directory Examples.Test.Errors Examples.Test.FilePath Examples.Test.Files Examples.Test.Pool- Examples.Tar.Main