hake 0.8 → 0.9

raw patch · 6 files changed

+264/−123 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Development/Hake.hs +16/−95
• Development/Hake/FunSet.hs +79/−0
• Development/Hake/HiddenTools.hs +28/−11
• Development/Hake/OldFunSet.hs +77/−0
• Development/Hake/Types.hs +41/−0
• hake.cabal +23/−17

@@ -21,52 +21,31 @@ , hakeT , hakefileIs -, base-, file-, task-, rule-, ruleSS-, dflt-, mkfl+, addDeps ---, liftIO-, systemE---, getSrcs , isSuffixOf , changeSuffix , ExitCode(ExitSuccess) ) where  import System.Environment           (getArgs)-import System.Exit                  (ExitCode(ExitSuccess), exitWith)-import System.Cmd                   (system)+import System.Exit                  (ExitCode(ExitSuccess)) import System.Directory             (doesFileExist) import System.Directory.Tools       (maybeGetModificationTime) import System.IO.Unsafe             (unsafeInterleaveIO)-import Control.Monad.Reader         (asks, ReaderT(runReaderT), lift)-import Control.Monad.Tools          (ifM, whenM)+import Control.Monad.Reader         (ReaderT(runReaderT), lift)+import Control.Monad.Tools          (ifM) import Control.Applicative          ((<$>), liftA2) import Control.Applicative.Tools    ((<.>)) import Control.Arrow                (second) import Data.List                    (isSuffixOf) import Data.List.Tools              (mulLists)--- import Data.Tuple.Tools             (modifySnd)-import Data.Function.Tools          (const2)-import Development.Hake.HiddenTools (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]) ]+import Development.Hake.HiddenTools (runHake, hakefileUpdateOption,+                                     defaultTrgtStr, abortIfFailure,+				     changeSuffix)+import Development.Hake.Types       (Rule, RuleInner,+                                     TargetRet, SourcesRet, CommandRet, RuleRet,+				     MadeFromList)  ruleToRuleInner :: Rule -> RuleInner ruleToRuleInner ( x, y, z ) = ( x, (y, z) )@@ -126,72 +105,14 @@   | otherwise     =               second (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 -> 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 systemEInner cmd )--task :: ( String, [String] ) -> Rule-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 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 systemEInner $-		         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--orM :: Monad m => m Bool -> m Bool -> m Bool-orM p1 p2 = do b1 <- p1-               b2 <- p2-	       return $ b1 || b2--mkfl :: ( String, [ String ] ) -> Rule-mkfl ( trgt, cont )-  = ( [ (==trgt) ], const [], \t -> const [ do-        whenM (getUpdateStatus `orM` lift (not <$> doesFileExist trgt)) $ do-	  lift $ putStrLn $ "make file `" ++ trgt ++ "' (hake)"-	  lift $ writeFile t $ unlines cont-	return ExitSuccess ] )+addDeps :: [ Rule ] -> [ (FilePath, [FilePath]) ] -> [ Rule ]+addDeps rls adrls = concatMap ad adrls ++ rls+  where+  ad :: (FilePath, [FilePath]) -> [ Rule ]+  ad (t, ss) = [ ([(==t)], const $ sgen t ++ ss, c) |+                 (testT, sgen, c) <- rls, or $ map ($t) testT ]  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)

@@ -0,0 +1,79 @@+module Development.Hake.FunSet (++  base+, file+, task+, rule+, ruleSS+, dflt+, mkfl++, systemE++) where++import System.Directory             (doesFileExist)+import System.Cmd                   (rawSystem)+import System.Exit                  (ExitCode(ExitSuccess))+import Data.List                    (isSuffixOf)+import Data.Function.Tools          (const2)+import Control.Monad.Reader         (lift, asks)+import Control.Monad.Tools          (whenM)+import Control.Applicative          ((<$>))+import Development.Hake.Types       (Rule, CommandRet, MadeFromList,+                                     Commands, Targets, Sources,+				     getSrcs, getUpdateStatus)+import Development.Hake.HiddenTools (abortIfFailure, changeSuffix,+                                     defaultTrgtStr)++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 systemEInner cmd )++task :: String -> [[String]] -> Rule+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 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 systemEInner $+		           snd $ head $ filter ( flip isSuffixOf srcSrc . fst ) $ cmds t s ] )++mkfl :: String -> [ String ] -> Rule+mkfl trgt cont+  = ( [ (==trgt) ], const [], \t -> const [ do+        whenM (getUpdateStatus `orM` lift (not <$> doesFileExist trgt)) $ do+	  lift $ putStrLn $ "make file `" ++ trgt ++ "' (hake)"+	  lift $ writeFile t $ unlines cont+	return ExitSuccess ] )++orM :: Monad m => m Bool -> m Bool -> m Bool+orM p1 p2 = do b1 <- p1+               b2 <- p2+	       return $ b1 || b2++systemE :: [ String ] -> IO ExitCode+systemE cmd = putStrLn (unwords cmd) >> rawSystem (head cmd) (tail cmd)++systemEInner :: [ String ] -> CommandRet+systemEInner cmd = lift $ putStrLn (unwords cmd) >> rawSystem (head cmd) (tail cmd)

@@ -19,19 +19,25 @@   runHake , hakefileUpdateOption , defaultTrgtStr+, abortIfFailure+, changeSuffix ) where -import System.Directory       (createDirectory, doesDirectoryExist,-                               doesFileExist)-import System.Exit            (ExitCode)-import System.FilePath        (takeFileName)-import System.Process         (runProcess, waitForProcess)-import System.Directory.Tools (doesNotExistOrOldThan)-import Control.Monad          (when)-import Control.Monad.Tools    (unlessM)-import Data.List.Tools        (defaultElem)-import Data.Function.Tools    (applyWhen, apply2way)-import YJTools.Tribial        (ghcMake, updateFile)+import System.Directory          (createDirectory, doesDirectoryExist,+                                  doesFileExist)+import System.Exit               (ExitCode(ExitSuccess), exitWith)+import System.FilePath           (takeFileName)+import System.Process            (runProcess, waitForProcess)+import System.Directory.Tools    (doesNotExistOrOldThan)+import Control.Monad             (when)+import Control.Monad.Reader      (lift)+import Control.Monad.Tools       (unlessM)+import Control.Applicative.Tools ((<.>))+import Data.List                 (isSuffixOf)+import Data.List.Tools           (defaultElem)+import Data.Function.Tools       (applyWhen, apply2way)+import YJTools.Tribial           (ghcMake, updateFile)+import Development.Hake.Types    (CommandRet)  hakeDir, defaultTrgtStr, hakefileUpdateOption, srcSuffix :: String commentPair :: (String, String)@@ -62,3 +68,14 @@ errorExist :: FilePath -> IO () errorExist fp = unlessM (doesFileExist fp) $                   error $ "runHake: " ++ fp ++ " does not exist"++abortIfFailure :: [ CommandRet ] -> CommandRet+abortIfFailure = (<.>) last $ mapM $ flip (>>=) $ \ec ->+  case ec of+       ExitSuccess -> return ec+       _           -> lift $ exitWith ec++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

@@ -0,0 +1,77 @@+module Development.Hake.OldFunSet (++  base+, file+, task+, rule+, ruleSS+, dflt+, mkfl++, systemE++) where++import System.Directory             (doesFileExist)+import System.Cmd                   (system)+import System.Exit                  (ExitCode(ExitSuccess))+import Data.List                    (isSuffixOf)+import Data.Function.Tools          (const2)+import Control.Monad.Reader         (lift, asks)+import Control.Monad.Tools          (whenM)+import Control.Applicative          ((<$>))+import Development.Hake.Types       (Rule, CommandRet, MadeFromList,+                                     Commands, Targets, Sources,+				     getSrcs, getUpdateStatus)+import Development.Hake.HiddenTools (abortIfFailure, changeSuffix,+                                     defaultTrgtStr)++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 systemEInner cmd )++task :: ( String, [String] ) -> Rule+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 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 systemEInner $+		           snd $ head $ filter ( flip isSuffixOf srcSrc . fst ) $ cmds t s ] )++mkfl :: ( String, [ String ] ) -> Rule+mkfl ( trgt, cont )+  = ( [ (==trgt) ], const [], \t -> const [ do+        whenM (getUpdateStatus `orM` lift (not <$> doesFileExist trgt)) $ do+	  lift $ putStrLn $ "make file `" ++ trgt ++ "' (hake)"+	  lift $ writeFile t $ unlines cont+	return ExitSuccess ] )++orM :: Monad m => m Bool -> m Bool -> m Bool+orM p1 p2 = do b1 <- p1+               b2 <- p2+	       return $ b1 || b2++systemE :: String -> IO ExitCode+systemE cmd = putStrLn cmd >> system cmd++systemEInner :: String -> CommandRet+systemEInner cmd = lift $ putStrLn cmd >> system cmd

@@ -0,0 +1,41 @@+module Development.Hake.Types (+  Rule+, RuleInner+, Targets+, Sources+, Commands++, TargetRet+, SourcesRet+, CommandIO+, CommandRet+, RuleRet++, MadeFromList++, getSrcs+, getUpdateStatus+) where++import Control.Monad.Reader (ReaderT, asks)+import System.Exit          (ExitCode)++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]) ]++getSrcs :: FilePath -> CommandIO [FilePath]+getSrcs fp = asks (maybe [] id . lookup fp . snd)++getUpdateStatus :: CommandIO Bool+getUpdateStatus = asks fst

@@ -1,5 +1,5 @@ Name:		hake-Version:	0.8+Version:	0.9 License:	GPL License-file:	LICENSE Author:		Yoshikuni Jujo@@ -14,36 +14,42 @@ 		Hakefile is just Haskell source code, 		then you can use all Haskell features. 		.+		I have changed Hakefile syntax.+		If you want to use old Hakefile,+		put 'import Development.Hake.OldFunSet'.+		. 		> import Development.Hake+		> import Development.Hake.FunSet 		> hake_rules = [ 		> 		>  dflt	[ "greeting" ] 		>  ,-		>  file	( [ "greeting", "greeting.log" ], [ "hello.o", "good-bye.o" ] ,-		> 		[ "linker -o greeting hello.o good-bye.o" ] )+		>  file	[ "greeting", "greeting.log" ] [ "hello.o", "good-bye.o" ]+		> 		[ [ "linker", "-o", "greeting", "hello.o", "good-bye.o" ] ] 		>  ,-		>  rule	( ".o", ".sfx1",-		> 		\t s -> [ "compiler1 " ++ s ++ " -o " ++ t ] )+		>  rule	".o" ".sfx1" $+		> 		\t s -> [ [ "compiler1", s, "-o", t ] ] 		>  ,-		>  rule	( ".o", ".sfx2",-		> 		\t s -> [ "compiler2 " ++ s ++ " -o " ++ t ] )+		>  rule	".o" ".sfx2" $+		> 		\t s -> [ [ "compiler2", s, "-o", t ] ] 		>  ,-		>  task	( "clean" , [ "rm -f *.o greeting greeting.log" ] )+		>  task	"clean"+		>       [ [ "rm", "-f", "hello.o", "good-by.o", "greeting", "greeting.log" ] ] 		>  ,-		>  mkfl	( "script.sh", [ "#!/bin/sh", "echo This is script", "echo made by Hakefile" ] )+		>  mkfl	"script.sh" [ "#!/bin/sh", "echo This is script", "echo made by Hakefile" ] 		>  ,-		>  ruleSS ( "", ".o", \t s -> [ (".c",  [ "gcc " ++ s ++ " -o " ++ t ] ) ,-		>                               (".cc", [ "g++ " ++ s ++ " -o " ++ t ] ) ] )+		>  ruleSS "" ".o" $ \t s -> [ (".c",  [ [ "gcc", s, "-o", t ] ] ) ,+		>                             (".cc", [ [ "g++", s, "-o", t ] ] ) ] ) 		>  ,-		>  rule   ( ".o", ".c",  \_ s -> [ "gcc -c " ++ s ] )+		>  rule   ".o" ".c" $ \_ s -> [ [ "gcc", "-c", s ] ] 		>  ,-		>  rule   ( ".o", ".cc", \_ s -> [ "g++ -c " ++ s ] )+		>  rule   ".o" ".cc" $ \_ s -> [ [ "g++", "-c", s ] ] 		>  ,-		>  base   ( [ (=="foo") ], const [ "foo.gen", "Hakefile" ], \t [s] -> [ \_ -> do+		>  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 ] )+		>               return ExitSuccess ] 		> 		>  ] 		>@@ -63,8 +69,8 @@   GHC-Options:		-Wall --  CPP-Options:		-DDEBUG   Build-Depends:	base, old-time, mtl, filepath-  Exposed-Modules:	Development.Hake-  Other-Modules:	Development.Hake.HiddenTools+  Exposed-Modules:	Development.Hake, Development.Hake.OldFunSet, Development.Hake.FunSet+  Other-Modules:	Development.Hake.HiddenTools, Development.Hake.Types  Executable hake   GHC-Options:		-Wall