From d342798b4fcd0ff8f58d5f2a174ec76cb8e8f8cb Mon Sep 17 00:00:00 2001 From: Luite Stegeman Date: Sat, 10 Sep 2011 01:04:58 +0200 Subject: [PATCH] restore original yesod touch behaviour --- yesod/Build.hs | 30 ++++++++++++++++++++++-------- yesod/Devel.hs | 10 +++++----- yesod/main.hs | 19 +++++++++++++++++-- yesod/yesod.cabal | 2 ++ 4 files changed, 46 insertions(+), 15 deletions(-) diff --git a/yesod/Build.hs b/yesod/Build.hs index 309251b1..f0b68ad4 100644 --- a/yesod/Build.hs +++ b/yesod/Build.hs @@ -3,6 +3,7 @@ module Build ( getDeps , touchDeps , touch + , recompDeps , findHaskellFiles ) where @@ -24,11 +25,14 @@ import qualified Data.Text.Lazy.IO as TIO import qualified System.Posix.Types import System.Directory import System.FilePath (replaceExtension, ()) -import System.PosixCompat.Files (getFileStatus, +import System.PosixCompat.Files (getFileStatus, setFileTimes, accessTime, modificationTime) touch :: IO () -touch = touchDeps =<< getDeps +touch = touchDeps id updateFileTime =<< getDeps + +recompDeps :: IO () +recompDeps = touchDeps hiFile removeHi =<< getDeps type Deps = Map.Map FilePath (Set.Set FilePath) @@ -38,24 +42,34 @@ getDeps = do deps' <- mapM determineHamletDeps hss return $ fixDeps $ zip hss deps' -touchDeps :: Deps -> IO () -touchDeps deps = (mapM_ go . Map.toList) deps +touchDeps :: (FilePath -> FilePath) -> + (FilePath -> FilePath -> IO ()) -> + Deps -> IO () +touchDeps f action deps = (mapM_ go . Map.toList) deps where go (x, ys) = forM_ (Set.toList ys) $ \y -> do - n <- x `isNewerThan` (hiFile y) + n <- x `isNewerThan` f y when n $ do putStrLn ("Forcing recompile for " ++ y ++ " because of " ++ x) - removeHi y + action x y -- | remove the .hi files for a .hs file, thereby forcing a recompile -removeHi :: FilePath -> IO () -removeHi hs = mapM_ removeFile' hiFiles +removeHi :: FilePath -> FilePath -> IO () +removeHi _ hs = mapM_ removeFile' hiFiles where removeFile' file = try' (removeFile file) >> return () hiFiles = map (\e -> "dist/build" replaceExtension hs e) ["hi", "p_hi"] +-- | change file mtime of .hs file to that of the dependency +updateFileTime :: FilePath -> FilePath -> IO () +updateFileTime x hs = do + (_ , modx) <- getFileStatus' x + (access, _ ) <- getFileStatus' hs + _ <- try' (setFileTimes hs access modx) + return () + hiFile :: FilePath -> FilePath hiFile hs = "dist/build" replaceExtension hs "hi" diff --git a/yesod/Devel.hs b/yesod/Devel.hs index 7fe65052..88e214bd 100755 --- a/yesod/Devel.hs +++ b/yesod/Devel.hs @@ -33,14 +33,14 @@ import System.Process (runCommand, terminateProcess, import Text.Shakespeare.Text (st) -import Build (touch, getDeps, findHaskellFiles) +import Build (recompDeps, getDeps,findHaskellFiles) lockFile :: FilePath lockFile = "dist/devel-terminate" writeLock :: IO () writeLock = do - createDirectoryIfMissing True "dist" + createDirectoryIfMissing True "dist" writeFile lockFile "" removeLock :: IO () @@ -49,7 +49,7 @@ removeLock = try_ (removeFile lockFile) devel :: Bool -> IO () devel isDevel = do writeLock - + putStrLn "Yesod devel server. Press ENTER to quit" _ <- forkIO $ do cabal <- D.findPackageDesc "." @@ -65,7 +65,7 @@ devel isDevel = do T.writeFile "dist/devel.hs" (develFile pid) mainLoop isDevel - + _ <- getLine writeLock exitSuccess @@ -76,7 +76,7 @@ mainLoop :: Bool -> IO () mainLoop isDevel = forever $ do putStrLn "Rebuilding application..." - touch + recompDeps list <- getFileList _ <- if isDevel diff --git a/yesod/main.hs b/yesod/main.hs index c2c17275..c461c66a 100755 --- a/yesod/main.hs +++ b/yesod/main.hs @@ -1,11 +1,22 @@ +{-# LANGUAGE CPP #-} + import Scaffolding.Scaffolder import System.Environment (getArgs) import System.Exit (exitWith) import System.Process (rawSystem) +#ifndef WINDOWS import Build (touch) +#endif import Devel (devel) +windowsWarning :: String +#ifdef WINDOWS +windowsWarning = "\n (does not work on Windows)" +#else +windowsWarning = "" +#endif + main :: IO () main = do args' <- getArgs @@ -17,8 +28,10 @@ main = do let build rest = rawSystem cmd $ "build":rest case args of ["init"] -> scaffold +#ifndef WINDOWS "build":rest -> touch >> build rest >>= exitWith ["touch"] -> touch +#endif ["devel"] -> devel isDev ["version"] -> putStrLn "0.9" "configure":rest -> rawSystem cmd ("configure":rest) >>= exitWith @@ -27,8 +40,10 @@ main = do putStrLn "Available commands:" putStrLn " init Scaffold a new site" putStrLn " configure Configure a project for building" - putStrLn " build Build project (performs TH dependency analysis)" - putStrLn " touch Touch any files with altered TH dependencies but do not build" + putStrLn $ " build Build project (performs TH dependency analysis)" + ++ windowsWarning + putStrLn $ " touch Touch any files with altered TH dependencies but do not build" + ++ windowsWarning putStrLn " devel Run project with the devel server" putStrLn " use --dev devel to build with cabal-dev" putStrLn " version Print the version of Yesod" diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal index cad486f3..be171174 100644 --- a/yesod/yesod.cabal +++ b/yesod/yesod.cabal @@ -85,6 +85,8 @@ executable yesod cpp-options: -DGHC7 else build-depends: base >= 4 && < 4.3 + if os(windows) + cpp-options: -DWINDOWS build-depends: parsec >= 2.1 && < 4 , text >= 0.11 && < 0.12 , shakespeare-text >= 0.10 && < 0.11