HiddenTools.hs

{- 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
, isOldThanSomeOf
, hakefileUpdateOption
, defaultTrgtStr
) where

import System.IO            (openFile, hClose, IOMode(WriteMode))
import System.Directory     (createDirectory, doesDirectoryExist,
                             doesFileExist, copyFile, getModificationTime)
import System.Exit          (ExitCode(ExitSuccess))
import System.Time          (ClockTime)
import System.Process       (runProcess, waitForProcess)
import System.FilePath      (takeFileName)
import Control.Monad.Utils  (unlessM, ifM)
import Control.Applicative  ((<$>), liftA2)
import Control.Exception    (bracket)

hakeDir, defaultTrgtStr, hakefileUpdateOption :: String
hakeDir              = "_hake/"
defaultTrgtStr       = "default"
hakefileUpdateOption = "--hakefile-is-updated"

maybeGetModificationTime :: FilePath -> IO (Maybe ClockTime)
maybeGetModificationTime fn
  = ifM (doesFileExist fn)
        (Just <$> getModificationTime fn)
        (return Nothing)

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

runHake :: FilePath -> FilePath -> [ FilePath ] -> [ String ] -> IO ExitCode
runHake src exe othrs args = do
  let exePath = hakeDir ++ exe
      exeSrc  = hakeDir ++ exe ++ ".hs"
      errFile = hakeDir ++ exe ++ ".error"
  unlessM (doesFileExist src) $
    error $ "runHake: " ++ src ++ " does not exist"
  unlessM (and <$> mapM doesFileExist othrs) $
    error $ "runHake: " ++ unwords othrs ++ " does not exist"
  unlessM (doesDirectoryExist hakeDir) $ createDirectory hakeDir
  othrsUD <- fmap or $ flip mapM othrs $ \fn -> do
    let dist = hakeDir ++ takeFileName fn
    ifM (isOldThanSomeOf dist [ fn ])
        (copyFile fn dist >> return True)
	(                    return False)
  hakefileUD <-
    ifM (isOldThanSomeOf exeSrc [ src ])
        (readFile src >>= writeFile exeSrc >> return True )
	(                                     return False)
  ret <- bracket (openFile errFile WriteMode) hClose $ \errH ->
           runProcess "ghc" [ "--make", exe ] (Just hakeDir)
                      Nothing Nothing Nothing (Just errH) >>= waitForProcess
  case ret of
       ExitSuccess -> return ()
       _           -> readFile errFile >>= putStr
  let args_ = applyWhen (othrsUD || hakefileUD) (hakefileUpdateOption:) $
                defaultElem defaultTrgtStr args
  runProcess exePath args_ Nothing Nothing Nothing Nothing Nothing >>= waitForProcess

defaultElem :: a -> [a] -> [a]
defaultElem dflt []  = [dflt]
defaultElem _    lst = lst

applyWhen :: Bool -> (a -> a) -> a -> a
applyWhen b f = if b then f else id