@@ -1,3 +1,4 @@
1+{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE CPP #-}
2{-# LANGUAGE LambdaCase #-}
3{-# LANGUAGE LambdaCase #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE OverloadedStrings #-}
@@ -208,7 +209,7 @@ runJavaScript sendBatch entryPoint = do
208 cbCount <- M.size <$> readTVarIO callbacks
209 cbCount <- M.size <$> readTVarIO callbacks
209 putStrLn . s $ "M " <> currentBytesUsedStr <> "CB " <> show cbCount
210 putStrLn . s $ "M " <> currentBytesUsedStr <> "CB " <> show cbCount
210 False -> return ()
211 False -> return ()
211− _ <- forkIO . forM_ [1..] $ \nBatch ->
212+ _ <- forkIO . numberForeverFromM_ 1 $ \nBatch ->
212 readBatch nBatch commandChan >>= \case
213 readBatch nBatch commandChan >>= \case
213 (batch@(Batch cmds _ _), resultMVars) -> do
214 (batch@(Batch cmds _ _), resultMVars) -> do
214 logInfo (\x -> "Sync " <> x <> show (length cmds, last cmds))
215 logInfo (\x -> "Sync " <> x <> show (length cmds, last cmds))
@@ -226,6 +227,10 @@ runJavaScript sendBatch entryPoint = do
226 zipWithM_ putMVar resultMVars $ results <> repeat (ThrowJSValue exception)
227 zipWithM_ putMVar resultMVars $ results <> repeat (ThrowJSValue exception)
227 return (asyncResults, syncResults, runReaderT (unJSM entryPoint) ctx)
228 return (asyncResults, syncResults, runReaderT (unJSM entryPoint) ctx)
230+ numberForeverFromM_ :: (Monad m, Enum n) => n -> (n -> m a) -> m ()
231+ numberForeverFromM_ !n f = do
233+ numberForeverFromM_ (succ n) f
229 takeResult recvMVar nBatch =
234 takeResult recvMVar nBatch =
230 takeMVar recvMVar >>= \case
235 takeMVar recvMVar >>= \case
231 (n, _) | n < nBatch -> takeResult recvMVar nBatch
236 (n, _) | n < nBatch -> takeResult recvMVar nBatch