@@ -57,6 +57,7 @@ import Data.Monoid ((<>))
5757import qualified Data.Text as T (unpack)
5858import qualified Data.Map as M (lookup, delete, insert, empty, size)
5959import Data.Time.Clock (getCurrentTime,diffUTCTime)
60+import Data.IORef (newIORef, atomicWriteIORef, readIORef)
6061
6162import Language.Javascript.JSaddle.Types
6263 (Command(..), AsyncCommand(..), Result(..), Results(..), JSContextRef(..), JSVal(..),
@@ -141,6 +142,7 @@ runJavaScript sendBatch entryPoint = do
141142 commandChan <- newTChanIO
142143 callbacks <- newTVarIO M.empty
143144 nextRef' <- newTVarIO 0
145+ loggingEnabled <- newIORef False
144146 let ctx = JSContextRef {
145147 startTime = startTime'
146148 , doSendCommand = \cmd -> cmd `deepseq` do
@@ -154,6 +156,7 @@ runJavaScript sendBatch entryPoint = do
154156 , addCallback = \(Object (JSVal val)) cb -> atomically $ modifyTVar' callbacks (M.insert val cb)
155157 , freeCallback = \(Object (JSVal val)) -> atomically $ modifyTVar' callbacks (M.delete val)
156158 , nextRef = nextRef'
159+ , enableLogging = atomicWriteIORef loggingEnabled
157160 }
158161 let processResults = \case
159162 (ProtocolError err) -> error $ "Protocol error : " <> T.unpack err
@@ -166,12 +169,15 @@ runJavaScript sendBatch entryPoint = do
166169 Nothing -> liftIO $ putStrLn "Callback called after it was freed"
167170 Just cb -> void . forkIO $ runReaderT (unJSM $ cb f' this' args) ctx
168171 m -> putMVar recvMVar m
169− logInfo s = do
170− stats <- getGCStatsEnabled
171− when stats $ do
172− current <- currentBytesUsed <$> getGCStats
173− cbCount <- M.size <$> readTVarIO callbacks
174− putStrLn . s $ show (current, cbCount)
172+ logInfo s =
173+ readIORef loggingEnabled >>= \case
174+ True -> do
175+ currentBytesUsedStr <- getGCStatsEnabled >>= \case
176+ True -> show . currentBytesUsed <$> getGCStats
177+ False -> return "??"
178+ cbCount <- M.size <$> readTVarIO callbacks
179+ putStrLn . s $ "M " <> currentBytesUsedStr <> "CB " <> show cbCount
180+ False -> return ()
175181 _ <- forkIO . forever $ readBatch commandChan >>= \case
176182 (batch@(Batch cmds _), resultMVars) -> do
177183 logInfo (\x -> "Sync " <> x <> show (length cmds, last cmds))