haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

exit application on enter

Browse Source
This commit is contained in:
Luite Stegeman 2011-09-05 23:04:48 +02:00
parent ddb470b1a7
commit 58a91c7634
1 changed files with 30 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
yesod/Devel.hs
View File

@ -25,7 +25,7 @@ import qualified Data.Text.IO as T
import System.Directory (createDirectoryIfMissing, removeFile, import System.Directory (createDirectoryIfMissing, removeFile,
getDirectoryContents) getDirectoryContents)
import System.Exit (exitFailure) import System.Exit (exitFailure, exitSuccess)
import System.Posix.Types (EpochTime) import System.Posix.Types (EpochTime)
import System.PosixCompat.Files (modificationTime, getFileStatus) import System.PosixCompat.Files (modificationTime, getFileStatus)
import System.Process (runCommand, terminateProcess, import System.Process (runCommand, terminateProcess,
@ -38,24 +38,38 @@ import Build (touch, getDeps, findHaskellFiles)
lockFile :: FilePath lockFile :: FilePath
lockFile = "dist/devel-terminate" lockFile = "dist/devel-terminate"
devel :: Bool -> IO () writeLock :: IO ()
devel isDevel = do writeLock = do
createDirectoryIfMissing True "dist" createDirectoryIfMissing True "dist"
writeFile lockFile "" writeFile lockFile ""
cabal <- D.findPackageDesc "." removeLock :: IO ()
gpd <- D.readPackageDescription D.normal cabal removeLock = try_ (removeFile lockFile)
let pid = (D.package . D.packageDescription) gpd
checkCabalFile gpd devel :: Bool -> IO ()
devel isDevel = do
writeLock
_ <- if isDevel putStrLn "Yesod devel server. Pres ENTER to quit"
then rawSystem "cabal-dev" ["configure", "--cabal-install-arg=-fdevel"] _ <- forkIO $ do
else rawSystem "cabal" ["configure", "-fdevel"] cabal <- D.findPackageDesc "."
gpd <- D.readPackageDescription D.normal cabal
let pid = (D.package . D.packageDescription) gpd
T.writeFile "dist/devel.hs" (develFile pid) checkCabalFile gpd
_ <- if isDevel
then rawSystem "cabal-dev" ["configure", "--cabal-install-arg=-fdevel"]
else rawSystem "cabal" ["configure", "-fdevel"]
T.writeFile "dist/devel.hs" (develFile pid)
mainLoop isDevel
_ <- getLine
writeLock
exitSuccess
mainLoop isDevel
mainLoop :: Bool -> IO () mainLoop :: Bool -> IO ()
@ -69,14 +83,14 @@ mainLoop isDevel = forever $ do
then rawSystem "cabal" ["build"] then rawSystem "cabal" ["build"]
else rawSystem "cabal-dev" ["build"] else rawSystem "cabal-dev" ["build"]
try_ $ removeFile lockFile removeLock
putStrLn "Starting development server..." putStrLn "Starting development server..."
pkg <- pkgConfigs isDevel pkg <- pkgConfigs isDevel
ph <- runCommand $ concat ["runghc ", pkg, " dist/devel.hs"] ph <- runCommand $ concat ["runghc ", pkg, " dist/devel.hs"]
watchTid <- forkIO . try_ $ do watchTid <- forkIO . try_ $ do
watchForChanges list watchForChanges list
putStrLn "Stopping development server..." putStrLn "Stopping development server..."
writeFile lockFile "" writeLock
threadDelay 1000000 threadDelay 1000000
putStrLn "Terminating development server..." putStrLn "Terminating development server..."
terminateProcess ph terminateProcess ph
@ -147,9 +161,7 @@ loop = do
if e then terminateDevel else loop if e then terminateDevel else loop
terminateDevel :: IO () terminateDevel :: IO ()
terminateDevel = do terminateDevel = exitSuccess
putStrLn "Devel application exiting"
exitSuccess
|] |]
checkCabalFile :: D.GenericPackageDescription -> IO () checkCabalFile :: D.GenericPackageDescription -> IO ()