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

Check cabal build exit code, don't try to start application if build failed

Browse Source
This commit is contained in:
Luite Stegeman 2012-02-11 04:26:26 +01:00
parent f2d7b0bda0
commit 2d3e10b372
1 changed files with 16 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
yesod/Devel.hs
View File

@ -24,7 +24,7 @@ import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import System.Directory import System.Directory
import System.Exit (exitFailure, exitSuccess) import System.Exit (exitFailure, exitSuccess, ExitCode (..))
import System.FilePath (splitDirectories, dropExtension, takeExtension) import System.FilePath (splitDirectories, dropExtension, takeExtension)
import System.Posix.Types (EpochTime) import System.Posix.Types (EpochTime)
import System.PosixCompat.Files (modificationTime, getFileStatus) import System.PosixCompat.Files (modificationTime, getFileStatus)
@ -87,25 +87,28 @@ mainLoop isCabalDev = do
recompDeps recompDeps
list <- getFileList list <- getFileList
_ <- if isCabalDev exit <- if isCabalDev
then rawSystem "cabal-dev" ["build"] then rawSystem "cabal-dev" ["build"]
else rawSystem "cabal" ["build"] else rawSystem "cabal" ["build"]
removeLock case exit of
let pkg = pkgConfigs isCabalDev ghcVer ExitFailure _ -> putStrLn "Build failure, pausing..."
let start = concat ["runghc ", pkg, " devel.hs"] _ -> do
putStrLn $ "Starting development server: " ++ start removeLock
ph <- runCommand start let pkg = pkgConfigs isCabalDev ghcVer
watchTid <- forkIO . try_ $ do let start = concat ["runghc ", pkg, " devel.hs"]
putStrLn $ "Starting development server: " ++ start
ph <- runCommand start
watchTid <- forkIO . try_ $ do
watchForChanges list watchForChanges list
putStrLn "Stopping development server..." putStrLn "Stopping development server..."
writeLock writeLock
threadDelay 1000000 threadDelay 1000000
putStrLn "Terminating development server..." putStrLn "Terminating development server..."
terminateProcess ph terminateProcess ph
ec <- waitForProcess ph ec <- waitForProcess ph
putStrLn $ "Exit code: " ++ show ec putStrLn $ "Exit code: " ++ show ec
Ex.throwTo watchTid (userError "process finished") Ex.throwTo watchTid (userError "process finished")
watchForChanges list watchForChanges list
try_ :: forall a. IO a -> IO () try_ :: forall a. IO a -> IO ()
@ -157,16 +160,12 @@ checkCabalFile gpd = case D.condLibrary gpd of
putStrLn $ "WARNING: yesod devel may not work correctly with " ++ putStrLn $ "WARNING: yesod devel may not work correctly with " ++
"custom hs-source-dirs" "custom hs-source-dirs"
fl <- getFileList fl <- getFileList
print (allModules dLib)
let unlisted = checkFileList fl dLib let unlisted = checkFileList fl dLib
print fl
when (not . null $ unlisted) $ do when (not . null $ unlisted) $ do
putStrLn "WARNING: the following source files are not listed in exposed-modules or other-modules:" putStrLn "WARNING: the following source files are not listed in exposed-modules or other-modules:"
mapM_ putStrLn unlisted mapM_ putStrLn unlisted
when (D.fromString "Application" `notElem` D.exposedModules dLib) $ do when (D.fromString "Application" `notElem` D.exposedModules dLib) $ do
putStrLn "WARNING: no exposed module Application" putStrLn "WARNING: no exposed module Application"
print (D.exposedModules dLib)
print dLib
failWith :: String -> IO a failWith :: String -> IO a
failWith msg = do failWith msg = do