yesod-bin 1.5.2.2 → 1.5.2.3

raw patch · 3 files changed

+38/−3 lines, 3 files

Files

• ChangeLog.md +4/−0
• Devel.hs +33/−2
• yesod-bin.cabal +1/−1

@@ -1,3 +1,7 @@+## 1.5.2.3++* Fix race condition which leads dev server to stay in compilation mode. [#1380](https://github.com/yesodweb/yesod/issues/1380)+ ## 1.5.2.2  * I guess `--no-nix-pure` implies Nix... sigh [#1359](https://github.com/yesodweb/yesod/issues/1359)

@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP                 #-} {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE TemplateHaskell     #-}@@ -14,6 +15,7 @@ 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@@ -126,6 +128,7 @@ reverseProxy opts appPortVar = do     manager <- newManager $ managerSetProxy noProxy tlsManagerSettings     let refreshHtml = LB.fromChunks [$(embedFile "refreshing.html")]+        sayV = when (verbose opts) . sayString         let onExc _ req             | maybe False (("application/json" `elem`) . parseHttpAccept)                 (lookup "accept" $ requestHeaders req) =@@ -142,6 +145,7 @@     let proxyApp = waiProxyToSettings                 (const $ do                     appPort <- atomically $ readTVar appPortVar+                    sayV $ "revProxy: appPort " ++ (show appPort)                     return $                         ReverseProxy.WPRProxyDest                         $ ProxyDest "127.0.0.1" appPort)@@ -222,6 +226,30 @@             then return x             else loop xs +stackSuccessString :: ByteString+stackSuccessString = "ExitSuccess"++stackFailureString :: ByteString+stackFailureString = "ExitFailure"++-- We need updateAppPort logic to prevent a race condition.+-- See https://github.com/yesodweb/yesod/issues/1380+updateAppPort :: ByteString -> TVar Bool -- ^ Bool to indicate if the+                                         -- output from stack has+                                         -- started. False indicate+                                         -- that it hasn't started+                                         -- yet.+              -> TVar Int -> STM ()+updateAppPort bs buildStarted appPortVar = do+  hasStarted <- readTVar buildStarted+  let buildEnd = isInfixOf stackFailureString bs || isInfixOf stackSuccessString bs+  case (hasStarted, buildEnd) of+    (False, False) -> do+      writeTVar appPortVar (-1 :: Int)+      writeTVar buildStarted True+    (True, False) -> return ()+    (_, True) -> writeTVar buildStarted False+ -- | Get the set of all flags available in the given cabal file getAvailableFlags :: D.GenericPackageDescription -> Set.Set String getAvailableFlags =@@ -283,6 +311,7 @@     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 +345,7 @@                 passThroughArgs          sayV $ show procConfig-+        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@@ -325,12 +354,13 @@         withProcess_ procConfig $ \p -> do             let helper getter h =                       getter p-                   $$ CL.iterM (\_ -> atomically $ writeTVar appPortVar (-1))+                   $$ CL.iterM (\(str :: ByteString) -> atomically (updateAppPort str buildStarted 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.@@ -353,6 +383,7 @@         inner changedVar      -- Each time the library builds successfully, run the application+    runApp :: TVar Int -> TVar Bool -> String -> IO b     runApp appPortVar changedVar develHsPath = do         -- Wait for the first change, indicating that the library         -- has been built

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