@@ -24,7 +24,7 @@ module Language.Javascript.JSaddle.WebSockets (
2424 , debugWrapper
2525) where
2626
27−import Control.Monad (when, join, void, forever)
27+import Control.Monad (when, void, forever)
2828import Control.Concurrent (killThread, forkIO, threadDelay)
2929import Control.Exception (handle, AsyncException, throwIO, fromException, finally)
3030
@@ -53,11 +53,11 @@ import Language.Javascript.JSaddle.Debug
5353import Data.Maybe (fromMaybe)
5454import qualified Data.Map as M (empty, insert, lookup)
5555import Data.IORef
56− (writeIORef, IORef, readIORef, newIORef, atomicModifyIORef')
56+ (readIORef, newIORef, atomicModifyIORef')
5757import Data.ByteString.Lazy (ByteString)
5858import Control.Concurrent.MVar
59− (tryPutMVar, modifyMVar_, putMVar, takeMVar, readMVar, newMVar,
60− newEmptyMVar, modifyMVar)
59+ (tryTakeMVar, MVar, tryPutMVar, modifyMVar_, putMVar, takeMVar,
60+ readMVar, newMVar, newEmptyMVar, modifyMVar)
6161import Network.Wai.Handler.Warp
6262 (defaultSettings, setTimeout, setPort, runSettings)
6363import Foreign.Store (newStore, readStore, lookupStore)
@@ -168,7 +168,7 @@ jsaddleJs refreshOnLoad = "\
168168 \ xhr.open('POST', '/reload/'+syncKey, true);\n\
169169 \ xhr.onreadystatechange = function() {\n\
170170 \ if(xhr.readyState === XMLHttpRequest.DONE && xhr.status === 200)\n\
171− \ setTimeout(function(){window.location.reload();}, 500);\n\
171+ \ setTimeout(function(){window.location.reload();}, 100);\n\
172172 \ };\n\
173173 \ xhr.send();\n"
174174 else "") <>
@@ -240,15 +240,24 @@ debugWrapper run = do
240240 ctxs <- takeMVar contexts
241241 mapM_ removeContext ctxs
242242 takeMVar reloadDoneMVars >>= mapM_ takeMVar
243− killThread thread
244− takeMVar serverDone
243+ tryTakeMVar serverDone >>= \case
244+ Nothing -> do
245+ killThread thread
246+ takeMVar serverDone
247+ Just _ -> return ()
245248 return $ length ctxs
249+ restarter :: MVar (Int -> IO (IO Int)) -> IO Int -> IO ()
250+ restarter mvar stop = do
251+ start' <- takeMVar mvar
252+ n <- stop
253+ start' n >>= restarter mvar
246254 lookupStore shutdown_0 >>= \case
247255 Nothing -> do
248− shutdownRef <- newIORef =<< start 0
249− void $ newStore shutdownRef
256+ restartMVar <- newMVar start
257+ void . forkIO $ restarter restartMVar (return 0)
258+ void $ newStore restartMVar
250259 Just shutdownStore -> do
251− shutdownRef :: IORef (IO Int) <- readStore shutdownStore
252− expectedConnections <- join (readIORef shutdownRef)
253− writeIORef shutdownRef =<< start expectedConnections
260+ restartMVar :: MVar (Int -> IO (IO Int)) <- readStore shutdownStore
261+ void $ tryTakeMVar restartMVar
262+ putMVar restartMVar start
254263 where shutdown_0 = 0