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

Devel server indicates when recompilation is occurring

Browse Source 
Pinging @amitaibu
This commit is contained in:
Michael Snoyman 2016-11-28 09:58:48 +02:00
parent b1f1e4e222
commit 3883063ec2
1 changed files with 20 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
yesod-bin/Devel.hs
View File

@ -15,6 +15,9 @@ import qualified Control.Exception.Safe as Ex
import Control.Monad (forever, unless, void, import Control.Monad (forever, unless, void,
when) when)
import qualified Data.ByteString.Lazy as LB import qualified Data.ByteString.Lazy as LB
import Data.Conduit (($$), (=$))
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.List as CL
import Data.Default.Class (def) import Data.Default.Class (def)
import Data.FileEmbed (embedFile) import Data.FileEmbed (embedFile)
import qualified Data.Map as Map import qualified Data.Map as Map
@ -53,6 +56,7 @@ import System.Environment (getEnvironment,
import System.FilePath (takeDirectory, import System.FilePath (takeDirectory,
takeFileName, (</>)) takeFileName, (</>))
import System.FSNotify import System.FSNotify
import System.IO (stdout, stderr)
import System.IO.Error (isDoesNotExistError) import System.IO.Error (isDoesNotExistError)
import System.Process.Typed import System.Process.Typed
@ -267,7 +271,7 @@ devel opts passThroughArgs = do
-- loop starts. -- loop starts.
withChangedVar $ \changedVar -> withRevProxy $ race_ withChangedVar $ \changedVar -> withRevProxy $ race_
-- Start the build loop -- Start the build loop
(runStackBuild packageName (getAvailableFlags gpd)) (runStackBuild appPortVar packageName (getAvailableFlags gpd))
-- Run the app itself, restarting when a build succeeds -- Run the app itself, restarting when a build succeeds
(runApp appPortVar changedVar develHsPath) (runApp appPortVar changedVar develHsPath)
@ -276,10 +280,12 @@ devel opts passThroughArgs = do
sayV = when (verbose opts) . sayString sayV = when (verbose opts) . sayString
-- Leverage "stack build --file-watch" to do the build -- Leverage "stack build --file-watch" to do the build
runStackBuild packageName availableFlags = do runStackBuild appPortVar packageName availableFlags = do
-- We call into this app for the devel-signal command -- We call into this app for the devel-signal command
myPath <- getExecutablePath myPath <- getExecutablePath
let procConfig = setDelegateCtlc True $ proc "stack" $ let procConfig = setStdout createSource
$ setStderr createSource
$ setDelegateCtlc True $ proc "stack" $
[ "build" [ "build"
, "--fast" , "--fast"
, "--file-watch" , "--file-watch"
@ -308,7 +314,17 @@ devel opts passThroughArgs = do
sayV $ show procConfig sayV $ show procConfig
runProcess_ procConfig -- Monitor the stdout and stderr content from the build process. Any
-- time some output comes, we invalidate the currently running app by
-- changing the destination port for reverse proxying to -1. We also
-- make sure that all content to stdout or stderr from the build
-- process is piped to the actual stdout and stderr handles.
withProcess_ procConfig $ \p -> do
let helper getter h = runConduit
$ getter p
$$ CL.iterM (\_ -> atomically $ writeTVar appPortVar (-1))
=$ CB.sinkHandle h
race_ (helper getStdout stdout) (helper getStderr stderr)
-- Run the inner action with a TVar which will be set to True -- Run the inner action with a TVar which will be set to True
-- whenever the signal file is modified. -- whenever the signal file is modified.