change recompile method, revert scaffold changes

yesod/Build.hs

@@ -1,8 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Build
-    ( copySources
+    ( getDeps
-    , getDeps
+    , touchDeps
-    , copyDeps
     , touch
     , findHaskellFiles
     ) where
@@ -10,79 +9,55 @@ module Build
 -- FIXME there's a bug when getFileStatus applies to a file
 -- temporary deleted (e.g., Vim saving a file)
 
-import System.FilePath (takeFileName, takeDirectory, (</>))
+import           Control.Applicative ((<|>))
-import System.Directory
+import           Control.Exception (SomeException, try)
-import Data.List (isSuffixOf)
+import           Control.Monad (when, filterM, forM, forM_)
+
 import qualified Data.Attoparsec.Text.Lazy as A
-import qualified Data.Text.Lazy.IO as TIO
+import           Data.Char (isSpace)
-import Control.Applicative ((<|>))
+import           Data.Monoid (mappend)
-import Control.Exception (SomeException, try)
+import           Data.List (isSuffixOf)
-import Control.Monad (when, filterM, forM, forM_)
-import Data.Char (isSpace)
-import Data.Monoid (mappend)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
+import qualified Data.Text.Lazy.IO as TIO
+
 import qualified System.Posix.Types
-import System.PosixCompat.Files (setFileTimes, getFileStatus,
+import           System.Directory
+import           System.FilePath (replaceExtension, (</>))
+import           System.PosixCompat.Files (setFileTimes, getFileStatus,
                                              accessTime, modificationTime)
 
-
 touch :: IO ()
-touch = mapM_ go . Map.toList =<< getDeps
+touch = touchDeps =<< getDeps
-    where
-      go (x, ys) = do
-        (_, mod1) <- getFileStatus' x
-        forM_ (Set.toList ys) $ \y -> do
-            (access, mod2) <- getFileStatus' y
-            when (mod2 < mod1) $ do
-              putStrLn ("Touching " ++ y ++ " because of " ++ x)
-              setFileTimes y access mod1
-
-
--- | Copy all .hs files to the devel src dir
-copySources :: IO ()
-copySources = cleanDev >> copySources'
-
-copySources' :: IO ()
-copySources' = do
-    hss <- findHaskellFiles "."
-    forM_ hss $ \hs -> do
-        n <- hs `isNewerThan` (develSrcDir </> hs)
-        when n (copyToDev hs)
 
 type Deps = Map.Map FilePath (Set.Set FilePath)
 
-develSrcDir :: FilePath
-develSrcDir = "dist/src-devel"
-
 getDeps :: IO Deps
 getDeps = do
     hss <- findHaskellFiles "."
     deps' <- mapM determineHamletDeps hss
     return $ fixDeps $ zip hss deps'
 
-copyDeps :: Deps -> IO ()
+touchDeps :: Deps -> IO ()
-copyDeps deps = (mapM_ go . Map.toList) deps >> copySources'
+touchDeps deps = (mapM_ go . Map.toList) deps
   where
     go (x, ys) =
         forM_ (Set.toList ys) $ \y -> do
-                  n <- x `isNewerThan` (develSrcDir </> y)
+            n <- x `isNewerThan` (hiFile y)
-                  when n $ do
+            when n $ do
-                    putStrLn ("Copying " ++ y ++ " because of " ++ x)
+              putStrLn ("Forcing recompile for " ++ y ++ " because of " ++ x)
-                    copyToDev y
+              removeHi y
 
-copyToDev :: FilePath -> IO ()
+-- | remove the .hi files for a .hs file, thereby forcing a recompile
-copyToDev file = do
+removeHi :: FilePath -> IO ()
-  createDirectoryIfMissing True targetDir
+removeHi hs = mapM_ removeFile' hiFiles
-  copyFile file (targetDir </> takeFileName file)
+    where
-  where
+      removeFile' file = try' (removeFile file) >> return ()
-   dir = takeDirectory file
+      hiFiles          = map (\e -> "dist/build" </> replaceExtension hs e)
-   targetDir = develSrcDir </> dir
+                             ["hi", "p_hi"]
 
-cleanDev :: IO ()
+hiFile :: FilePath -> FilePath
-cleanDev = do
+hiFile hs = "dist/build" </> replaceExtension hs "hi"
-  try' $ removeDirectoryRecursive develSrcDir
-  return ()
 
 try' :: IO x -> IO (Either SomeException x)
 try' = try

yesod/Devel.hs

@@ -27,12 +27,12 @@ import           System.Directory (doesFileExist, removeFile,
 import           System.Exit (exitFailure)
 import           System.Posix.Types (EpochTime)
 import           System.PosixCompat.Files (modificationTime, getFileStatus)
-import           System.Process (runCommand, terminateProcess, 
+import           System.Process (runCommand, terminateProcess,
                                            waitForProcess, rawSystem)
 
 import Text.Shakespeare.Text (st)
 
-import Build (getDeps, copySources, copyDeps, findHaskellFiles)
+import Build (touch, getDeps, findHaskellFiles)
 
 devel :: Bool -> IO ()
 devel isDevel = do
@@ -45,7 +45,6 @@ devel isDevel = do
 
     checkCabalFile gpd
 
-    copySources
     _ <- if isDevel
       then rawSystem "cabal-dev" ["configure", "--cabal-install-arg=-fdevel"]
       else rawSystem "cabal"     ["configure", "-fdevel"]
@@ -59,8 +58,7 @@ mainLoop :: Bool -> IO ()
 mainLoop isDevel = forever $ do
    putStrLn "Rebuilding app"
 
-   deps <- getDeps
+   touch
-   copyDeps deps
 
    list <- getFileList
    _ <- if isDevel
@@ -105,7 +103,7 @@ getFileList = do
         fs <- getFileStatus f
         return (f, modificationTime fs)
 
-watchForChanges :: FileList -> IO () --  ThreadId -> IO ()
+watchForChanges :: FileList -> IO ()
 watchForChanges list = do
     newList <- getFileList
     if list /= newList
@@ -147,10 +145,6 @@ terminateDevel = do
   exitSuccess
 |]
 
-{-
-  check whether cabal file from old scaffold needs to be updated
-  should be removed after 1.0 release?
--}
 checkCabalFile :: D.GenericPackageDescription -> IO ()
 checkCabalFile gpd = case D.condLibrary gpd of
     Nothing -> do
@@ -163,9 +157,11 @@ checkCabalFile gpd = case D.condLibrary gpd of
           exitFailure
         Just dLib ->
          case (D.hsSourceDirs . D.libBuildInfo) dLib of
-           ["dist/src-devel"]  -> return ()
+           []     -> return ()
-           _                   ->
+           ["."]  -> return ()
-             T.putStrLn upgradeMessage >> exitFailure
+           _      ->
+             putStrLn $ "WARNING: yesod devel may not work correctly with " ++
+                        "custom hs-source-dirs"
 
 lookupDevelLib :: D.CondTree D.ConfVar c a -> Maybe a
 lookupDevelLib ct = listToMaybe . map (\(_,x,_) -> D.condTreeData x) .
@@ -174,31 +170,4 @@ lookupDevelLib ct = listToMaybe . map (\(_,x,_) -> D.condTreeData x) .
     isDevelLib ((D.Var (D.Flag (D.FlagName "devel"))), _, _) = True
     isDevelLib _                                             = False
 
-upgradeMessage :: T.Text
-upgradeMessage = [st|
-Your cabal file needs to be updated for this version of yesod devel.
-Find the lines:
-library
-    if flag(devel)
-        Buildable: True
-    else
-        Buildable: False
-
-    if os(windows)
-        cpp-options: -DWINDOWS
-
-    hs-source-dirs: .
-
-And replace them with:
-library
-    if flag(devel)
-        Buildable: True
-        hs-source-dirs: dist/src-devel
-    else
-        Buildable: False
-        hs-source-dirs: .
-
-    if os(windows)
-        cpp-options: -DWINDOWS
-|]
 

yesod/scaffold/project.cabal.cg

@@ -23,14 +23,13 @@ Flag devel
 library
     if flag(devel)
         Buildable: True
-        hs-source-dirs: dist/src-devel
     else
         Buildable: False
-        hs-source-dirs: .
 
     if os(windows)
         cpp-options: -DWINDOWS
 
+    hs-source-dirs: .
     exposed-modules: Application
     other-modules:   Foundation
                      Model