ad14ab8 · jsaddle · git.iko.soy

24 , debugWrapper

25) where

26

27−import Control.Monad (when, join, void, forever)

27+import Control.Monad (when, void, forever)

28import Control.Concurrent (killThread, forkIO, threadDelay)

29import Control.Exception (handle, AsyncException, throwIO, fromException, finally)

30

53import Data.Maybe (fromMaybe)

54import qualified Data.Map as M (empty, insert, lookup)

55import Data.IORef

56− (writeIORef, IORef, readIORef, newIORef, atomicModifyIORef')

56+ (readIORef, newIORef, atomicModifyIORef')

57import Data.ByteString.Lazy (ByteString)

58import Control.Concurrent.MVar

59− (tryPutMVar, modifyMVar_, putMVar, takeMVar, readMVar, newMVar,

59+ (tryTakeMVar, MVar, tryPutMVar, modifyMVar_, putMVar, takeMVar,

60− newEmptyMVar, modifyMVar)

60+ readMVar, newMVar, newEmptyMVar, modifyMVar)

61import Network.Wai.Handler.Warp

62 (defaultSettings, setTimeout, setPort, runSettings)

63import Foreign.Store (newStore, readStore, lookupStore)

168 \ xhr.open('POST', '/reload/'+syncKey, true);\n\

169 \ xhr.onreadystatechange = function() {\n\

170 \ 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\

172 \ };\n\

173 \ xhr.send();\n"

174 else "") <>

240 ctxs <- takeMVar contexts

241 mapM_ removeContext ctxs

242 takeMVar reloadDoneMVars >>= mapM_ takeMVar

243+ tryTakeMVar serverDone >>= \case

244+ Nothing -> do

243− killThread thread

245+ killThread thread

244− takeMVar serverDone

246+ takeMVar serverDone

247+ Just _ -> return ()

245 return $ length ctxs

248 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

246 lookupStore shutdown_0 >>= \case

254 lookupStore shutdown_0 >>= \case

247 Nothing -> do

255 Nothing -> do

248− shutdownRef <- newIORef =<< start 0

256+ restartMVar <- newMVar start

257+ void . forkIO $ restarter restartMVar (return 0)

249− void $ newStore shutdownRef

258+ void $ newStore restartMVar

250 Just shutdownStore -> do

259 Just shutdownStore -> do

251− shutdownRef :: IORef (IO Int) <- readStore shutdownStore

260+ restartMVar :: MVar (Int -> IO (IO Int)) <- readStore shutdownStore

252− expectedConnections <- join (readIORef shutdownRef)

261+ void $ tryTakeMVar restartMVar

253− writeIORef shutdownRef =<< start expectedConnections

262+ putMVar restartMVar start

254 where shutdown_0 = 0

263 where shutdown_0 = 0