hake 0.3 → 0.4
raw patch · 5 files changed
+230/−202 lines, 5 filesdep ~yjtools
Dependency ranges changed: yjtools
Files
- Development/Hake.cpphs +0/−188
- Development/Hake.hs +171/−0
- Development/Hake/HiddenTools.cpphs +26/−2
- Main.hs +25/−5
- hake.cabal +8/−7
− Development/Hake.cpphs
@@ -1,188 +0,0 @@-module Development.Hake (- Rule-, hake-, hakeT-, hakefileIs--, file-, task-, rule-, ruleSS-, dflt-, mkfl--, lift-, systemE-, getSrcs-, isSuffixOf-, changeSuffix-, ExitCode(ExitSuccess)-) where--import System.Environment (getArgs)-import Data.List (isSuffixOf)-import System.Exit (ExitCode(ExitSuccess), exitWith)-import System.Cmd (system)-import System.Directory (doesFileExist)-import Control.Applicative ((<$>))-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, whenM)-import System.IO.Unsafe (unsafeInterleaveIO-#ifdef DEBUG- , unsafePerformIO-#endif /* DEBUG */- )--type Targets = [ String -> Bool ]-type Sources = String -> SourcesRet-type Commands = String -> [ String ] -> [ CommandRet ]-type Rule = ( Targets, Sources, Commands )-type RuleInner = ( Targets, (Sources, Commands) )--type TargetRet = String-type SourcesRet = [ String ]-type CommandIO = ReaderT (Bool, MadeFromList) IO-type CommandRet = CommandIO ExitCode-type RuleRet = ( TargetRet, (SourcesRet, [CommandRet]) )--type MadeFromList = [ (FilePath, [FilePath]) ]--ruleToRuleInner :: Rule -> RuleInner-ruleToRuleInner ( x, y, z ) = ( x, (y, z) )--ruleRetToMadeFromList :: [ RuleRet ] -> MadeFromList-ruleRetToMadeFromList = map (\(x, (y, _)) -> (x, y))--hake :: [ Rule ] -> IO ()-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"--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--- >>= return . d (map $ map st)--- print $ map (map st) rl-#endif /* DEBUG */- 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 */--infixr 9 <.>-(<.>) :: Functor f => (a -> b) -> (c -> f a) -> c -> f b-f1 <.> f2 = fmap f1 . f2--traceRule :: FilePath -> [ RuleInner ] -> IO [[ RuleRet ]]-traceRule trgt rls- =-#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")- putStrLn $ "DEBUG (traceRule) : target " ++ trgt ++ exStat-#endif /* DEBUG */- ifM (doesFileExist trgt) (return [[]]) (return [])- finds -> do- optional <- ifM (doesFileExist trgt) (return [[]]) (return [])- fmap (++optional) $ concat <.> flip mapM finds $ \((tToS, tsToCmds), restRls) -> do- let srcs = tToS trgt- cmds = tsToCmds trgt srcs- obtainedRls <- mapM (unsafeInterleaveIO . flip traceRule restRls) srcs- return $ map ( (( trgt, (srcs, cmds) ):) . concat ) $ mulLists obtainedRls--mulLists :: [[a]] -> [[a]]-mulLists [] = [[]]-mulLists (xs:xss) = [ x:xs_ | x <- xs, xs_ <- mulLists xss ]--applyRule :: (TargetRet, (SourcesRet, [CommandRet])) -> CommandRet-applyRule (src, (dsts, cmds))- = ifM ( lift $ isOldThanSomeOf src dsts )- ( abortIfFailure cmds )- ( return ExitSuccess )--myLookup :: a -> [ ([a -> Bool], b) ] -> [ (b, [ ([a -> Bool], b) ]) ]-myLookup _ [] = []-myLookup x (pair@(p, y):rest)- | or $ map ($x) p- = (y, rest) : ( (\(z, ps) -> (z, pair:ps)) <$> myLookup x rest )- | otherwise- = (\(z, ps) -> (z, pair:ps)) <$> myLookup x rest--changeSuffix :: String -> String -> String -> String-changeSuffix oldSfx newSfx fn- | isSuffixOf oldSfx fn = take (length fn - length oldSfx) fn ++ newSfx- | otherwise = error $ "changeSuffix: " ++ oldSfx ++ " is not suffix of " ++ fn--const2 :: a -> b -> c -> a-const2 = const . const--systemE :: String -> CommandRet-systemE cmd = lift $ putStrLn cmd >> system cmd--dflt :: [ String ] -> Rule-dflt trgts = ( [ (=="default") ], const trgts, const2 [] )--file :: ( [String], [String], [String] ) -> Rule-file ( trgts, srcs, cmd ) = ( map (==) trgts, const srcs, const2 $ map systemE cmd )--task :: ( String, [String] ) -> Rule-task ( trgts, cmd ) = ( [(==trgts)], const [], const2 $ map systemE 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 )--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 $- snd $ head $ filter ( flip isSuffixOf srcSrc . fst ) $ cmds t s ] )--abortIfFailure :: [ CommandRet ] -> CommandRet-abortIfFailure = last <.> mapM (>>= (\ec -> if ec == ExitSuccess then return ec else lift $ exitWith ec)) --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 ] )--{--mkfl2 :: ( String, [ String ], [ String ] -> IO [ String ] ) -> Rule-mkfl2 ( trgt, src, cont )- = ( [(==trgt)], const src, \t -> const [ do- whenM getUpdateStatus $ - -}--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 fp = asks (maybe [] id . lookup fp . snd)
+ Development/Hake.hs view
@@ -0,0 +1,171 @@+{- hake: make tool. ruby : rake = haskell : hake+Copyright (C) 2008-2008 Yoshikuni Jujo <PAF01143@nifty.ne.jp>++This program is free software: you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation, either version 3 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program. If not, see <http://www.gnu.org/licenses/>.+-}++module Development.Hake (+ Rule+, hake+, hakeT+, hakefileIs++, file+, task+, rule+, ruleSS+, dflt+, mkfl++, liftIO+, systemE+, getSrcs+, isSuffixOf+, changeSuffix+, ExitCode(ExitSuccess)+) where++import System.Environment (getArgs)+import System.Exit (ExitCode(ExitSuccess), exitWith)+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.Utils (ifM, whenM)+import Control.Applicative ((<$>))+import Control.Applicative.Utils ((<.>))+import Data.List (isSuffixOf)+import Data.List.Tools (mulLists)+import Data.Tuple.Tools (modifySnd)+import Data.Function.Tools (const2)+import Development.Hake.HiddenTools (isOldThanSomeOf, runHake, hakefileUpdateOption, defaultTrgtStr)++type Targets = [ String -> Bool ]+type Sources = String -> SourcesRet+type Commands = String -> [ String ] -> [ CommandRet ]+type Rule = ( Targets, Sources, Commands )+type RuleInner = ( Targets, (Sources, Commands) )++type TargetRet = String+type SourcesRet = [ String ]+type CommandIO = ReaderT (Bool, MadeFromList) IO+type CommandRet = CommandIO ExitCode+type RuleRet = ( TargetRet, (SourcesRet, [CommandRet]) )++type MadeFromList = [ (FilePath, [FilePath]) ]++ruleToRuleInner :: Rule -> RuleInner+ruleToRuleInner ( x, y, z ) = ( x, (y, z) )++ruleRetToMadeFromList :: [ RuleRet ] -> MadeFromList+ruleRetToMadeFromList = map (\(x, (y, _)) -> (x, y))++-- |The 'hake' function take rules as argument and get target from command line and make target.+hake :: [ Rule ] -> IO ()+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"++hakeT :: [ Rule ] -> FilePath -> IO ()+hakeT = hakeTarget True . map ruleToRuleInner++hakeTarget :: Bool -> [ RuleInner ] -> FilePath -> IO ()+hakeTarget ud rls fn = do+ rrls <- traceRule fn rls+ case rrls of+ [] -> error $ "No usable rules for make target '" ++ fn ++ "'"+ r:_ -> flip runReaderT (ud, ruleRetToMadeFromList r) $ mapM_ applyRule $ reverse r++traceRule :: FilePath -> [ RuleInner ] -> IO [[ RuleRet ]]+traceRule trgt rls+ = case myLookup trgt rls of+ [] -> ifM (doesFileExist trgt) (return [[]]) (return [])+ finds -> do+ optional <- ifM (doesFileExist trgt) (return [[]]) (return [])+ fmap (++optional) $ concat <.> flip mapM finds $ \((tToS, tsToCmds), restRls) -> do+ let srcs = tToS trgt+ cmds = tsToCmds trgt srcs+ obtainedRls <- mapM (unsafeInterleaveIO . flip traceRule restRls) srcs+ return $ map ( (( trgt, (srcs, cmds) ):) . concat ) $ mulLists obtainedRls++applyRule :: (TargetRet, (SourcesRet, [CommandRet])) -> CommandRet+applyRule (src, (dsts, cmds))+ = ifM ( lift $ isOldThanSomeOf src dsts )+ ( abortIfFailure cmds )+ ( return ExitSuccess )++myLookup :: a -> [ ([a -> Bool], b) ] -> [ (b, [ ([a -> Bool], b) ]) ]+myLookup _ [] = []+myLookup x (pair@(p, y):rest)+ | or $ map ($x) p+ = (y, rest) : ( modifySnd (pair:) <$> myLookup x rest )+ | otherwise+ = modifySnd (pair:) <$> myLookup x rest++changeSuffix :: String -> String -> String -> String+changeSuffix oldSfx newSfx fn+ | 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++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 )++task :: ( String, [String] ) -> Rule+task ( trgts, cmd ) = ( [(==trgts)], const [], const2 $ map systemE 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 )++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 $+ snd $ head $ filter ( flip isSuffixOf srcSrc . fst ) $ cmds t s ] )++abortIfFailure :: [ CommandRet ] -> CommandRet+abortIfFailure = (<.>) last $ mapM $ flip (>>=) $ \ec ->+ case ec of+ ExitSuccess -> return ec+ _ -> lift $ exitWith ec++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 [ defaultTrgtStr ] else args++getUpdateStatus :: CommandIO Bool+getUpdateStatus = asks fst++getSrcs :: FilePath -> CommandIO [FilePath]+getSrcs fp = asks (maybe [] id . lookup fp . snd)
Development/Hake/HiddenTools.cpphs view
@@ -1,13 +1,31 @@+{- hake: make tool. ruby : rake = haskell : hake+Copyright (C) 2008-2008 Yoshikuni Jujo <PAF01143@nifty.ne.jp>++This program is free software: you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation, either version 3 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program. If not, see <http://www.gnu.org/licenses/>.+-}+ module Development.Hake.HiddenTools ( runHake , isOldThanSomeOf , hakefileUpdateOption+, defaultTrgtStr ) where import System.Directory (createDirectory, doesDirectoryExist, doesFileExist, copyFile, getModificationTime) import System.Process (runProcess, waitForProcess)-import System.Exit (ExitCode)+import System.Exit (ExitCode(ExitSuccess)) import System.Time (ClockTime) import System.IO (openFile, hClose, IOMode(WriteMode)) import Control.Applicative ((<$>), liftA2)@@ -45,7 +63,7 @@ when hakefileUD $ readFile src >>= writeFile ("_hake/" ++ exe ++ ".hs") #ifndef DEBUG- bracket (flip openFile WriteMode $ "_hake/" ++ exe ++ ".error") hClose $ \errH ->+ ret <- bracket (flip openFile WriteMode $ "_hake/" ++ exe ++ ".error") hClose $ \errH -> let mErrH = Just errH in #else let mErrH = Nothing in@@ -53,8 +71,14 @@ runProcess "ghc" [ "--make", exe ] (Just "_hake") Nothing Nothing Nothing mErrH >>= waitForProcess let args_ = if othrsUD || hakefileUD then (hakefileUpdateOption:args) else args+ case ret of+ ExitSuccess -> return ()+ _ -> readFile ("_hake/" ++ exe ++ ".error") >>= putStr runProcess ("_hake/" ++ exe) (if null args then ("default":args_) else args_) Nothing Nothing Nothing Nothing Nothing >>= waitForProcess basename :: FilePath -> FilePath basename = reverse . takeWhile (/='/') . reverse++defaultTrgtStr :: String+defaultTrgtStr = "default"
Main.hs view
@@ -1,13 +1,33 @@+{- hake: make tool. ruby : rake = haskell : hake+Copyright (C) 2008-2008 Yoshikuni Jujo <PAF01143@nifty.ne.jp>++This program is free software: you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation, either version 3 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program. If not, see <http://www.gnu.org/licenses/>.+-}+ module Main where import System.Environment (getArgs) import System.Exit (ExitCode(ExitSuccess))-import Development.Hake.HiddenTools (runHake)+import Development.Hake.HiddenTools (runHake, defaultTrgtStr) import Paths_hake (version) import Data.Version (showVersion) main :: IO ExitCode-main = do args <- getArgs- case args of- [ "--version" ] -> putStrLn ("hake " ++ showVersion version) >> return ExitSuccess- _ -> runHake "Hakefile" "hake" [] (if null args then ["default"] else args)+main = do+ args <- getArgs+ case args of+ [ "--version" ] ->+ putStrLn ("hake " ++ showVersion version) >> return ExitSuccess+ _ ->+ runHake "Hakefile" "hake" [] (if null args then [defaultTrgtStr] else args)
hake.cabal view
@@ -1,11 +1,11 @@ Name: hake-Version: 0.3+Version: 0.4 License: GPL License-file: LICENSE Author: Yoshikuni Jujo Maintainer: Yoshikuni Jujo <PAF01143@nifty.ne.jp> Category: Development-Synopsis: ruby : rake = haskell : hake+Synopsis: make tool. ruby : rake = haskell : hake Description: Like ruby's rake, hake have Hakefile which is Haskell source. .@@ -45,16 +45,17 @@ > rule ( ".o", ".cc", \_ s -> [ "g++ -c " ++ s ] ) > , > ( [ (=="foo") ], const [ "foo.gen", "Hakefile" ], \t [s] -> [ do- > gen <- readFile s- > writeFile t $ unlines $ [ "#!/bin/sh", "echo This is script" ] ++ lines gen ] )+ > gen <- liftIO $ readFile s+ > liftIO $ writeFile t $ unlines $+ > [ "#!/bin/sh", "echo This is script" ] ++ lines gen ] ) > > ] >- > main = hake hake_tree+ > main = hake hake_rules 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.2.tar.gz+Package-Url: http://homepage3.nifty.com/salamander/second/portage/distfiles/hake-0.4.tar.gz Cabal-Version: >= 1.2 Build-type: Simple Tested-With: GHC@@ -72,6 +73,6 @@ Executable hake GHC-Options: -Wall -- CPP-Options: -DDEBUG- Build-Depends: directory, process, yjtools+ Build-Depends: directory, process, yjtools > 0.1 Other-Modules: Development.Hake.HiddenTools Main-Is: Main.hs