Change logic to use TVar

yesod-bin/Devel.hs

@@ -231,26 +231,24 @@ stackSuccessString = "ExitSuccess"
 stackFailureString :: ByteString
 stackFailureString = "ExitFailure"
 
-data BuildOutput = Started
+-- We need updateAppPort logic to prevent a race condition.
-                   deriving (Show, Eq, Ord)
+-- See https://github.com/yesodweb/yesod/issues/1380
-
+updateAppPort :: ByteString -> TVar Bool -- ^ Bool to indicate if the
-makeEmptyMVar :: MVar a -> IO ()
+                                         -- output from stack has
-makeEmptyMVar mvar = do
+                                         -- started. False indicate
-  isEmpty <- isEmptyMVar mvar
+                                         -- that it hasn't started
-  case isEmpty of
+                                         -- yet.
-    True -> return ()
+              -> TVar Int -> IO ()
-    False -> takeMVar mvar >> return ()
+updateAppPort bs buildStarted appPortVar = do
-
+  hasStarted <- readTVarIO buildStarted
-updateAppPort :: ByteString -> MVar (BuildOutput) -> TVar Int -> IO ()
+  let buildEnd = isInfixOf stackFailureString bs || isInfixOf stackSuccessString bs
-updateAppPort bs mvar appPortVar = do
+  case (hasStarted, buildEnd) of
-  isEmpty <- isEmptyMVar mvar
+    (False, False) -> do
-  let hasEnd = isInfixOf stackFailureString bs || isInfixOf stackSuccessString bs
+      atomically $ do
-  case (isEmpty,hasEnd) of
+        writeTVar appPortVar (-1 :: Int)
-    (True,False) -> do
+        writeTVar buildStarted True
-      putMVar mvar Started
+    (True, False) -> return ()
-      atomically $ writeTVar appPortVar (-1 :: Int)
+    (_, True) -> atomically $ writeTVar buildStarted False
-    (_,False) -> return ()
-    (_,True) -> makeEmptyMVar mvar
 
 -- | Get the set of all flags available in the given cabal file
 getAvailableFlags :: D.GenericPackageDescription -> Set.Set String
@@ -347,7 +345,7 @@ devel opts passThroughArgs = do
                 passThroughArgs
 
         sayV $ show procConfig
-        mvar <- newEmptyMVar
+        buildStarted <- newTVarIO False
         -- 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
@@ -356,7 +354,7 @@ devel opts passThroughArgs = do
         withProcess_ procConfig $ \p -> do
             let helper getter h =
                       getter p
-                   $$ CL.iterM (\(str :: ByteString) -> updateAppPort str mvar appPortVar)
+                   $$ CL.iterM (\(str :: ByteString) -> updateAppPort str buildStarted appPortVar)
                    =$ CB.sinkHandle h
             race_ (helper getStdout stdout) (helper getStderr stderr)