shake 0.0 → 0.1
raw patch · 12 files changed
+204/−92 lines, 12 files
Files
- Development/Shake.hs +9/−2
- Development/Shake/Binary.hs +20/−0
- Development/Shake/Core.hs +37/−14
- Development/Shake/Database.hs +28/−30
- Development/Shake/Derived.hs +16/−7
- Development/Shake/Directory.hs +10/−10
- Development/Shake/File.hs +17/−15
- Development/Shake/Value.hs +7/−11
- Examples/Self/Main.hs +53/−0
- Examples/Tar/Main.hs +1/−1
- Main.hs +2/−0
- shake.cabal +4/−2
Development/Shake.hs view
@@ -1,13 +1,19 @@ +-- | Main module for defining Shake build systems. You may also want to include+-- "Development.Shake.FilePath". module Development.Shake( shake,+ -- * Core of Shake module Development.Shake.Core,+ -- * Utility functions module Development.Shake.Derived,+ -- * File rules module Development.Shake.File,+ -- * Directory rules module Development.Shake.Directory ) where -import Development.Shake.Core hiding (runShake)+import Development.Shake.Core hiding (run) import Development.Shake.Derived import Development.Shake.File hiding (defaultRuleFile) import Development.Shake.Directory hiding (defaultRuleDirectory)@@ -16,9 +22,10 @@ import qualified Development.Shake.File as X import qualified Development.Shake.Directory as X +-- | Main entry point for running Shake build systems. shake :: ShakeOptions -> Rules () -> IO () shake opts r = do- X.runShake opts $ do+ X.run opts $ do r X.defaultRuleFile X.defaultRuleDirectory
+ Development/Shake/Binary.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}++module Development.Shake.Binary(+ BinaryWith(..), module Data.Binary+ ) where++import Control.Monad+import Data.Binary++class BinaryWith ctx a where+ putWith :: ctx -> a -> Put+ getWith :: ctx -> Get a++instance (BinaryWith ctx a, BinaryWith ctx b) => BinaryWith ctx (a,b) where+ putWith ctx (a,b) = putWith ctx a >> putWith ctx b+ getWith ctx = do a <- getWith ctx; b <- getWith ctx; return (a,b)++instance BinaryWith ctx a => BinaryWith ctx [a] where+ putWith ctx xs = put (length xs) >> mapM_ (putWith ctx) xs+ getWith ctx = do n <- get; replicateM n $ getWith ctx
Development/Shake/Core.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE RecordWildCards, ExistentialQuantification, FunctionalDependencies, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} module Development.Shake.Core(- ShakeOptions(..), shakeOptions, runShake,+ ShakeOptions(..), shakeOptions, run, Rule(..), Rules, defaultRule, rule, action, Action, apply, apply1, traced, currentRule, putLoud, putNormal, putQuiet@@ -30,13 +30,15 @@ --------------------------------------------------------------------- -- OPTIONS +-- | Options to specify how to control 'shake'. data ShakeOptions = ShakeOptions {shakeFiles :: FilePath -- ^ Where shall I store the database and journal files (defaults to @.@)- ,shakeParallelism :: Int -- ^ What is the maximum number of rules I should run in parallel (defaults to @1@)+ ,shakeParallel :: Int -- ^ What is the maximum number of rules I should run in parallel (defaults to @1@) ,shakeVersion :: Int -- ^ What is the version of your build system, increment to force everyone to rebuild ,shakeVerbosity :: Int -- ^ 1 = normal, 0 = quiet, 2 = loud } +-- | A default set of 'ShakeOptions'. shakeOptions :: ShakeOptions shakeOptions = ShakeOptions "." 1 1 1 @@ -44,10 +46,13 @@ --------------------------------------------------------------------- -- RULES +-- | Define a pair of types that can be used as a Shake rule. class ( Show key, Typeable key, Eq key, Hashable key, Binary key, Show value, Typeable value, Eq value, Hashable value, Binary value ) => Rule key value | key -> value where+ -- | Given that the database contains @key@/@value@, does that still match the on-disk contents?+ -- Return 'True' if no work needs to be done. validStored :: key -> value -> IO Bool validStored _ _ = return True @@ -64,6 +69,8 @@ ruleStored _ k v = unsafePerformIO $ validStored k v -- safe because of the invariants on validStored +-- | Define a set of rules. Rules can be created with calls to 'rule'/'action'. Rules are combined+-- with either the 'Monoid' instance, or more commonly using the 'Monad' instance and @do@ notation. data Rules a = Rules {value :: a -- not really used, other than for the Monad instance ,actions :: [Action ()]@@ -80,17 +87,22 @@ Rules v1 x1 x2 >>= f = Rules v2 (x1++y1) (x2++y2) where Rules v2 y1 y2 = f v1 +instance Functor Rules where+ fmap f x = return . f =<< x --- accumulate the Rule instances from defaultRule and rule, and put them in--- if no rules to build something then it's cache instance is dodgy anyway++-- | Like 'rule', but lower priority, if no 'rule' exists then 'defaultRule' is checked. defaultRule :: Rule key value => (key -> Maybe (Action value)) -> Rules () defaultRule r = mempty{rules=[(0,ARule r)]} +-- | Add a rule to build a key, returning an appropriate 'Action'. All rules must be disjoint.+-- To define lower priority rules use 'defaultRule'. rule :: Rule key value => (key -> Maybe (Action value)) -> Rules () rule r = mempty{rules=[(1,ARule r)]} +-- | Run an action, usually used for specifying top-level requirements. action :: Action a -> Rules () action a = mempty{actions=[a >> return ()]} @@ -115,22 +127,22 @@ ,traces :: [(String, Double, Double)] -- in reverse } +-- | The 'Action' monad, use 'liftIO' to raise 'IO' actions into it, and 'need' to execute files.+-- Action values are used by 'rule' and 'action'. newtype Action a = Action (StateT S IO a) deriving (Functor, Monad, MonadIO) -runShake :: ShakeOptions -> Rules () -> IO Double-runShake ShakeOptions{..} rules = do+-- | This function is not actually exported, but Haddock is buggy. Please ignore.+run :: ShakeOptions -> Rules () -> IO ()+run ShakeOptions{..} rules = do start <- getCurrentTime registerWitnesses rules- database <- openDatabase shakeFiles shakeVersion outputLock <- newVar ()- withPool shakeParallelism $ \pool -> do- let state = S database pool start (createStored rules) (createExecute rules) outputLock shakeVerbosity [] [] 0 []- parallel_ pool $ map (runAction state) (actions rules)- closeDatabase database- end <- getCurrentTime- return $ duration start end+ withDatabase shakeFiles shakeVersion $ \database -> do+ withPool shakeParallel $ \pool -> do+ let s0 = S database pool start (createStored rules) (createExecute rules) outputLock shakeVerbosity [] [] 0 []+ parallel_ pool $ map (runAction s0) (actions rules) registerWitnesses :: Rules () -> IO ()@@ -177,6 +189,8 @@ duration start end = fromRational $ toRational $ end `diffUTCTime` start +-- | Execute a rule, returning the associated values. If possible, the rules will be run in parallel.+-- This function requires that appropriate rules have been added with 'rule'/'defaultRule'. apply :: Rule key value => [key] -> Action [value] apply ks = Action $ do modify $ \s -> s{depends=map newKey ks:depends s}@@ -186,7 +200,7 @@ s <- get res <- liftIO $ request (database s) (stored s) $ map newKey ks case res of- Block act -> discounted (liftIO act) >> loop+ Block act -> discounted (liftIO $ extraWorkerWhileBlocked (pool s) act) >> loop Response vs -> return $ map fromValue vs Execute todo -> do let bad = intersect (stack s) todo@@ -212,10 +226,14 @@ modify $ \s -> s{discount=discount s + duration start end} +-- | Apply a single rule, equivalent to calling 'apply' with a singleton list. Where possible,+-- use 'apply' to allow the potential for parallelism. apply1 :: Rule key value => key -> Action value apply1 = fmap head . apply . return +-- | Write an action to the trace list, along with the start/end time of running the IO action.+-- The 'system'' command automatically calls 'traced'. traced :: String -> IO a -> Action a traced msg act = Action $ do start <- liftIO getCurrentTime@@ -225,6 +243,8 @@ return res +-- | Get the 'Key' for the currently executing rule - usally used to improve error messages.+-- Returns 'Nothing' if being run by 'action'. currentRule :: Action (Maybe Key) currentRule = Action $ do s <- get@@ -239,6 +259,9 @@ putStrLn msg +-- | Write a message to the output when the verbosity is appropriate.+-- The output will not be interleaved with any other Shake messages+-- (other than those generated by system commands). putLoud, putNormal, putQuiet :: String -> Action () putLoud = putWhen (>= 2) putNormal = putWhen (>= 1)
Development/Shake/Database.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards, ScopedTypeVariables, PatternGuards #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, UndecidableInstances #-} {-# OPTIONS -fno-warn-unused-binds #-} -- for fields used just for docs {- Files stores the meta-data so its very important its always accurate@@ -8,10 +9,11 @@ -} module Development.Shake.Database(- Database, openDatabase, closeDatabase,+ Database, withDatabase, request, Response(..), finished ) where +import Development.Shake.Binary import Development.Shake.Locks import Development.Shake.Value @@ -21,7 +23,6 @@ import Control.Monad import Control.Monad.IO.Class import qualified Control.Monad.Trans.State as S-import Data.Binary import Data.Binary.Get import Data.Binary.Put import Data.Char@@ -63,9 +64,9 @@ data Info = Info {value :: Value -- the value associated with the Key- ,time :: Time -- the timestamp for deciding if it's valid+ ,built :: Time -- the timestamp for deciding if it's valid+ ,changed :: Time -- when it was actually run ,depends :: [[Key]] -- dependencies- ,realTime :: Time -- when it was actually run ,execution :: Double -- how long it took when it was last run (seconds) ,traces :: [(String, Double, Double)] -- a trace of the expensive operations (start/end in seconds since beginning of run) }@@ -118,7 +119,7 @@ case Map.lookup k s of Nothing -> build k Just (Building bar _) -> return $ Response_ [] [bar] []- Just (Built i) -> return $ Response_ [] [] [(time i, value i)]+ Just (Built i) -> return $ Response_ [] [] [(changed i, value i)] Just (Loaded i) -> if not $ validStored k (value i) then build k@@ -127,11 +128,11 @@ validHistory :: Key -> Info -> [[Key]] -> S.StateT (Map Key Status) IO Response_ validHistory k i [] = do S.modify $ Map.insert k $ Built i- return $ Response_ [] [] [(time i, value i)]+ return $ Response_ [] [] [(changed i, value i)] validHistory k i (x:xs) = do r@Response_{..} <- fmap concatResponse $ mapM f x if not $ null execute && null barriers then return r- else if all ((<= time i) . fst) values then validHistory k i xs+ else if all ((<= built i) . fst) values then validHistory k i xs else build k build :: Key -> S.StateT (Map Key Status) IO Response_@@ -145,10 +146,10 @@ finished :: Database -> Key -> Value -> [[Key]] -> Double -> [(String,Double,Double)] -> IO () finished Database{..} k v depends duration traces = do- let info = Info v timestamp depends timestamp duration traces+ let info = Info v timestamp timestamp depends duration traces (info2, barrier) <- modifyVar status $ \mp -> return $ let Just (Building bar old) = Map.lookup k mp- info2 = if isJust old && value (fromJust old) == value info then info{time=time $ fromJust old} else info+ info2 = if isJust old && value (fromJust old) == value info then info{changed=changed $ fromJust old} else info in (Map.insert k (Built info2) mp, (info2, bar)) appendJournal journal k info2 releaseBarrier barrier@@ -157,6 +158,11 @@ --------------------------------------------------------------------- -- DATABASE ++withDatabase :: FilePath -> Int -> (Database -> IO a) -> IO a+withDatabase filename version = bracket (openDatabase filename version) closeDatabase++ -- Files are named based on the FilePath, but with different extensions, -- such as .database, .journal, .trace openDatabase :: FilePath -> Int -> IO Database@@ -241,8 +247,8 @@ replayJournal file ver mp = catch (do src <- readFileVer file $ journalVersion ver let ws:rest = readChunks src- ws <- return $ decode ws- rest <- return $ map (runGet (getWitness ws)) rest+ ws :: Witness <- return $ decode ws+ rest <- return $ map (runGet (getWith ws)) rest return $ foldl' (\mp (k,v) -> Map.insert k (Loaded v) mp) mp rest) $ \(err :: SomeException) -> do putStrLn $ unlines $@@ -256,7 +262,7 @@ appendJournal Journal{..} k i = modifyVar_ handle $ \v -> case v of Nothing -> return Nothing Just h -> do- writeChunk h $ runPut $ putWitness witness (k,i)+ writeChunk h $ runPut $ putWith witness (k,i) return $ Just h @@ -281,34 +287,26 @@ data Witnessed a = Witnessed Witness a fromWitnessed (Witnessed _ x) = x -instance BinaryWitness a => Binary (Witnessed a) where- put (Witnessed ws x) = put ws >> putWitness ws x- get = do ws <- get; x <- getWitness ws; return $ Witnessed ws x+instance BinaryWith Witness a => Binary (Witnessed a) where+ put (Witnessed ws x) = put ws >> putWith ws x+ get = do ws <- get; x <- getWith ws; return $ Witnessed ws x -- Only for serialisation newtype Statuses = Statuses {fromStatuses :: Map Key Status} -instance BinaryWitness Statuses where- putWitness ws (Statuses x) = putWitness ws [(k,i) | (k,v) <- Map.toList x, Just i <- [f v]]+instance BinaryWith Witness Statuses where+ putWith ws (Statuses x) = putWith ws [(k,i) | (k,v) <- Map.toList x, Just i <- [f v]] where f (Building _ i) = i f (Built i) = Just i f (Loaded i) = Just i- getWitness ws = do- x <- getWitness ws+ getWith ws = do+ x <- getWith ws return $ Statuses $ Map.fromList $ map (second Loaded) x -instance BinaryWitness Info where- putWitness ws (Info x1 x2 x3 x4 x5 x6) = putWitness ws x1 >> put x2 >> putWitness ws x3 >> put x4 >> put x5 >> put x6- getWitness ws = do x1 <- getWitness ws; x2 <- get; x3 <- getWitness ws; x4 <- get; x5 <- get; x6 <- get; return $ Info x1 x2 x3 x4 x5 x6--instance (BinaryWitness a, BinaryWitness b) => BinaryWitness (a,b) where- putWitness ws (a,b) = putWitness ws a >> putWitness ws b- getWitness ws = do a <- getWitness ws; b <- getWitness ws; return (a,b)--instance BinaryWitness a => BinaryWitness [a] where- putWitness ws xs = put (length xs) >> mapM_ (putWitness ws) xs- getWitness ws = do n <- get; replicateM n $ getWitness ws+instance BinaryWith Witness Info where+ putWith ws (Info x1 x2 x3 x4 x5 x6) = putWith ws x1 >> put x2 >> put x3 >> putWith ws x4 >> put x5 >> put x6+ getWith ws = do x1 <- getWith ws; x2 <- get; x3 <- get; x4 <- getWith ws; x5 <- get; x6 <- get; return $ Info x1 x2 x3 x4 x5 x6 readFileVer :: FilePath -> String -> IO LBS.ByteString
Development/Shake/Derived.hs view
@@ -4,6 +4,7 @@ import Control.Monad import Control.Monad.IO.Class import System.Cmd+import System.Directory import System.Exit import Development.Shake.Core@@ -11,8 +12,8 @@ import Development.Shake.FilePath -system_ :: [String] -> Action ()-system_ (x:xs) = do+system' :: [String] -> Action ()+system' (x:xs) = do let cmd = unwords $ toNative x : xs putLoud cmd res <- liftIO $ system cmd@@ -21,11 +22,19 @@ error $ "System command failed while building " ++ show k ++ ", " ++ cmd -readFile_ :: FilePath -> Action String-readFile_ x = do- need [x]- liftIO $ readFile x+copyFile' :: FilePath -> FilePath -> Action ()+copyFile' old new = need [old] >> liftIO (copyFile old new) +readFile' :: FilePath -> Action String+readFile' x = need [x] >> liftIO (readFile x)++writeFile' :: FilePath -> String -> Action ()+writeFile' name x = liftIO $ writeFile name x++ readFileLines :: FilePath -> Action [String]-readFileLines = fmap lines . readFile_+readFileLines = fmap lines . readFile'++writeFileLines :: FilePath -> [String] -> Action ()+writeFileLines name = writeFile' name . unlines
Development/Shake/Directory.hs view
@@ -21,11 +21,12 @@ newtype Exist = Exist FilePath- deriving (Typeable,Show,Eq,Hashable,Binary)-newtype Exist_ = Exist_ Bool- deriving (Typeable,Show,Eq,Hashable,Binary)+ deriving (Typeable,Eq,Hashable,Binary) +instance Show Exist where+ show (Exist a) = "Exists? " ++ a + data GetDir = GetDir {dir :: FilePath} | GetDirFiles {dir :: FilePath, pat :: FilePattern}@@ -53,25 +54,24 @@ put (GetDirDirs x) = putWord8 2 >> put x -instance Rule Exist Exist_ where- validStored (Exist x) (Exist_ b) = fmap (== b) $ IO.doesFileExist x+instance Rule Exist Bool where+ validStored (Exist x) b = fmap (== b) $ IO.doesFileExist x instance Rule GetDir GetDir_ where validStored x y = fmap (== y) $ getDir x +-- | This function is not actually exported, but Haddock is buggy. Please ignore. defaultRuleDirectory :: Rules () defaultRuleDirectory = do defaultRule $ \(Exist x) -> Just $- liftIO $ fmap Exist_ $ IO.doesFileExist x+ liftIO $ IO.doesFileExist x defaultRule $ \x@GetDir{} -> Just $ liftIO $ getDir x doesFileExist :: FilePath -> Action Bool-doesFileExist x = do- Exist_ y <- apply1 $ Exist x- return y+doesFileExist = apply1 . Exist getDirectoryContents :: FilePath -> Action [FilePath] getDirectoryContents x = getDirAction $ GetDir x@@ -92,5 +92,5 @@ f GetDir{} xs = return xs f GetDirFiles{} xs = flip filterM xs $ \s -> do- if not $ pat x =*= s then return False else IO.doesFileExist $ dir x </> s+ if not $ pat x ?== s then return False else IO.doesFileExist $ dir x </> s f GetDirDirs{} xs = flip filterM xs $ \s -> IO.doesDirectoryExist $ dir x </> s
Development/Shake/File.hs view
@@ -3,18 +3,20 @@ module Development.Shake.File( FilePattern, need, want, defaultRuleFile,- (=*=), (?>), (**>), (*>)+ (?==), (?>), (**>), (*>) ) where import Control.Monad.IO.Class import Data.Binary import Data.Hashable import Data.List+import Data.Maybe import Data.Typeable import System.Directory import System.Time import Development.Shake.Core+import System.FilePath(takeDirectory) type FilePattern = String@@ -40,12 +42,12 @@ validStored (File x) t = fmap (== Just t) $ getFileTime x +-- | This function is not actually exported, but Haddock is buggy. Please ignore. defaultRuleFile :: Rules () defaultRuleFile = defaultRule $ \(File x) -> Just $ do res <- liftIO $ getFileTime x- case res of- Nothing -> error $ "Error, file does not exist and no available rule: " ++ x- Just t -> return t+ let msg = "Error, file does not exist and no available rule: " ++ x+ return $ fromMaybe (error msg) res need :: [FilePath] -> Action ()@@ -58,24 +60,24 @@ (?>) :: (FilePath -> Bool) -> (FilePath -> Action ()) -> Rules () (?>) test act = rule $ \(File x) -> if not $ test x then Nothing else Just $ do+ liftIO $ createDirectoryIfMissing True $ takeDirectory x act x res <- liftIO $ getFileTime x- case res of- Nothing -> error $ "Error, rule failed to build the file: " ++ x- Just t -> return t+ let msg = "Error, rule failed to build the file: " ++ x+ return $ fromMaybe (error msg) res (**>) :: [FilePattern] -> (FilePath -> Action ()) -> Rules ()-(**>) test act = (\x -> any (x =*=) test) ?> act+(**>) test act = (\x -> any (x ?==) test) ?> act (*>) :: FilePattern -> (FilePath -> Action ()) -> Rules ()-(*>) test act = (test =*=) ?> act+(*>) test act = (test ?==) ?> act -(=*=) :: FilePattern -> FilePath -> Bool-(=*=) ('/':'/':x) y = any (x =*=) $ y : [i | '/':i <- tails y]-(=*=) ('*':x) y = any (x =*=) $ a ++ take 1 b+(?==) :: FilePattern -> FilePath -> Bool+(?==) ('/':'/':x) y = any (x ?==) $ y : [i | '/':i <- tails y]+(?==) ('*':x) y = any (x ?==) $ a ++ take 1 b where (a,b) = break ("/" `isPrefixOf`) $ tails y-(=*=) (x:xs) (y:ys) | x == y = xs =*= ys-(=*=) [] [] = True-(=*=) _ _ = False+(?==) (x:xs) (y:ys) | x == y = xs ?== ys+(?==) [] [] = True+(?==) _ _ = False
Development/Shake/Value.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ExistentialQuantification, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ExistentialQuantification, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} {- | This module implements the Key/Value types, to abstract over hetrogenous data types.@@ -6,10 +6,10 @@ module Development.Shake.Value( Value, newValue, fromValue, typeValue, Key, newKey, fromKey, typeKey,- Witness, BinaryWitness(..), currentWitness, registerWitness+ Witness, currentWitness, registerWitness ) where -import Data.Binary+import Development.Shake.Binary import Data.Hashable import Data.Typeable @@ -24,7 +24,7 @@ -- We deliberately avoid Typeable instances on Key/Value to stop them accidentally -- being used inside themselves newtype Key = Key Value- deriving (Eq,Hashable,BinaryWitness)+ deriving (Eq,Hashable,BinaryWith Witness) data Value = forall a . (Eq a, Show a, Typeable a, Hashable a, Binary a) => Value a @@ -97,17 +97,13 @@ return $ Witness ts (Map.fromList $ zip is vs) (Map.fromList $ zip ks is) -class BinaryWitness a where- putWitness :: Witness -> a -> Put- getWitness :: Witness -> Get a--instance BinaryWitness Value where- putWitness ws (Value x) = do+instance BinaryWith Witness Value where+ putWith ws (Value x) = do let msg = "Internal error, could not find witness type for " ++ show (typeOf x) put $ fromMaybe (error msg) $ Map.lookup (typeOf x) (witnessOut ws) put x - getWitness ws = do+ getWith ws = do h <- get case Map.lookup h $ witnessIn ws of Nothing -> error $
+ Examples/Self/Main.hs view
@@ -0,0 +1,53 @@++module Examples.Self.Main(main) where++import Development.Shake+import Development.Shake.FilePath++import Control.Monad+import Data.Char+import Data.List+++main :: IO ()+main = shake shakeOptions{shakeFiles="output/self", shakeVerbosity=2, shakeParallel=1} $ do+ let pkgs = "transformers binary unordered-containers parallel-io filepath directory process"+ flags = map ("-package=" ++) $ words pkgs++ let out x = "output/self/" ++ x+ unout x = dropDirectory1 $ dropDirectory1 x+ moduleToFile ext xs = map (\x -> if x == '.' then '/' else x) xs <.> ext+ want [out "Main.exe"]++ out "/*.exe" *> \res -> do+ src <- readFileLines $ replaceExtension res "deps"+ let os = map (out . moduleToFile "o") $ "Main":src+ need os+ system' $ ["ghc","-o",res] ++ os ++ flags++ out "/*.deps" *> \res -> do+ dep <- readFileLines $ replaceExtension res "dep"+ let xs = map (out . moduleToFile "deps") dep+ need xs+ ds <- fmap (nub . sort . (++) dep . concat) $ mapM readFileLines xs+ writeFileLines res ds++ out "/*.dep" *> \res -> do+ src <- readFile' $ unout $ replaceExtension res "hs"+ let xs = hsImports src+ xs <- filterM (doesFileExist . moduleToFile "hs") xs+ writeFileLines res xs++ out "/*.hi" *> \res -> do+ need [replaceExtension res "o"]++ out "/*.o" *> \res -> do+ dep <- readFileLines $ replaceExtension res "dep"+ let hs = unout $ replaceExtension res "hs"+ need $ hs : map (out . moduleToFile "hi") dep+ system' $ ["ghc","-c",hs,"-odir=output/self","-hidir=output/self","-i=output/self"] ++ flags+++hsImports :: String -> [String]+hsImports xs = [ takeWhile (\x -> isAlphaNum x || x `elem` "._") $ dropWhile (not . isUpper) x+ | x <- lines xs, "import " `isPrefixOf` x]
Examples/Tar/Main.hs view
@@ -10,4 +10,4 @@ "output/tar/result.tar" *> \out -> do contents <- readFileLines "Examples/Tar/list.txt" need contents- system_ $ ["tar","-cf",out] ++ contents+ system' $ ["tar","-cf",out] ++ contents
Main.hs view
@@ -5,6 +5,7 @@ import System.Environment import qualified Examples.Tar.Main as Tar+import qualified Examples.Self.Main as Self main :: IO ()@@ -13,6 +14,7 @@ case xs of "clean":_ -> error "todo: clean" "tar":xs -> mkdir "output/tar" >> withArgs xs Tar.main+ "self":xs -> mkdir "output/self" >> withArgs xs Self.main _ -> error "Enter a command to continue"
shake.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.6 build-type: Simple name: shake-version: 0.0+version: 0.1 license: BSD3 license-file: LICENSE category: Development@@ -10,7 +10,7 @@ copyright: Neil Mitchell 2011 synopsis: Build system creator description:- Write build systems. NOT READY FOR USE YET. DO NOT USE THIS PACKAGE.+ Write build systems, mostly works but seriously early adopters only. homepage: http://community.haskell.org/~ndm/shake/ stability: Beta @@ -42,6 +42,7 @@ Development.Shake.FilePath other-modules:+ Development.Shake.Binary Development.Shake.Core Development.Shake.Database Development.Shake.Derived@@ -60,3 +61,4 @@ other-modules: Examples.Tar.Main+ Examples.Self.Main