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

Make updateAppPort as a single STM transaction

Browse Source
This commit is contained in:
Sibi Prabakaran 2017-04-27 17:08:12 +05:30
parent 35e0095590
commit 67eb728703
No known key found for this signature in database
GPG Key ID: D19E3E0EBB557613
1 changed files with 9 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
yesod-bin/Devel.hs
View File

@ -128,6 +128,7 @@ reverseProxy :: DevelOpts -> TVar Int -> IO ()
reverseProxy opts appPortVar = do reverseProxy opts appPortVar = do
manager <- newManager $ managerSetProxy noProxy tlsManagerSettings manager <- newManager $ managerSetProxy noProxy tlsManagerSettings
let refreshHtml = LB.fromChunks [$(embedFile "refreshing.html")] let refreshHtml = LB.fromChunks [$(embedFile "refreshing.html")]
sayV = when (verbose opts) . sayString
let onExc _ req let onExc _ req
| maybe False (("application/json" `elem`) . parseHttpAccept) | maybe False (("application/json" `elem`) . parseHttpAccept)
(lookup "accept" $ requestHeaders req) = (lookup "accept" $ requestHeaders req) =
@ -144,9 +145,7 @@ reverseProxy opts appPortVar = do
let proxyApp = waiProxyToSettings let proxyApp = waiProxyToSettings
(const $ do (const $ do
appPort <- atomically $ readTVar appPortVar appPort <- atomically $ readTVar appPortVar
#if DEBUG sayV $ "revProxy: appPort " ++ (show appPort)
print $ "revProxy: appPort " ++ (show appPort)
#endif
return $ return $
ReverseProxy.WPRProxyDest ReverseProxy.WPRProxyDest
$ ProxyDest "127.0.0.1" appPort) $ ProxyDest "127.0.0.1" appPort)
@ -240,28 +239,16 @@ updateAppPort :: ByteString -> TVar Bool -- ^ Bool to indicate if the
-- started. False indicate -- started. False indicate
-- that it hasn't started -- that it hasn't started
-- yet. -- yet.
-> TVar Int -> IO () -> TVar Int -> STM ()
updateAppPort bs buildStarted appPortVar = do updateAppPort bs buildStarted appPortVar = do
hasStarted <- readTVarIO buildStarted hasStarted <- readTVar buildStarted
let buildEnd = isInfixOf stackFailureString bs || isInfixOf stackSuccessString bs let buildEnd = isInfixOf stackFailureString bs || isInfixOf stackSuccessString bs
case (hasStarted, buildEnd) of case (hasStarted, buildEnd) of
(False, False) -> do (False, False) -> do
#if DEBUG writeTVar appPortVar (-1 :: Int)
print "updated appPortVar to -1" writeTVar buildStarted True
#endif (True, False) -> return ()
atomically $ do (_, True) -> writeTVar buildStarted False
writeTVar appPortVar (-1 :: Int)
writeTVar buildStarted True
(True, False) -> do
#if DEBUG
print "ignored"
#endif
return ()
(_, True) -> do
#if DEBUG
print "Reset buildStarted to False"
#endif
atomically $ writeTVar buildStarted False
-- | Get the set of all flags available in the given cabal file -- | Get the set of all flags available in the given cabal file
getAvailableFlags :: D.GenericPackageDescription -> Set.Set String getAvailableFlags :: D.GenericPackageDescription -> Set.Set String
@ -367,7 +354,7 @@ devel opts passThroughArgs = do
withProcess_ procConfig $ \p -> do withProcess_ procConfig $ \p -> do
let helper getter h = let helper getter h =
getter p getter p
$$ CL.iterM (\(str :: ByteString) -> updateAppPort str buildStarted appPortVar) $$ CL.iterM (\(str :: ByteString) -> atomically (updateAppPort str buildStarted appPortVar))
=$ CB.sinkHandle h =$ CB.sinkHandle h
race_ (helper getStdout stdout) (helper getStderr stderr) race_ (helper getStdout stdout) (helper getStderr stderr)