Fix race condition in yesod-bin

Stack build process emittles line even after successful build process
which leads to the overwriting of the appPortVar with -1. This leads
it to a compile mode again. Pressing Return Key and rebuilding it
again makes it go, but that's just a workaround I have to do every now
and then to solve the actual issue.

I'm using a `MVar` based locking solution for fixing the race
condition introduced.
This commit is contained in:
Sibi Prabakaran 2017-04-20 18:52:20 +05:30
parent bc3054bfa2
commit 878534a272
No known key found for this signature in database
GPG Key ID: D19E3E0EBB557613
2 changed files with 36 additions and 3 deletions

View File

@ -1,3 +1,4 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
@ -11,9 +12,12 @@ import Control.Applicative ((<|>))
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (race_)
import Control.Concurrent.STM
import Control.Concurrent.MVar
import System.IO
import qualified Control.Exception.Safe as Ex
import Control.Monad (forever, unless, void,
when)
import Data.ByteString (ByteString, isInfixOf)
import qualified Data.ByteString.Lazy as LB
import Data.Conduit (($$), (=$))
import qualified Data.Conduit.Binary as CB
@ -222,6 +226,33 @@ checkDevelFile =
then return x
else loop xs
stackSuccessString :: ByteString
stackSuccessString = "ExitSuccess"
stackFailureString :: ByteString
stackFailureString = "ExitFailure"
data BuildOutput = Started
deriving (Show, Eq, Ord)
makeEmptyMVar :: MVar a -> IO ()
makeEmptyMVar mvar = do
isEmpty <- isEmptyMVar mvar
case isEmpty of
True -> return ()
False -> takeMVar mvar >> return ()
updateAppPort :: ByteString -> MVar (BuildOutput) -> TVar Int -> IO ()
updateAppPort bs mvar appPortVar = do
isEmpty <- isEmptyMVar mvar
let hasEnd = isInfixOf stackFailureString bs || isInfixOf stackSuccessString bs
case (isEmpty,hasEnd) of
(True,False) -> do
putMVar mvar Started
atomically $ writeTVar appPortVar (-1 :: Int)
(_,False) -> return ()
(_,True) -> makeEmptyMVar mvar
-- | Get the set of all flags available in the given cabal file
getAvailableFlags :: D.GenericPackageDescription -> Set.Set String
getAvailableFlags =
@ -283,6 +314,7 @@ devel opts passThroughArgs = do
sayV = when (verbose opts) . sayString
-- Leverage "stack build --file-watch" to do the build
runStackBuild :: TVar Int -> [Char] -> Set.Set [Char] -> IO ()
runStackBuild appPortVar packageName availableFlags = do
-- We call into this app for the devel-signal command
myPath <- getExecutablePath
@ -316,7 +348,7 @@ devel opts passThroughArgs = do
passThroughArgs
sayV $ show procConfig
mvar <- newEmptyMVar
-- 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
@ -325,12 +357,13 @@ devel opts passThroughArgs = do
withProcess_ procConfig $ \p -> do
let helper getter h =
getter p
$$ CL.iterM (\_ -> atomically $ writeTVar appPortVar (-1))
$$ CL.iterM (\(str :: ByteString) -> updateAppPort str mvar appPortVar)
=$ CB.sinkHandle h
race_ (helper getStdout stdout) (helper getStderr stderr)
-- Run the inner action with a TVar which will be set to True
-- whenever the signal file is modified.
withChangedVar :: (TVar Bool -> IO a) -> IO a
withChangedVar inner = withManager $ \manager -> do
-- Variable indicating that the signal file has been changed. We
-- reset it each time we handle the signal.

View File

@ -1,5 +1,5 @@
name: yesod-bin
version: 1.5.2.2
version: 1.7
license: MIT
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>