restore original yesod touch behaviour

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"
 

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

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"

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