restore original yesod touch behaviour
This commit is contained in:
parent
064b8da896
commit
d342798b4f
@ -3,6 +3,7 @@ module Build
|
|||||||
( getDeps
|
( getDeps
|
||||||
, touchDeps
|
, touchDeps
|
||||||
, touch
|
, touch
|
||||||
|
, recompDeps
|
||||||
, findHaskellFiles
|
, findHaskellFiles
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@ -24,11 +25,14 @@ import qualified Data.Text.Lazy.IO as TIO
|
|||||||
import qualified System.Posix.Types
|
import qualified System.Posix.Types
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import System.FilePath (replaceExtension, (</>))
|
import System.FilePath (replaceExtension, (</>))
|
||||||
import System.PosixCompat.Files (getFileStatus,
|
import System.PosixCompat.Files (getFileStatus, setFileTimes,
|
||||||
accessTime, modificationTime)
|
accessTime, modificationTime)
|
||||||
|
|
||||||
touch :: IO ()
|
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)
|
type Deps = Map.Map FilePath (Set.Set FilePath)
|
||||||
|
|
||||||
@ -38,24 +42,34 @@ getDeps = do
|
|||||||
deps' <- mapM determineHamletDeps hss
|
deps' <- mapM determineHamletDeps hss
|
||||||
return $ fixDeps $ zip hss deps'
|
return $ fixDeps $ zip hss deps'
|
||||||
|
|
||||||
touchDeps :: Deps -> IO ()
|
touchDeps :: (FilePath -> FilePath) ->
|
||||||
touchDeps deps = (mapM_ go . Map.toList) deps
|
(FilePath -> FilePath -> IO ()) ->
|
||||||
|
Deps -> IO ()
|
||||||
|
touchDeps f action deps = (mapM_ go . Map.toList) deps
|
||||||
where
|
where
|
||||||
go (x, ys) =
|
go (x, ys) =
|
||||||
forM_ (Set.toList ys) $ \y -> do
|
forM_ (Set.toList ys) $ \y -> do
|
||||||
n <- x `isNewerThan` (hiFile y)
|
n <- x `isNewerThan` f y
|
||||||
when n $ do
|
when n $ do
|
||||||
putStrLn ("Forcing recompile for " ++ y ++ " because of " ++ x)
|
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
|
-- | remove the .hi files for a .hs file, thereby forcing a recompile
|
||||||
removeHi :: FilePath -> IO ()
|
removeHi :: FilePath -> FilePath -> IO ()
|
||||||
removeHi hs = mapM_ removeFile' hiFiles
|
removeHi _ hs = mapM_ removeFile' hiFiles
|
||||||
where
|
where
|
||||||
removeFile' file = try' (removeFile file) >> return ()
|
removeFile' file = try' (removeFile file) >> return ()
|
||||||
hiFiles = map (\e -> "dist/build" </> replaceExtension hs e)
|
hiFiles = map (\e -> "dist/build" </> replaceExtension hs e)
|
||||||
["hi", "p_hi"]
|
["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 :: FilePath -> FilePath
|
||||||
hiFile hs = "dist/build" </> replaceExtension hs "hi"
|
hiFile hs = "dist/build" </> replaceExtension hs "hi"
|
||||||
|
|
||||||
|
|||||||
@ -33,7 +33,7 @@ import System.Process (runCommand, terminateProcess,
|
|||||||
|
|
||||||
import Text.Shakespeare.Text (st)
|
import Text.Shakespeare.Text (st)
|
||||||
|
|
||||||
import Build (touch, getDeps, findHaskellFiles)
|
import Build (recompDeps, getDeps,findHaskellFiles)
|
||||||
|
|
||||||
lockFile :: FilePath
|
lockFile :: FilePath
|
||||||
lockFile = "dist/devel-terminate"
|
lockFile = "dist/devel-terminate"
|
||||||
@ -76,7 +76,7 @@ mainLoop :: Bool -> IO ()
|
|||||||
mainLoop isDevel = forever $ do
|
mainLoop isDevel = forever $ do
|
||||||
putStrLn "Rebuilding application..."
|
putStrLn "Rebuilding application..."
|
||||||
|
|
||||||
touch
|
recompDeps
|
||||||
|
|
||||||
list <- getFileList
|
list <- getFileList
|
||||||
_ <- if isDevel
|
_ <- if isDevel
|
||||||
|
|||||||
@ -1,11 +1,22 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
|
||||||
import Scaffolding.Scaffolder
|
import Scaffolding.Scaffolder
|
||||||
import System.Environment (getArgs)
|
import System.Environment (getArgs)
|
||||||
import System.Exit (exitWith)
|
import System.Exit (exitWith)
|
||||||
import System.Process (rawSystem)
|
import System.Process (rawSystem)
|
||||||
|
|
||||||
|
#ifndef WINDOWS
|
||||||
import Build (touch)
|
import Build (touch)
|
||||||
|
#endif
|
||||||
import Devel (devel)
|
import Devel (devel)
|
||||||
|
|
||||||
|
windowsWarning :: String
|
||||||
|
#ifdef WINDOWS
|
||||||
|
windowsWarning = "\n (does not work on Windows)"
|
||||||
|
#else
|
||||||
|
windowsWarning = ""
|
||||||
|
#endif
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
args' <- getArgs
|
args' <- getArgs
|
||||||
@ -17,8 +28,10 @@ main = do
|
|||||||
let build rest = rawSystem cmd $ "build":rest
|
let build rest = rawSystem cmd $ "build":rest
|
||||||
case args of
|
case args of
|
||||||
["init"] -> scaffold
|
["init"] -> scaffold
|
||||||
|
#ifndef WINDOWS
|
||||||
"build":rest -> touch >> build rest >>= exitWith
|
"build":rest -> touch >> build rest >>= exitWith
|
||||||
["touch"] -> touch
|
["touch"] -> touch
|
||||||
|
#endif
|
||||||
["devel"] -> devel isDev
|
["devel"] -> devel isDev
|
||||||
["version"] -> putStrLn "0.9"
|
["version"] -> putStrLn "0.9"
|
||||||
"configure":rest -> rawSystem cmd ("configure":rest) >>= exitWith
|
"configure":rest -> rawSystem cmd ("configure":rest) >>= exitWith
|
||||||
@ -27,8 +40,10 @@ main = do
|
|||||||
putStrLn "Available commands:"
|
putStrLn "Available commands:"
|
||||||
putStrLn " init Scaffold a new site"
|
putStrLn " init Scaffold a new site"
|
||||||
putStrLn " configure Configure a project for building"
|
putStrLn " configure Configure a project for building"
|
||||||
putStrLn " build Build project (performs TH dependency analysis)"
|
putStrLn $ " build Build project (performs TH dependency analysis)"
|
||||||
putStrLn " touch Touch any files with altered TH dependencies but do not build"
|
++ windowsWarning
|
||||||
|
putStrLn $ " touch Touch any files with altered TH dependencies but do not build"
|
||||||
|
++ windowsWarning
|
||||||
putStrLn " devel Run project with the devel server"
|
putStrLn " devel Run project with the devel server"
|
||||||
putStrLn " use --dev devel to build with cabal-dev"
|
putStrLn " use --dev devel to build with cabal-dev"
|
||||||
putStrLn " version Print the version of Yesod"
|
putStrLn " version Print the version of Yesod"
|
||||||
|
|||||||
@ -85,6 +85,8 @@ executable yesod
|
|||||||
cpp-options: -DGHC7
|
cpp-options: -DGHC7
|
||||||
else
|
else
|
||||||
build-depends: base >= 4 && < 4.3
|
build-depends: base >= 4 && < 4.3
|
||||||
|
if os(windows)
|
||||||
|
cpp-options: -DWINDOWS
|
||||||
build-depends: parsec >= 2.1 && < 4
|
build-depends: parsec >= 2.1 && < 4
|
||||||
, text >= 0.11 && < 0.12
|
, text >= 0.11 && < 0.12
|
||||||
, shakespeare-text >= 0.10 && < 0.11
|
, shakespeare-text >= 0.10 && < 0.11
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user