hake 0.1 → 0.2
raw patch · 4 files changed
+72/−25 lines, 4 files
Files
- Development/Hake.cpphs +46/−14
- Development/Hake/HiddenTools.cpphs +15/−6
- Main.hs +6/−2
- hake.cabal +5/−3
Development/Hake.cpphs view
@@ -1,12 +1,14 @@ module Development.Hake ( Rule , hake+, hakeT , hakefileIs , file , task , rule , dflt+, mkfl , lift , systemE@@ -22,12 +24,17 @@ import System.Cmd (system) import System.Directory (doesFileExist) import Control.Applicative ((<$>))-import Development.Hake.HiddenTools (isOldThanSomeOf, runHake)+import Development.Hake.HiddenTools (isOldThanSomeOf, runHake, hakefileUpdateOption) import Control.Monad.Reader (asks, ReaderT(runReaderT), lift) #ifdef DEBUG import Control.Monad.Reader (ask) #endif /* DEBUG */-import Control.Monad.Utils (ifM)+import Control.Monad.Utils (ifM, whenM)+import System.IO.Unsafe (unsafeInterleaveIO+#ifdef DEBUG+ , unsafePerformIO+#endif /* DEBUG */+ ) type Targets = [ String -> Bool ] type Sources = String -> SourcesRet@@ -37,7 +44,7 @@ type TargetRet = String type SourcesRet = [ String ]-type CommandIO = ReaderT MadeFromList IO+type CommandIO = ReaderT (Bool, MadeFromList) IO type CommandRet = CommandIO ExitCode type RuleRet = ( TargetRet, (SourcesRet, [CommandRet]) ) @@ -50,17 +57,28 @@ ruleRetToMadeFromList = map (\(x, (y, _)) -> (x, y)) hake :: [ Rule ] -> IO ()-hake rl = getArgs >>= hakeTarget (map ruleToRuleInner rl) . head+hake rl = do args <- getArgs+ let ud = elem hakefileUpdateOption args+ args_ = filter (/=hakefileUpdateOption) args+ case args_ of+ [ trgt ] -> hakeTarget ud (map ruleToRuleInner rl) trgt+ _ -> error "function (hake): argument error" -hakeTarget :: [ RuleInner ] -> FilePath -> IO ()-hakeTarget rls fn = do+hakeT :: [ Rule ] -> FilePath -> IO ()+hakeT = hakeTarget True . map ruleToRuleInner++hakeTarget :: Bool -> [ RuleInner ] -> FilePath -> IO ()+hakeTarget ud rls fn = do rl <- traceRule fn rls #ifdef DEBUG- print $ map (map st) rl+-- >>= return . d (map $ map st)+-- print $ map (map st) rl #endif /* DEBUG */- flip runReaderT (ruleRetToMadeFromList $ head rl) $ mapM_ applyRule $ reverse $ head rl+ flip runReaderT (ud, ruleRetToMadeFromList $ head rl) $ mapM_ applyRule $ reverse $ head rl #ifdef DEBUG+d :: Show b => (a -> b) -> a -> a+d f x = unsafePerformIO $ print (f x) >> return x st :: RuleRet -> (TargetRet, SourcesRet) st (t, (s, _)) = (t, s) #endif /* DEBUG */@@ -71,10 +89,14 @@ traceRule :: FilePath -> [ RuleInner ] -> IO [[ RuleRet ]] traceRule trgt rls- = case myLookup trgt rls of+ =+#ifdef DEBUG+ do putStrLn $ "traceRule " ++ show trgt ++ " rls"+#endif /* DEBUG */+ case myLookup trgt rls of [] -> #ifdef DEBUG- do exStat <- ifM (doesFileExist trgt) (return "exist") (return " does not exist")+ do exStat <- ifM (doesFileExist trgt) (return " exist") (return " does not exist") putStrLn $ "DEBUG (traceRule) : target " ++ trgt ++ exStat #endif /* DEBUG */ ifM (doesFileExist trgt) (return [[]]) (return [])@@ -83,7 +105,7 @@ fmap (++optional) $ concat <.> flip mapM finds $ \((tToS, tsToCmds), restRls) -> do let srcs = tToS trgt cmds = tsToCmds trgt srcs- obtainedRls <- mapM (flip traceRule restRls) srcs+ obtainedRls <- mapM (unsafeInterleaveIO . flip traceRule restRls) srcs return $ map ( (( trgt, (srcs, cmds) ):) . concat ) $ mulLists obtainedRls mulLists :: [[a]] -> [[a]]@@ -129,14 +151,24 @@ = ( [isSuffixOf trgt], \dst -> [changeSuffix trgt src dst ], \t [s] -> map systemE $ cmd t s ) +mkfl :: ( String, [ String ] ) -> Rule+mkfl ( trgt, cont )+ = ( [(==trgt)], const [], \t -> const [ do+ whenM getUpdateStatus $ do lift $ putStrLn $ "make file `" ++ trgt ++ "' (hake)"+ lift $ writeFile t $ unlines cont+ return ExitSuccess ] )+ hakefileIs :: FilePath -> [ FilePath ] -> IO ExitCode hakefileIs src others = do args <- getArgs runHake src "hake_" others $ if null args then [ "default" ] else args +getUpdateStatus :: CommandIO Bool+getUpdateStatus = asks fst+ getSrcs :: FilePath -> CommandIO [FilePath]-getSrcs = +getSrcs fp = #ifdef DEBUG- (ask >>= lift . print >>) .+-- (ask >>= lift . print >>) . #endif /* DEBUG */- asks . ( maybe [] id . ) . lookup+ asks (maybe [] id . lookup fp . snd)
Development/Hake/HiddenTools.cpphs view
@@ -1,6 +1,7 @@ module Development.Hake.HiddenTools ( runHake , isOldThanSomeOf+, hakefileUpdateOption ) where import System.Directory (createDirectory, doesDirectoryExist,@@ -10,7 +11,8 @@ import System.Time (ClockTime) import System.IO (openFile, hClose, IOMode(WriteMode)) import Control.Applicative ((<$>), liftA2)-import Control.Monad.Utils (whenM, unlessM)+import Control.Monad (when)+import Control.Monad.Utils (unlessM) import Control.Exception (bracket) maybeGetModificationTime :: FilePath -> IO (Maybe ClockTime)@@ -28,13 +30,19 @@ myOr [] = True myOr bs = or bs +hakefileUpdateOption :: String+hakefileUpdateOption = "--hakefile-is-updated"+ runHake :: FilePath -> FilePath -> [ FilePath ] -> [ String ] -> IO ExitCode-runHake src exe otrs args = do+runHake src exe othrs args = do unlessM (doesDirectoryExist "_hake") $ createDirectory "_hake"- flip mapM_ otrs $ \fn -> do+ othrsUD <- fmap or $ flip mapM othrs $ \fn -> do let dist = "_hake/" ++ basename fn- whenM (isOldThanSomeOf dist [ fn ]) $ copyFile fn dist- whenM (isOldThanSomeOf ("_hake/" ++ exe ++ ".hs") [ src ]) $+ updated <- isOldThanSomeOf dist [ fn ]+ when updated $ copyFile fn dist+ return updated+ hakefileUD <- isOldThanSomeOf ("_hake/" ++ exe ++ ".hs") [ src ]+ when hakefileUD $ readFile src >>= writeFile ("_hake/" ++ exe ++ ".hs") #ifndef DEBUG bracket (flip openFile WriteMode $ "_hake/" ++ exe ++ ".error") hClose $ \errH ->@@ -44,7 +52,8 @@ #endif /* DEBUG */ runProcess "ghc" [ "--make", exe ] (Just "_hake") Nothing Nothing Nothing mErrH >>= waitForProcess- runProcess ("_hake/" ++ exe) (if null args then ["default"] else args)+ let args_ = if othrsUD || hakefileUD then (hakefileUpdateOption:args) else args+ runProcess ("_hake/" ++ exe) (if null args then ("default":args_) else args_) Nothing Nothing Nothing Nothing Nothing >>= waitForProcess basename :: FilePath -> FilePath
Main.hs view
@@ -1,9 +1,13 @@ module Main where import System.Environment (getArgs)-import System.Exit (ExitCode)+import System.Exit (ExitCode(ExitSuccess)) import Development.Hake.HiddenTools (runHake)+import Paths_hake (version)+import Data.Version (showVersion) main :: IO ExitCode main = do args <- getArgs- runHake "Hakefile" "hake" [] (if null args then ["default"] else args)+ case args of+ [ "--version" ] -> putStrLn ("hake " ++ showVersion version) >> return ExitSuccess+ _ -> runHake "Hakefile" "hake" [] (if null args then ["default"] else args)
hake.cabal view
@@ -1,5 +1,5 @@ Name: hake-Version: 0.1+Version: 0.2 License: GPL License-file: LICENSE Author: Yoshikuni Jujo@@ -15,7 +15,7 @@ then you can use all Haskell features. . > import Development.Hake- > hake_tree = [+ > hake_rules = [ > > dflt [ "greeting" ] > ,@@ -29,6 +29,8 @@ > \t s -> [ "compiler2 " ++ s ++ " -o " ++ t ] ) > , > task ( "clean" , [ "rm -f *.o greeting greeting.log" ] )+ > ,+ > mkfl ( "script.sh", [ "#!/bin/sh", "echo This is script", "echo made by Hakefile" ] ) > > ] >@@ -36,7 +38,7 @@ Stability: experimental Homepage: http://homepage3.nifty.com/salamander/second/projects/hake/index.xhtml-Package-Url: http://homepage3.nifty.com/salamander/second/portage/distfiles/hake-0.0.tar.gz+Package-Url: http://homepage3.nifty.com/salamander/second/portage/distfiles/hake-0.2.tar.gz Cabal-Version: >= 1.2 Build-type: Simple Tested-With: GHC