OldFunSet.hs

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 = 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 )

task :: ( String, [String] ) -> Rule
task ( trgts, cmd )       = ( (==trgts), const [], const2 $ abortIfFailure $ map systemEInner 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 )

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