# 1 "Development/Hake/HiddenTools.cpphs"
# 1 "<built-in>"
# 1 "<command-line>"
# 13 "<command-line>"
# 1 "./dist/build/autogen/cabal_macros.h" 1
# 13 "<command-line>" 2
# 1 "Development/Hake/HiddenTools.cpphs"
module Development.Hake.HiddenTools (
runHake
, isOldThanSomeOf
, hakefileUpdateOption
) where
import System.Directory (createDirectory, doesDirectoryExist,
doesFileExist, copyFile, getModificationTime)
import System.Process (runProcess, waitForProcess)
import System.Exit (ExitCode)
import System.Time (ClockTime)
import System.IO (openFile, hClose, IOMode(WriteMode))
import Control.Applicative ((<$>), liftA2)
import Control.Monad (when)
import Control.Monad.Utils (unlessM)
import Control.Exception (bracket)
maybeGetModificationTime :: FilePath -> IO (Maybe ClockTime)
maybeGetModificationTime fn = do
ex <- doesFileExist fn
if ex then Just <$> getModificationTime fn
else return Nothing
isOldThanSomeOf :: FilePath -> [FilePath] -> IO Bool
isOldThanSomeOf dfn sfns
= liftA2 ((myOr .) . map . (<)) (maybeGetModificationTime dfn)
(mapM maybeGetModificationTime sfns)
where
myOr [] = True
myOr bs = or bs
hakefileUpdateOption :: String
hakefileUpdateOption = "--hakefile-is-updated"
runHake :: FilePath -> FilePath -> [ FilePath ] -> [ String ] -> IO ExitCode
runHake src exe othrs args = do
unlessM (doesDirectoryExist "_hake") $ createDirectory "_hake"
othrsUD <- fmap or $ flip mapM othrs $ \fn -> do
let dist = "_hake/" ++ basename fn
updated <- isOldThanSomeOf dist [ fn ]
when updated $ copyFile fn dist
return updated
hakefileUD <- isOldThanSomeOf ("_hake/" ++ exe ++ ".hs") [ src ]
when hakefileUD $
readFile src >>= writeFile ("_hake/" ++ exe ++ ".hs")
bracket (flip openFile WriteMode $ "_hake/" ++ exe ++ ".error") hClose $ \errH ->
let mErrH = Just errH in
runProcess "ghc" [ "--make", exe ] (Just "_hake")
Nothing Nothing Nothing mErrH >>= waitForProcess
let args_ = if othrsUD || hakefileUD then (hakefileUpdateOption:args) else args
runProcess ("_hake/" ++ exe) (if null args then ("default":args_) else args_)
Nothing Nothing Nothing Nothing Nothing >>= waitForProcess
basename :: FilePath -> FilePath
basename = reverse . takeWhile (/='/') . reverse