diff --git a/Development/Hake.hs b/Development/Hake.hs --- a/Development/Hake.hs +++ b/Development/Hake.hs @@ -151,10 +151,15 @@ ExitSuccess -> return ec _ -> lift $ exitWith ec +orM :: Monad m => m Bool -> m Bool -> m Bool +orM p1 p2 = do b1 <- p1 + b2 <- p2 + return $ b1 || b2 + mkfl :: ( String, [ String ] ) -> Rule mkfl ( trgt, cont ) = ( [ (==trgt) ], const [], \t -> const [ do - whenM getUpdateStatus $ do + whenM (getUpdateStatus `orM` lift (not <$> doesFileExist trgt)) $ do lift $ putStrLn $ "make file `" ++ trgt ++ "' (hake)" lift $ writeFile t $ unlines cont return ExitSuccess ] ) diff --git a/Development/Hake/HiddenTools.cpphs b/Development/Hake/HiddenTools.cpphs deleted file mode 100644 --- a/Development/Hake/HiddenTools.cpphs +++ /dev/null @@ -1,84 +0,0 @@ -{- hake: make tool. ruby : rake = haskell : hake -Copyright (C) 2008-2008 Yoshikuni Jujo - -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 . --} - -module Development.Hake.HiddenTools ( - runHake -, isOldThanSomeOf -, hakefileUpdateOption -, defaultTrgtStr -) where - -import System.Directory (createDirectory, doesDirectoryExist, - doesFileExist, copyFile, getModificationTime) -import System.Process (runProcess, waitForProcess) -import System.Exit (ExitCode(ExitSuccess)) -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 - -- for task like "clean" - 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") -#ifndef DEBUG - ret <- bracket (flip openFile WriteMode $ "_hake/" ++ exe ++ ".error") hClose $ \errH -> - let mErrH = Just errH in -#else - let mErrH = Nothing in -#endif /* DEBUG */ - runProcess "ghc" [ "--make", exe ] (Just "_hake") - Nothing Nothing Nothing mErrH >>= waitForProcess - let args_ = if othrsUD || hakefileUD then (hakefileUpdateOption:args) else args - case ret of - ExitSuccess -> return () - _ -> readFile ("_hake/" ++ exe ++ ".error") >>= putStr - runProcess ("_hake/" ++ exe) (if null args then ("default":args_) else args_) - Nothing Nothing Nothing Nothing Nothing >>= waitForProcess - -basename :: FilePath -> FilePath -basename = reverse . takeWhile (/='/') . reverse - -defaultTrgtStr :: String -defaultTrgtStr = "default" diff --git a/Development/Hake/HiddenTools.hs b/Development/Hake/HiddenTools.hs new file mode 100644 --- /dev/null +++ b/Development/Hake/HiddenTools.hs @@ -0,0 +1,90 @@ +{- hake: make tool. ruby : rake = haskell : hake +Copyright (C) 2008-2008 Yoshikuni Jujo + +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 . +-} + +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 diff --git a/hake.cabal b/hake.cabal --- a/hake.cabal +++ b/hake.cabal @@ -1,5 +1,5 @@ Name: hake -Version: 0.4 +Version: 0.5 License: GPL License-file: LICENSE Author: Yoshikuni Jujo @@ -32,11 +32,6 @@ > , > mkfl ( "script.sh", [ "#!/bin/sh", "echo This is script", "echo made by Hakefile" ] ) > , - > mkfl2 ( "script.sh", [ "script.sh.gen" ], \[s] -> - > do gen <- readFile s - > return $ [ "#!/bin/sh", "echo This is script", "echo made by Hakefile" ] - > ++ gen ) - > , > ruleSS ( "", ".o", \t s -> [ (".c", [ "gcc " ++ s ++ " -o " ++ t ] ) , > (".cc", [ "g++ " ++ s ++ " -o " ++ t ] ) ] ) > , @@ -55,7 +50,7 @@ Stability: experimental Homepage: http://homepage3.nifty.com/salamander/second/projects/hake/index.xhtml -Package-Url: http://homepage3.nifty.com/salamander/second/portage/distfiles/hake-0.4.tar.gz +Package-Url: http://homepage3.nifty.com/salamander/second/portage/distfiles/hake-0.5.tar.gz Cabal-Version: >= 1.2 Build-type: Simple Tested-With: GHC @@ -66,7 +61,7 @@ Library GHC-Options: -Wall -- CPP-Options: -DDEBUG - Build-Depends: base, old-time, mtl + Build-Depends: base, old-time, mtl, filepath Exposed-Modules: Development.Hake Other-Modules: Development.Hake.HiddenTools