From 878534a272e06fb65ea44a86a7558d6f07c9cfcf Mon Sep 17 00:00:00 2001
From: Sibi Prabakaran <sibi@psibi.in>
Date: Thu, 20 Apr 2017 18:52:20 +0530
Subject: [PATCH] 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.
---
 yesod-bin/Devel.hs        | 37 +++++++++++++++++++++++++++++++++++--
 yesod-bin/yesod-bin.cabal |  2 +-
 2 files changed, 36 insertions(+), 3 deletions(-)

diff --git a/yesod-bin/Devel.hs b/yesod-bin/Devel.hs
index 4289317b..b477557c 100644
--- a/yesod-bin/Devel.hs
+++ b/yesod-bin/Devel.hs
@@ -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.
diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal
index 54eb1805..31f42fb6 100644
--- a/yesod-bin/yesod-bin.cabal
+++ b/yesod-bin/yesod-bin.cabal
@@ -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>