From 7a1629eaba93f304b7bdb22311b2e8ace3a7cb07 Mon Sep 17 00:00:00 2001 From: Luite Stegeman Date: Fri, 2 Sep 2011 09:41:37 +0200 Subject: [PATCH] change recompile method, revert scaffold changes --- yesod/Build.hs | 85 ++++++++++++--------------------- yesod/Devel.hs | 49 ++++--------------- yesod/scaffold/project.cabal.cg | 3 +- 3 files changed, 40 insertions(+), 97 deletions(-) diff --git a/yesod/Build.hs b/yesod/Build.hs index cce4888c..a984ee0d 100644 --- a/yesod/Build.hs +++ b/yesod/Build.hs @@ -1,8 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Build - ( copySources - , getDeps - , copyDeps + ( getDeps + , touchDeps , 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 System.Directory -import Data.List (isSuffixOf) +import Control.Applicative ((<|>)) +import Control.Exception (SomeException, try) +import Control.Monad (when, filterM, forM, forM_) + import qualified Data.Attoparsec.Text.Lazy as A -import qualified Data.Text.Lazy.IO as TIO -import Control.Applicative ((<|>)) -import Control.Exception (SomeException, try) -import Control.Monad (when, filterM, forM, forM_) -import Data.Char (isSpace) -import Data.Monoid (mappend) +import Data.Char (isSpace) +import Data.Monoid (mappend) +import Data.List (isSuffixOf) 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 - 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) +touch = touchDeps =<< getDeps 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 () -copyDeps deps = (mapM_ go . Map.toList) deps >> copySources' +touchDeps :: Deps -> IO () +touchDeps deps = (mapM_ go . Map.toList) deps where go (x, ys) = forM_ (Set.toList ys) $ \y -> do - n <- x `isNewerThan` (develSrcDir y) - when n $ do - putStrLn ("Copying " ++ y ++ " because of " ++ x) - copyToDev y + n <- x `isNewerThan` (hiFile y) + when n $ do + putStrLn ("Forcing recompile for " ++ y ++ " because of " ++ x) + removeHi y -copyToDev :: FilePath -> IO () -copyToDev file = do - createDirectoryIfMissing True targetDir - copyFile file (targetDir takeFileName file) - where - dir = takeDirectory file - targetDir = develSrcDir dir +-- | remove the .hi files for a .hs file, thereby forcing a recompile +removeHi :: 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"] -cleanDev :: IO () -cleanDev = do - try' $ removeDirectoryRecursive develSrcDir - return () +hiFile :: FilePath -> FilePath +hiFile hs = "dist/build" replaceExtension hs "hi" try' :: IO x -> IO (Either SomeException x) try' = try diff --git a/yesod/Devel.hs b/yesod/Devel.hs index 3efa0144..9d57f9f1 100644 --- a/yesod/Devel.hs +++ b/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 - copyDeps deps + touch 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 () - _ -> - T.putStrLn upgradeMessage >> exitFailure + [] -> return () + ["."] -> return () + _ -> + 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 -|] diff --git a/yesod/scaffold/project.cabal.cg b/yesod/scaffold/project.cabal.cg index d88be4d4..3109b5ed 100644 --- a/yesod/scaffold/project.cabal.cg +++ b/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