hake 0.9.5 → 0.9.9

raw patch · 13 files changed

+447/−289 lines, 13 filesdep ~yjtoolsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: yjtools

API changes (from Hackage documentation)

Files

• Development/Hake.hs +88/−64
• Development/Hake/Core.hs +53/−0
• Development/Hake/FunSet.hs +18/−62
• Development/Hake/FunSetIO.hs +46/−0
• Development/Hake/FunSetRaw.hs +42/−0
• Development/Hake/HiddenTools.hs +0/−83
• Development/Hake/OldFunSet.hs +13/−54
• Development/Hake/RunHake.hs +61/−0
• Development/Hake/Tools.hs +33/−0
• Development/Hake/Types.hs +11/−4
• Development/Hake/Variables.hs +40/−0
• Main.hs +33/−10
• hake.cabal +9/−12

@@ -16,45 +16,58 @@ -}  module Development.Hake (+   Rule , hake , hakeT , hakefileIs +, base+, dflt+, mkfl+ , addDeps+, setCmd +, systemE+, rawSystemE+ , isSuffixOf , changeSuffix-, ExitCode(ExitSuccess)+, getVals+, getNewers++, ExitCode(ExitSuccess, ExitFailure)+ ) where  import System.Environment           (getArgs)-import System.Exit                  (ExitCode(ExitSuccess))+import System.Exit                  (ExitCode(ExitSuccess, ExitFailure)) import System.Directory             (doesFileExist) import System.Directory.Tools       (maybeGetModificationTime) import System.IO.Unsafe             (unsafeInterleaveIO)-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 Development.Hake.HiddenTools (runHake, hakefileUpdateOption,-                                     defaultTrgtStr, changeSuffix)-import Development.Hake.Types       (Rule, RuleInner,-                                     TargetRet, SourcesRet, CommandRet, RuleRet,-				     MadeFromList)--ruleToRuleInner :: Rule -> RuleInner-ruleToRuleInner ( x, y, z ) = ( x, (y, z) )--ruleRetToMadeFromList :: [ RuleRet ] -> MadeFromList-ruleRetToMadeFromList = map (\(x, (y, _)) -> (x, y))+import Control.Monad.Trans          (lift)+import Control.Monad.Reader         (ReaderT(runReaderT), asks)+import Control.Monad.Tools          (whenM)+import Control.Applicative          ((<$>))+import Data.List                    (isSuffixOf, isPrefixOf)+import Data.List.Tools              (dropUntil)+import Data.Maybe                   (listToMaybe, catMaybes)+import Data.Bool.Tools              ((&&&), (|||))+import Data.Function.Tools          (const2)+import Development.Hake.Core        (traceRule, applyRule)+import Development.Hake.RunHake     (runHake)+import Development.Hake.Tools       (orDie, changeSuffix, systemE, rawSystemE)+import Development.Hake.Types       (Rule, RuleInner, ruleToRuleInner,+				     Targets, Sources, Commands,+				     MadeFromList, ruleRetToMadeFromList,+				     getUpdateStatus)+import Development.Hake.Variables   (hakefileUpdateOption, defaultTrgtStr) --- |The 'hake' function take rules as argument and get target from command line and make target.+-- |The 'hake' function take rules as argument and get target from command line+--  and make target. hake :: [ Rule ] -> IO ()-hake rl = do args <- getArgs+hake rl = do args <- filter (notElem '=') <$> getArgs              let ud    = elem hakefileUpdateOption args 	         trgts = filter (/=hakefileUpdateOption) args 	     mapM_ (hakeTarget ud (map ruleToRuleInner rl)) trgts@@ -62,56 +75,67 @@ hakeT :: [ Rule ] -> FilePath -> IO () hakeT = hakeTarget True . map ruleToRuleInner +hakefileIs :: FilePath -> [ FilePath ] -> IO ExitCode+hakefileIs src others = getArgs >>= runHake src src others+ hakeTarget :: Bool -> [ RuleInner ] -> FilePath -> IO () hakeTarget ud rls fn = do-  rrls <- traceRule fn rls+  rrls <- traceRule unsafeInterleaveIO doesFileExist 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, cmd))-  = ifM ( lift $ isOldThanSomeOf src dsts )-        cmd-        ( return ExitSuccess )--isOldThanSomeOf :: FilePath -> [FilePath] -> IO Bool-isOldThanSomeOf dfn sfns-  = liftA2 ((myOr .) . map . (<)) (maybeGetModificationTime dfn)-                                  (mapM maybeGetModificationTime sfns)-    where-      -- for task like "clean"-      myOr [] = True-      myOr bs = or bs--myLookup :: a -> [ (a -> Bool, b) ] -> [ (b, [ (a -> Bool, b) ]) ]-myLookup _ []            = []-myLookup x (pair@(p, y):rest)-  | p x -- or $ map ($x) p-    = (y, rest) : ( second (pair:) <$> myLookup x rest )-  | otherwise-    =               second (pair:) <$> myLookup x rest+       r:_ -> flip runReaderT (ud, ruleRetToMadeFromList r) $ mapM_ applyRule+                                                            $ reverse r  addDeps :: [ Rule ] -> [ (FilePath, [FilePath]) ] -> [ Rule ]-addDeps rls adrls = concatMap ad adrls ++ rls+addDeps rls adrls = concatMap ad adrls ++ map dels rls   where   ad :: (FilePath, [FilePath]) -> [ Rule ]   ad (t, ss) = [ ((==t), const $ sgen t ++ ss, c) |                  (testT, sgen, c) <- rls, testT t ]+  dels :: Rule -> Rule+  dels r = foldr del r $ map fst adrls+  del :: FilePath -> Rule -> Rule+  del t r@(pt, _, _)+    | pt t      = modifyFirstOfThree (&&& (/=t)) r+    | otherwise = r+  modifyFirstOfThree f (x, y, z) = (f x, y, z) -hakefileIs :: FilePath -> [ FilePath ] -> IO ExitCode-hakefileIs src others = do-  args <- getArgs-  runHake src "hake_" others $ if null args then [ defaultTrgtStr ] else args+setCmd ::+  Rule -> ( String -> [ String ] -> MadeFromList -> IO ExitCode ) -> Rule+setCmd (trgts, srcs, _) cmdsGen = (trgts, srcs, cmd)+  where cmd :: Commands+        cmd t s = do mfl <- asks snd+	             lift $ cmdsGen t s mfl `orDie` show++getVals :: String -> [String] -> [String]+getVals var args = maybe [] words $+  dropUntil (=='=') <$> (listToMaybe $ filter (isPrefixOf $ var ++ "=") args)++getNewers :: FilePath -> [ FilePath ] -> IO [ FilePath ]+getNewers fb fs = catMaybes <$> mapM getNewer fs+  where+  getNewer :: FilePath -> IO (Maybe FilePath)+  getNewer f = do+    tb <- maybeGetModificationTime fb+    t  <- maybeGetModificationTime f+    if (tb < t) then return $ Just f else return Nothing++base ::+  Targets -> Sources+          -> ( String -> [ String ] -> MadeFromList -> Bool -> IO ExitCode )+          -> Rule+base trgts srcs cmdsGen = (trgts, srcs, cmd)+  where cmd :: Commands+        cmd t s = do mfl <- asks snd+	             us  <- asks fst+		     lift $ cmdsGen t s mfl us `orDie` show++dflt :: [ String ] -> Rule+dflt trgts = ( (==defaultTrgtStr), const trgts, const2 $ return () )++mkfl :: String -> [ String ] -> Rule+mkfl trgt cont+  = ( (==trgt), const [], \t -> const $ do+        whenM (getUpdateStatus ||| lift (not <$> doesFileExist trgt)) $ do+	  lift $ putStrLn $ "make file `" ++ trgt ++ "' (hake)"+	  lift $ writeFile t $ unlines cont )

@@ -0,0 +1,53 @@+module Development.Hake.Core (++  traceRule+, applyRule++) where++import System.Directory          (doesFileExist)+import System.Directory.Tools    (maybeGetModificationTime)+import Control.Monad.Trans       (lift)+import Control.Monad.Tools       (ifM)+import Control.Applicative       ((<$>), liftA2)+import Control.Applicative.Tools ((<.>))+import Control.Arrow             (second)+import Data.List.Tools           (mulLists)+import Development.Hake.Types    (RuleRet, RuleInner, CommandIO)++traceRule ::+  (Monad m, Functor m) =>+  (m [[ RuleRet ]] -> m [[ RuleRet ]]) -> (FilePath -> m Bool) ->+  FilePath -> [ RuleInner ] -> m [[ RuleRet ]]+traceRule opt tst trgt rls+  = case myLookup trgt rls of+      []    -> ifM (tst trgt) (return [[]]) (return [])+      finds -> do+        optional <- ifM (tst trgt) (return [[]]) (return [])+        fmap (++ optional) $ concat <.> flip mapM finds+	                   $ \((tToS, tsToCmds), restRls) -> do+          let srcs = tToS trgt+	      cmds = tsToCmds trgt srcs+          obtainedRls <- mapM (opt . flip (traceRule opt tst) restRls) srcs+	  return $ map ( (( trgt, (srcs, cmds) ):) . concat )+	         $ mulLists obtainedRls++myLookup :: a -> [ (a -> Bool, b) ] -> [ (b, [ (a -> Bool, b) ]) ]+myLookup _ []            = []+myLookup x (pair@(p, y):rest)+  | p x       = (y, rest) : ( second (pair:) <$> myLookup x rest )+  | otherwise =               second (pair:) <$> myLookup x rest++applyRule :: RuleRet -> CommandIO ()+applyRule (src, (dsts, cmd))+  = ifM ( lift $ isOldThanSomeOf src dsts ) cmd ( return () )++isOldThanSomeOf :: FilePath -> [FilePath] -> IO Bool+isOldThanSomeOf dfn sfns =+  flip (ifM $ doesFileExist dfn) (return True) $+    liftA2 ((myOr .) . map . (<)) (maybeGetModificationTime dfn)+                                  (mapM maybeGetModificationTime sfns)+    where+      -- for task like "clean"+      myOr [] = True+      myOr bs = or bs

@@ -1,85 +1,41 @@ module Development.Hake.FunSet ( -  base-, file+  file , task , rule , ruleV , 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, cmd)-  where cmd :: Commands-        cmd t s = 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 $ return ExitSuccess )+import Development.Hake.Types       (Rule, getSrcs)+import Development.Hake.Tools       (changeSuffix, systemE) -file :: [String] -> [String] -> [[String]] -> Rule+file :: [String] -> [String] -> (String -> [String]) -> Rule file trgts srcs cmd-  = ( \f -> or $ map (==f) trgts, const srcs, const2 $ abortIfFailure $ map systemEInner cmd )+  = ( \f -> or $ map (==f) trgts, const srcs,+      \t -> const $ sequence_ $ map systemE $ cmd t ) -task :: String -> [[String]] -> Rule-task trgts cmd = ( (==trgts), const [], const2 $ abortIfFailure $ map systemEInner cmd )+task :: String -> [String] -> Rule+task trgts cmd = ( (==trgts), const [], const2 $ sequence_ $ map systemE cmd ) -rule :: String -> String -> (String -> [String] -> [[String]]) -> Rule+rule :: String -> String -> (String -> [String] -> [String]) -> Rule rule trgt src cmd   = ( isSuffixOf trgt, \dst -> [changeSuffix trgt src dst ],-      \t s -> abortIfFailure $ map systemEInner $ cmd t s )+      \t s -> sequence_ $ map systemE $ cmd t s ) -ruleV :: String -> [String] -> [String] -> (String -> [String] -> [[String]]) -> Rule+ruleV ::+  String -> [String] -> [String] -> (String -> [String] -> [String]) -> Rule ruleV trgt srcs cmmns cmd   = ( isSuffixOf trgt, \dst -> map (flip (changeSuffix trgt) dst) srcs ++ cmmns,-        \t s -> abortIfFailure $ map systemEInner $ cmd t s )+      \t s -> sequence_ $ map systemE $ cmd t s ) -ruleSS :: String -> String -> (String -> [String] -> [ (String, [[String]]) ]) -> Rule+ruleSS ::+  String -> String -> (String -> [String] -> [ (String, [String]) ]) -> Rule ruleSS trgt src cmds   = ( isSuffixOf trgt, \dst -> [ changeSuffix trgt src dst ],-        \t s -> do [ srcSrc ] <- getSrcs $ head 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)+      \t s -> do (srcSrc:_) <- getSrcs $ head s+	         sequence_ $ map systemE $ snd $ head $+		   filter ( flip isSuffixOf srcSrc . fst ) $ cmds t s )

@@ -0,0 +1,46 @@+module Development.Hake.FunSetIO (++  file+, task+, rule+, ruleV+, ruleSS++, orDie++) where++import System.Exit                  (ExitCode)+import Data.List                    (isSuffixOf)+import Data.Function.Tools          (const2)+import Control.Monad.Reader         (lift)+import Development.Hake.Types       (Rule, getSrcs)+import Development.Hake.Tools       (orDie, changeSuffix)+                                     ++file :: [String] -> [String] -> (String -> IO ExitCode) -> Rule+file trgts srcs cmd+  = ( \f -> or $ map (==f) trgts, const srcs,+      const . lift . (flip orDie show) . cmd )++task :: String -> IO ExitCode -> Rule+task trgts cmd = ( (==trgts), const [], const2 $ lift cmd `orDie` show)++rule :: String -> String -> (String -> [String] -> IO ExitCode) -> Rule+rule trgt src cmd+  = ( isSuffixOf trgt, \dst -> [changeSuffix trgt src dst ],+      (.) (flip orDie show) . (.) lift . cmd )++ruleV ::+  String -> [String] -> [String] -> (String -> [String] -> IO ExitCode) -> Rule+ruleV trgt srcs cmmns cmd+  = ( isSuffixOf trgt, \dst -> map (flip (changeSuffix trgt) dst) srcs ++ cmmns,+      (.) (flip orDie show) . (.) lift . cmd )++ruleSS ::+  String -> String -> (String -> [String] -> [ (String, IO ExitCode) ]) -> Rule+ruleSS trgt src cmds+  = ( isSuffixOf trgt, \dst -> [ changeSuffix trgt src dst ],+      \t s -> do (srcSrc:_) <- getSrcs $ head s+	         lift $ flip orDie show $ snd $ head $+		   filter ( flip isSuffixOf srcSrc . fst ) $ cmds t s)

@@ -0,0 +1,42 @@+module Development.Hake.FunSetRaw (++  file+, task+, rule+, ruleV+, ruleSS++) where++import Data.List                    (isSuffixOf)+import Data.Function.Tools          (const2)+import Development.Hake.Types       (Rule, getSrcs)+import Development.Hake.Tools       (changeSuffix, rawSystemE)++file :: [String] -> [String] -> (String -> [[String]]) -> Rule+file trgts srcs cmd+  = ( \f -> or $ map (==f) trgts, const srcs,+      \t -> const $ sequence_ $ map rawSystemE $ cmd t )++task :: String -> [[String]] -> Rule+task trgts cmd+  = ( (==trgts), const [], const2 $ sequence_ $ map rawSystemE cmd )++rule :: String -> String -> (String -> [String] -> [[String]]) -> Rule+rule trgt src cmd+  = ( isSuffixOf trgt, \dst -> [changeSuffix trgt src dst ],+      \t s -> sequence_ $ map rawSystemE $ cmd t s )++ruleV ::+  String -> [String] -> [String] -> (String -> [String] -> [[String]]) -> Rule+ruleV trgt srcs cmmns cmd+  = ( isSuffixOf trgt, \dst -> map (flip (changeSuffix trgt) dst) srcs ++ cmmns,+      \t s -> sequence_ $ map rawSystemE $ 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 $ head s+	         sequence_ $ map rawSystemE $ snd $ head $+		   filter ( flip isSuffixOf srcSrc . fst ) $ cmds t s )

@@ -1,83 +0,0 @@-{- 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-, hakefileUpdateOption-, defaultTrgtStr-, abortIfFailure-, changeSuffix-) where--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)-hakeDir              = "_hake/"-defaultTrgtStr       = "default"-hakefileUpdateOption = "--hakefile-is-updated"-srcSuffix            = ".hs"-commentPair          = ("{- ", " -}")--runHake :: FilePath -> FilePath -> [ FilePath ] -> [ String ] -> IO ExitCode-runHake src exe othrs args = do-  let exePath = hakeDir ++ exe-      exeSrc  = hakeDir ++ exe ++ srcSuffix-  mapM_ errorExist $ src : othrs-  unlessM (doesDirectoryExist hakeDir) $ createDirectory hakeDir-  othrsUD <- fmap or-               $ flip mapM othrs-               $ apply2way (updateFile commentPair) id $-			                            (hakeDir ++) . takeFileName-  hakefileUD  <- updateFile commentPair src exeSrc-  notUpdated  <- doesNotExistOrOldThan exePath exeSrc-  when (othrsUD || hakefileUD || notUpdated) $ do-    ec <- ghcMake exe hakeDir-    when (ec /= ExitSuccess) $ exitWith ec-  let args_ = applyWhen (othrsUD || hakefileUD) (hakefileUpdateOption:) $-                defaultElem defaultTrgtStr args-  runProcess exePath args_ Nothing Nothing Nothing Nothing Nothing-    >>= waitForProcess--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

@@ -1,77 +1,36 @@ module Development.Hake.OldFunSet ( -  base-, file+  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)+import Development.Hake.Types       (Rule, getSrcs)+import Development.Hake.Tools       (changeSuffix, systemE) -base ::-  ( Targets, Sources, String -> [ String ] -> [ MadeFromList -> IO ExitCode ] )-  -> Rule-base (trgts, srcs, cmdsGen) = (trgts, srcs, cmds)-  where cmds :: Commands-        cmds t s = abortIfFailure $ 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 $ return ExitSuccess )- file :: ( [String], [String], [String] ) -> Rule-file ( trgts, srcs, cmd ) = ( \f -> or $ map (==f) trgts, const srcs, const2 $ abortIfFailure $ map systemEInner cmd )+file ( trgts, srcs, cmd )+  = ( \f -> or $ map (==f) trgts, const srcs,+      const2 $ sequence_ $ map systemE cmd )  task :: ( String, [String] ) -> Rule-task ( trgts, cmd )       = ( (==trgts), const [], const2 $ abortIfFailure $ map systemEInner cmd )+task ( trgts, cmd )+  = ( (==trgts), const [], const2 $ sequence_ $ map systemE cmd )  rule :: ( String, String, String -> String -> [String] ) -> Rule rule ( trgt, src, cmd )   = ( isSuffixOf trgt, \dst -> [changeSuffix trgt src dst ],-      \t (s:_) -> abortIfFailure $ map systemEInner $ cmd t s )+      \t (s:_) -> sequence_ $ 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 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+      \t (s:_) -> do [ srcSrc ] <- getSrcs s+	             sequence_ $ map systemE $+		       snd $ head $+		       filter ( flip isSuffixOf srcSrc . fst ) $ cmds t s )

@@ -0,0 +1,61 @@+{- 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.RunHake (++  runHake++) where++import System.Exit                (ExitCode(ExitSuccess), exitWith)+import System.Directory           (createDirectory, doesDirectoryExist,+                                   doesFileExist)+import System.Directory.Tools     (doesNotExistOrOldThan)+import System.FilePath            (takeFileName)+import System.Process             (runProcess, waitForProcess)+import Control.Monad              (when)+import Control.Monad.Tools        (unlessM)+import Data.Function.Tools        (applyWhen, apply2way)+import YJTools.Tribial            (ghcMake, updateFile)+import Text.RegexPR               (gsubRegexPR)+import Development.Hake.Variables (defaultTrgtStr, hakefileUpdateOption,+                                   hakeDir, commentPair, srcSuffix, exeEscPairs)++runHake :: FilePath -> FilePath -> [ FilePath ] -> [ String ] -> IO ExitCode+runHake src exe othrs args = do+  let bin     = foldr (uncurry gsubRegexPR) exe exeEscPairs+      binPath = hakeDir ++ bin+      binSrc  = hakeDir ++ bin ++ srcSuffix+  mapM_ errorNotExist $ src : othrs+  unlessM (doesDirectoryExist hakeDir) $ createDirectory hakeDir+  othrsUD+    <- fmap or $ flip mapM othrs+               $ apply2way (updateFile commentPair) id $+			                            (hakeDir ++) . takeFileName+  hakefileUD  <- updateFile commentPair src binSrc+  notUpdated  <- doesNotExistOrOldThan binPath binSrc+  when (othrsUD || hakefileUD || notUpdated) $ do+    ec <- ghcMake bin hakeDir+    when (ec /= ExitSuccess) $ exitWith ec+  let args_  = applyWhen (othrsUD || hakefileUD) (hakefileUpdateOption:) $+                 applyWhen (null $ filter (notElem '=') args) (defaultTrgtStr:) args+  runProcess binPath args_ Nothing Nothing Nothing Nothing Nothing+    >>= waitForProcess++errorNotExist :: FilePath -> IO ()+errorNotExist fp = unlessM (doesFileExist fp) $+                     error $ "runHake: " ++ fp ++ " does not exist"

@@ -0,0 +1,33 @@+module Development.Hake.Tools (++  changeSuffix+, orDie+, systemE+, rawSystemE++) where++import System.Exit         (ExitCode(ExitSuccess, ExitFailure), exitWith)+import System.Cmd          (system, rawSystem)+import Control.Monad.Trans (MonadIO, liftIO)+import Data.List           (isSuffixOf)++orDie :: MonadIO m => m ExitCode -> (ExitCode -> String) -> m ()+orDie act msg = do+  ec <- act+  case ec of+    ExitSuccess   -> return ()+    ExitFailure _ -> do liftIO $ putStrLn $ msg ec+                        liftIO $ 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++systemE :: MonadIO m => String -> m ExitCode+systemE cmd = liftIO (putStrLn cmd) >> liftIO (system cmd)++rawSystemE :: MonadIO m => [ String ] -> m ExitCode+rawSystemE []  = error "rawSystemE: command not exist"+rawSystemE cmd = liftIO (putStrLn $ unwords cmd) >> liftIO (rawSystem (head cmd) (tail cmd))

@@ -5,20 +5,21 @@ , Sources , Commands -, TargetRet-, SourcesRet+, TargetRet	-- for Unit Test+, SourcesRet	-- for Unit Test , CommandIO , CommandRet , RuleRet  , MadeFromList +, ruleToRuleInner+, ruleRetToMadeFromList , getSrcs , getUpdateStatus ) where  import Control.Monad.Reader (ReaderT, asks)-import System.Exit          (ExitCode)  type Targets   = String -> Bool type Sources   = String -> SourcesRet@@ -29,7 +30,7 @@ type TargetRet   = String type SourcesRet  = [ String ] type CommandIO   = ReaderT (Bool, MadeFromList) IO-type CommandRet  = CommandIO ExitCode+type CommandRet  = CommandIO () type RuleRet     = ( TargetRet, (SourcesRet, CommandRet) )  type MadeFromList = [ (FilePath, [FilePath]) ]@@ -39,3 +40,9 @@  getUpdateStatus :: CommandIO Bool getUpdateStatus = asks fst++ruleToRuleInner :: Rule -> RuleInner+ruleToRuleInner ( t, s, c ) = ( t, (s, c) )++ruleRetToMadeFromList :: [ RuleRet ] -> MadeFromList+ruleRetToMadeFromList = map (\(t, (s, _)) -> (t, s))

@@ -0,0 +1,40 @@+{- 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.Variables (++  hakeDir+, srcSuffix+, commentPair+, exeEscPairs++, defaultTrgtStr+, hakefileUpdateOption++) where++hakeDir, defaultTrgtStr, hakefileUpdateOption, srcSuffix :: String+commentPair :: (String, String)+exeEscPairs :: [ (String, String) ]++hakeDir              = "_hake/"+srcSuffix            = ".hs"+commentPair          = ("{- ", " -}")+exeEscPairs          = [("/","_s_"),("\\.","_d_"),("_","_u_")]++defaultTrgtStr       = "default"+hakefileUpdateOption = "--hakefile-is-updated"

@@ -18,16 +18,39 @@ module Main where  import System.Environment           (getArgs)-import System.Exit                  (ExitCode(ExitSuccess))-import Development.Hake.HiddenTools (runHake, defaultTrgtStr)-import Paths_hake                   (version)+import System.Console.GetOpt        (getOpt,+                                     ArgOrder(Permute), OptDescr(Option),+				     ArgDescr(ReqArg, NoArg))+import System.Exit                  (exitWith, ExitCode(ExitFailure)) import Data.Version                 (showVersion)+import Data.Maybe                   (mapMaybe)+import Control.Applicative          ((<$>))+import Paths_hake                   (version)+import Development.Hake.RunHake     (runHake) -main :: IO ExitCode+main :: IO () main = do-  args <- getArgs-  case args of-       [ "--version" ] ->-	 putStrLn ("hake " ++ showVersion version) >> return ExitSuccess-       _               ->-	 runHake "Hakefile" "hake" [] (if null args then [defaultTrgtStr] else args)+  (ver, hFile, args) <- processArgs+  if ver then putStrLn ("hake " ++ showVersion version)+         else runHake hFile hFile [] args >>= exitWith++processArgs :: IO ( Bool, String, [ String ] )+processArgs = do+  (opts, args, errMsgs) <- getOpt Permute optionList <$> getArgs+  let ver   = elem OptVersion opts+      hFile = head $ mapMaybe getHakefile $ opts ++ [ OptHakefile "Hakefile" ]+  case errMsgs of+       [] -> return ()+       _  -> mapM_ putStr errMsgs >> exitWith (ExitFailure 1)+  return ( ver, hFile, args )++data Opt = OptVersion | OptHakefile FilePath deriving Eq+getHakefile :: Opt -> Maybe FilePath+getHakefile (OptHakefile hf) = Just hf+getHakefile _                = Nothing++optionList :: [ OptDescr Opt ]+optionList = [+ Option "f" [] (ReqArg OptHakefile "file as Hakefile") "set Hakefile",+ Option "" [ "version" ] (NoArg OptVersion) "show version"+ ]

@@ -1,5 +1,5 @@ Name:		hake-Version:	0.9.5+Version:	0.9.9 License:	GPL License-file:	LICENSE Author:		Yoshikuni Jujo@@ -19,13 +19,13 @@ 		put 'import Development.Hake.OldFunSet'. 		. 		> import Development.Hake-		> import Development.Hake.FunSet+		> import Development.Hake.FunSetRaw 		> 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" ] $+		> 		const [ [ "linker", "-o", "greeting", "hello.o", "good-bye.o" ] ] 		>  , 		>  rule	".o" ".sfx1" $ 		> 		\t (s:_) -> [ [ "compiler1", s, "-o", t ] ]@@ -45,7 +45,7 @@ 		>  , 		>  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@@ -55,7 +55,7 @@ 		> 		> main = hake hake_rules -Stability:	experimental+Stability:	semi-stable Homepage:	http://homepage3.nifty.com/salamander/second/projects/hake/index.xhtml Package-Url:	http://code.haskell.org/hake/ Cabal-Version:	>= 1.2@@ -67,14 +67,11 @@  Library   GHC-Options:		-Wall---  CPP-Options:		-DDEBUG   Build-Depends:	base, old-time, mtl, filepath-  Exposed-Modules:	Development.Hake, Development.Hake.OldFunSet, Development.Hake.FunSet-  Other-Modules:	Development.Hake.HiddenTools, Development.Hake.Types+  Exposed-Modules:	Development.Hake, Development.Hake.OldFunSet, Development.Hake.FunSet, Development.Hake.FunSetRaw, Development.Hake.FunSetIO+  Other-Modules:	Development.Hake.Variables, Development.Hake.Types, Development.Hake.Tools, Development.Hake.RunHake, Development.Hake.Core  Executable hake   GHC-Options:		-Wall---  CPP-Options:		-DDEBUG-  Build-Depends:	directory, process, yjtools >= 0.6, regexpr >= 0.3-  Other-Modules:	Development.Hake.HiddenTools+  Build-Depends:	directory, process, yjtools >= 0.9.5, regexpr >= 0.3   Main-Is:		Main.hs