module Development.Hake (
Rule
, hake
, hakeT
, hakefileIs
, addDeps
, isSuffixOf
, changeSuffix
, ExitCode(ExitSuccess)
) where
import System.Environment (getArgs)
import System.Exit (ExitCode(ExitSuccess))
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))
hake :: [ Rule ] -> IO ()
hake rl = do args <- getArgs
let ud = elem hakefileUpdateOption args
trgts = filter (/=hakefileUpdateOption) args
mapM_ (hakeTarget ud (map ruleToRuleInner rl)) trgts
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, 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
myOr [] = True
myOr bs = or bs
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
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, testT t ]
hakefileIs :: FilePath -> [ FilePath ] -> IO ExitCode
hakefileIs src others = do
args <- getArgs
runHake src "hake_" others $ if null args then [ defaultTrgtStr ] else args