{-# LANGUAGE RecordWildCards #-}
module Foreign.JavaScript.CallBuffer where
import Control.Concurrent
import Control.Concurrent.STM as STM
import Control.Monad
import Foreign.JavaScript.Types
setCallBufferMode :: Window -> CallBufferMode -> IO ()
setCallBufferMode w@Window{..} new = do
flushCallBuffer w
atomically $ writeTVar wCallBufferMode new
getCallBufferMode :: Window -> IO CallBufferMode
getCallBufferMode w@Window{..} = atomically $ readTVar wCallBufferMode
flushCallBuffer :: Window -> IO ()
flushCallBuffer w@Window{..} = do
code' <- atomically $ do
code <- readTVar wCallBuffer
writeTVar wCallBuffer id
return code
let code = code' ""
unless (null code) $
runEval code
bufferRunEval :: Window -> String -> IO ()
bufferRunEval w@Window{..} code = do
action <- atomically $ do
mode <- readTVar wCallBufferMode
case mode of
NoBuffering -> do
return $ Just code
_ -> do
msg <- readTVar wCallBuffer
writeTVar wCallBuffer (msg . (\s -> ";" ++ code ++ s))
return Nothing
case action of
Nothing -> return ()
Just code -> runEval code