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) $ ghcMake exe hakeDir >> return ()
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