hake 0.5 → 0.6
raw patch · 3 files changed
+67/−41 lines, 3 filesdep +regexprdep ~yjtools
Dependencies added: regexpr
Dependency ranges changed: yjtools
Files
- Development/Hake.hs +21/−9
- Development/Hake/HiddenTools.hs +39/−26
- hake.cabal +7/−6
Development/Hake.hs view
@@ -21,6 +21,7 @@ , hakeT , hakefileIs +, base , file , task , rule@@ -28,9 +29,9 @@ , dflt , mkfl -, liftIO+--, liftIO , systemE-, getSrcs+--, getSrcs , isSuffixOf , changeSuffix , ExitCode(ExitSuccess)@@ -41,7 +42,7 @@ import System.Cmd (system) import System.Directory (doesFileExist) import System.IO.Unsafe (unsafeInterleaveIO)-import Control.Monad.Reader (asks, ReaderT(runReaderT), lift, liftIO)+import Control.Monad.Reader (asks, ReaderT(runReaderT), lift) import Control.Monad.Utils (ifM, whenM) import Control.Applicative ((<$>)) import Control.Applicative.Utils ((<.>))@@ -121,28 +122,39 @@ | isSuffixOf oldSfx fn = take (length fn - length oldSfx) fn ++ newSfx | otherwise = error $ "changeSuffix: " ++ oldSfx ++ " is not suffix of " ++ fn -systemE :: String -> CommandRet-systemE cmd = lift $ putStrLn cmd >> system cmd+systemE :: String -> IO ExitCode+systemE cmd = putStrLn cmd >> system cmd +systemEInner :: String -> CommandRet+systemEInner cmd = lift $ putStrLn cmd >> system cmd++base :: ( Targets, Sources, String -> [ String ] -> [ MadeFromList -> IO ExitCode ] ) -> Rule+base (trgts, srcs, cmdsGen) = (trgts, srcs, cmds)+ where cmds :: Commands+ cmds t s = map cmdGenToCmd $ cmdsGen t s+ cmdGenToCmd :: (MadeFromList -> IO ExitCode) -> CommandRet+ cmdGenToCmd cg = do mfl <- asks snd+ lift $ cg mfl+ dflt :: [ String ] -> Rule dflt trgts = ( [ (==defaultTrgtStr) ], const trgts, const2 [] ) file :: ( [String], [String], [String] ) -> Rule-file ( trgts, srcs, cmd ) = ( map (==) trgts, const srcs, const2 $ map systemE cmd )+file ( trgts, srcs, cmd ) = ( map (==) trgts, const srcs, const2 $ map systemEInner cmd ) task :: ( String, [String] ) -> Rule-task ( trgts, cmd ) = ( [(==trgts)], const [], const2 $ map systemE cmd )+task ( trgts, cmd ) = ( [(==trgts)], const [], const2 $ map systemEInner cmd ) rule :: ( String, String, String -> String -> [String] ) -> Rule rule ( trgt, src, cmd ) = ( [isSuffixOf trgt], \dst -> [changeSuffix trgt src dst ],- \t [s] -> map systemE $ cmd t s )+ \t [s] -> map systemEInner $ cmd t s ) ruleSS :: ( String, String, String -> String -> [ (String, [String]) ] ) -> Rule ruleSS ( trgt, src, cmds ) = ( [ isSuffixOf trgt ], \dst -> [ changeSuffix trgt src dst ], \t [s] -> [ do [ srcSrc ] <- getSrcs s- abortIfFailure $ map systemE $+ abortIfFailure $ map systemEInner $ snd $ head $ filter ( flip isSuffixOf srcSrc . fst ) $ cmds t s ] ) abortIfFailure :: [ CommandRet ] -> CommandRet
Development/Hake/HiddenTools.hs view
@@ -24,14 +24,18 @@ import System.IO (openFile, hClose, IOMode(WriteMode)) import System.Directory (createDirectory, doesDirectoryExist,- doesFileExist, copyFile, getModificationTime)+ doesFileExist, getModificationTime) import System.Exit (ExitCode(ExitSuccess)) import System.Time (ClockTime) import System.Process (runProcess, waitForProcess) import System.FilePath (takeFileName)+import System.IO.Unsafe (unsafeInterleaveIO) import Control.Monad.Utils (unlessM, ifM) import Control.Applicative ((<$>), liftA2) import Control.Exception (bracket)+import Data.List.Tools (defaultElem)+import Data.Function.Tools (applyWhen, apply2way)+import Text.RegexPR (matchRegexPR) hakeDir, defaultTrgtStr, hakefileUpdateOption :: String hakeDir = "_hake/"@@ -57,34 +61,43 @@ runHake src exe othrs args = do let exePath = hakeDir ++ exe exeSrc = hakeDir ++ exe ++ ".hs"- errFile = hakeDir ++ exe ++ ".error"- unlessM (doesFileExist src) $- error $ "runHake: " ++ src ++ " does not exist"- unlessM (and <$> mapM doesFileExist othrs) $- error $ "runHake: " ++ unwords othrs ++ " does not exist"+ cmtOut = ("{- " ++) . ( ++ " -}\n")+ cmtIn = (>>= lookup 1) . fmap snd . matchRegexPR "\\{-\\s*(\\S+)\\s*-\\}" . head . lines+ mapM_ errorExist $ src : othrs unlessM (doesDirectoryExist hakeDir) $ createDirectory hakeDir- othrsUD <- fmap or $ flip mapM othrs $ \fn -> do- let dist = hakeDir ++ takeFileName fn- ifM (isOldThanSomeOf dist [ fn ])- (copyFile fn dist >> return True)- ( return False)- hakefileUD <-- ifM (isOldThanSomeOf exeSrc [ src ])- (readFile src >>= writeFile exeSrc >> return True )- ( return False)- ret <- bracket (openFile errFile WriteMode) hClose $ \errH ->- runProcess "ghc" [ "--make", exe ] (Just hakeDir)- Nothing Nothing Nothing (Just errH) >>= waitForProcess- case ret of- ExitSuccess -> return ()- _ -> readFile errFile >>= putStr+ othrsUD <- fmap or $ flip mapM othrs+ $ apply2way (updateFile cmtIn cmtOut) id $ (hakeDir ++) . takeFileName+ hakefileUD <- updateFile cmtIn cmtOut src exeSrc+ ghcMake exe hakeDir let args_ = applyWhen (othrsUD || hakefileUD) (hakefileUpdateOption:) $ defaultElem defaultTrgtStr args runProcess exePath args_ Nothing Nothing Nothing Nothing Nothing >>= waitForProcess -defaultElem :: a -> [a] -> [a]-defaultElem dflt [] = [dflt]-defaultElem _ lst = lst+errorExist :: FilePath -> IO ()+errorExist fp = unlessM (doesFileExist fp) $+ error $ "runHake: " ++ fp ++ " does not exist" -applyWhen :: Bool -> (a -> a) -> a -> a-applyWhen b f = if b then f else id+updateFile :: (String -> Maybe String) -> (FilePath -> String) -> FilePath -> FilePath -> IO Bool+updateFile gtSrc hdr src dst+ = ifM ( not <$> doesFileExist dst+ `orIO`+ (/= Just src) . gtSrc <$> (readFile dst >>= ioFlushLst)+ `orIO`+ isOldThanSomeOf dst [ src ] )+ (readFile src >>= writeFile dst . (hdr src ++ ) >> return True)+ ( return False)+ where+ ioFlushLst lst = const lst <$> putStr (take (length lst - length lst) "dummy")+ infixr 2 `orIO`+ orIO p1 p2 = do { b1 <- p1; b2 <- unsafeInterleaveIO p2; return $ b1 || b2 }++ghcMake :: String -> FilePath -> IO ExitCode+ghcMake exe dir = do+ let errFile = exe ++ ".error"+ ret <- bracket (openFile errFile WriteMode) hClose $ \errH ->+ runProcess "ghc" [ "--make", exe ] (Just dir)+ Nothing Nothing Nothing (Just errH) >>= waitForProcess+ case ret of+ ExitSuccess -> return ()+ _ -> readFile errFile >>= putStr+ return ret
hake.cabal view
@@ -1,5 +1,5 @@ Name: hake-Version: 0.5+Version: 0.6 License: GPL License-file: LICENSE Author: Yoshikuni Jujo@@ -39,10 +39,11 @@ > , > rule ( ".o", ".cc", \_ s -> [ "g++ -c " ++ s ] ) > ,- > ( [ (=="foo") ], const [ "foo.gen", "Hakefile" ], \t [s] -> [ do- > gen <- liftIO $ readFile s- > liftIO $ writeFile t $ unlines $- > [ "#!/bin/sh", "echo This is script" ] ++ lines gen ] )+ > base ( [ (=="foo") ], const [ "foo.gen", "Hakefile" ], \t [s] -> [ \_ -> do+ > gen <- readFile s+ > writeFile t $ unlines $+ > [ "#!/bin/sh", "echo This is script" ] ++ lines gen+ > return ExitSuccess ] ) > > ] >@@ -68,6 +69,6 @@ Executable hake GHC-Options: -Wall -- CPP-Options: -DDEBUG- Build-Depends: directory, process, yjtools > 0.1+ Build-Depends: directory, process, yjtools > 0.3, regexpr >= 0.2.9 Other-Modules: Development.Hake.HiddenTools Main-Is: Main.hs