hake 0.6 → 0.7
raw patch · 3 files changed
+46/−78 lines, 3 filesdep ~regexprdep ~yjtools
Dependency ranges changed: regexpr, yjtools
Files
- Development/Hake.hs +20/−11
- Development/Hake/HiddenTools.hs +23/−64
- hake.cabal +3/−3
Development/Hake.hs view
@@ -41,16 +41,18 @@ import System.Exit (ExitCode(ExitSuccess), exitWith) import System.Cmd (system) import System.Directory (doesFileExist)+import System.Directory.Tools (maybeGetModificationTime) import System.IO.Unsafe (unsafeInterleaveIO) import Control.Monad.Reader (asks, ReaderT(runReaderT), lift)-import Control.Monad.Utils (ifM, whenM)-import Control.Applicative ((<$>))-import Control.Applicative.Utils ((<.>))+import Control.Monad.Tools (ifM, whenM)+import Control.Applicative ((<$>), liftA2)+import Control.Applicative.Tools ((<.>))+import Control.Arrow (second) import Data.List (isSuffixOf) import Data.List.Tools (mulLists)-import Data.Tuple.Tools (modifySnd)+-- import Data.Tuple.Tools (modifySnd) import Data.Function.Tools (const2)-import Development.Hake.HiddenTools (isOldThanSomeOf, runHake, hakefileUpdateOption, defaultTrgtStr)+import Development.Hake.HiddenTools (runHake, hakefileUpdateOption, defaultTrgtStr) type Targets = [ String -> Bool ] type Sources = String -> SourcesRet@@ -76,10 +78,8 @@ hake :: [ Rule ] -> IO () hake rl = do args <- getArgs let ud = elem hakefileUpdateOption args- args_ = filter (/=hakefileUpdateOption) args- case args_ of- [ trgt ] -> hakeTarget ud (map ruleToRuleInner rl) trgt- _ -> error "function (hake): argument error"+ trgts = filter (/=hakefileUpdateOption) args+ mapM_ (hakeTarget ud (map ruleToRuleInner rl)) trgts hakeT :: [ Rule ] -> FilePath -> IO () hakeT = hakeTarget True . map ruleToRuleInner@@ -109,13 +109,22 @@ ( abortIfFailure cmds ) ( return ExitSuccess ) +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+ myLookup :: a -> [ ([a -> Bool], b) ] -> [ (b, [ ([a -> Bool], b) ]) ] myLookup _ [] = [] myLookup x (pair@(p, y):rest) | or $ map ($x) p- = (y, rest) : ( modifySnd (pair:) <$> myLookup x rest )+ = (y, rest) : ( second (pair:) <$> myLookup x rest ) | otherwise- = modifySnd (pair:) <$> myLookup x rest+ = second (pair:) <$> myLookup x rest changeSuffix :: String -> String -> String -> String changeSuffix oldSfx newSfx fn
Development/Hake/HiddenTools.hs view
@@ -17,87 +17,46 @@ module Development.Hake.HiddenTools ( runHake-, isOldThanSomeOf , hakefileUpdateOption , defaultTrgtStr ) where -import System.IO (openFile, hClose, IOMode(WriteMode))-import System.Directory (createDirectory, doesDirectoryExist,- doesFileExist, getModificationTime)-import System.Exit (ExitCode(ExitSuccess))-import System.Time (ClockTime)-import System.Process (runProcess, waitForProcess)-import System.FilePath (takeFileName)-import System.IO.Unsafe (unsafeInterleaveIO)-import Control.Monad.Utils (unlessM, ifM)-import Control.Applicative ((<$>), liftA2)-import Control.Exception (bracket)-import Data.List.Tools (defaultElem)-import Data.Function.Tools (applyWhen, apply2way)-import Text.RegexPR (matchRegexPR)+import System.Directory (createDirectory, doesDirectoryExist,+ doesFileExist)+import System.Exit (ExitCode)+import System.FilePath (takeFileName)+import System.Process (runProcess, waitForProcess)+import Control.Monad (when)+import Control.Monad.Tools (unlessM)+import Data.List.Tools (defaultElem)+import Data.Function.Tools (applyWhen, apply2way)+import YJTools.Tribial (ghcMake, updateFile) -hakeDir, defaultTrgtStr, hakefileUpdateOption :: String+hakeDir, defaultTrgtStr, hakefileUpdateOption, srcSuffix :: String+commentPair :: (String, 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+srcSuffix = ".hs"+commentPair = ("{- ", " -}") runHake :: FilePath -> FilePath -> [ FilePath ] -> [ String ] -> IO ExitCode runHake src exe othrs args = do let exePath = hakeDir ++ exe- exeSrc = hakeDir ++ exe ++ ".hs"- cmtOut = ("{- " ++) . ( ++ " -}\n")- cmtIn = (>>= lookup 1) . fmap snd . matchRegexPR "\\{-\\s*(\\S+)\\s*-\\}" . head . lines+ exeSrc = hakeDir ++ exe ++ srcSuffix mapM_ errorExist $ src : othrs unlessM (doesDirectoryExist hakeDir) $ createDirectory hakeDir- othrsUD <- fmap or $ flip mapM othrs- $ apply2way (updateFile cmtIn cmtOut) id $ (hakeDir ++) . takeFileName- hakefileUD <- updateFile cmtIn cmtOut src exeSrc- ghcMake exe hakeDir+ othrsUD <- fmap or+ $ flip mapM othrs+ $ apply2way (updateFile commentPair) id $+ (hakeDir ++) . takeFileName+ hakefileUD <- updateFile commentPair src exeSrc+ when (othrsUD || hakefileUD) $ ghcMake exe hakeDir >> return () let args_ = applyWhen (othrsUD || hakefileUD) (hakefileUpdateOption:) $ defaultElem defaultTrgtStr args- runProcess exePath args_ Nothing Nothing Nothing Nothing Nothing >>= waitForProcess+ runProcess exePath args_ Nothing Nothing Nothing Nothing Nothing+ >>= waitForProcess errorExist :: FilePath -> IO () errorExist fp = unlessM (doesFileExist fp) $ error $ "runHake: " ++ fp ++ " does not exist"--updateFile :: (String -> Maybe String) -> (FilePath -> String) -> FilePath -> FilePath -> IO Bool-updateFile gtSrc hdr src dst- = ifM ( not <$> doesFileExist dst- `orIO`- (/= Just src) . gtSrc <$> (readFile dst >>= ioFlushLst)- `orIO`- isOldThanSomeOf dst [ src ] )- (readFile src >>= writeFile dst . (hdr src ++ ) >> return True)- ( return False)- where- ioFlushLst lst = const lst <$> putStr (take (length lst - length lst) "dummy")- infixr 2 `orIO`- orIO p1 p2 = do { b1 <- p1; b2 <- unsafeInterleaveIO p2; return $ b1 || b2 }--ghcMake :: String -> FilePath -> IO ExitCode-ghcMake exe dir = do- let errFile = exe ++ ".error"- ret <- bracket (openFile errFile WriteMode) hClose $ \errH ->- runProcess "ghc" [ "--make", exe ] (Just dir)- Nothing Nothing Nothing (Just errH) >>= waitForProcess- case ret of- ExitSuccess -> return ()- _ -> readFile errFile >>= putStr- return ret
hake.cabal view
@@ -1,5 +1,5 @@ Name: hake-Version: 0.6+Version: 0.7 License: GPL License-file: LICENSE Author: Yoshikuni Jujo@@ -51,7 +51,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.5.tar.gz+Package-Url: http://code.haskell.org/hake/ Cabal-Version: >= 1.2 Build-type: Simple Tested-With: GHC@@ -69,6 +69,6 @@ Executable hake GHC-Options: -Wall -- CPP-Options: -DDEBUG- Build-Depends: directory, process, yjtools > 0.3, regexpr >= 0.2.9+ Build-Depends: directory, process, yjtools >= 0.5, regexpr >= 0.3 Other-Modules: Development.Hake.HiddenTools Main-Is: Main.hs