{-# LANGUAGE RecordWildCards #-}
module Foreign.JavaScript.CallBuffer where

import Control.Concurrent
import Control.Concurrent.STM as STM
import Control.Monad

import Foreign.JavaScript.Types

{-----------------------------------------------------------------------------
    Call Buffer
------------------------------------------------------------------------------}
-- | Set the call buffering mode for the given browser window.
setCallBufferMode :: Window -> CallBufferMode -> IO ()
setCallBufferMode :: Window -> CallBufferMode -> IO ()
setCallBufferMode Window
w CallBufferMode
new =
    forall a. Window -> STM a -> IO a
flushCallBufferWithAtomic Window
w forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> a -> STM ()
writeTVar (Window -> TVar CallBufferMode
wCallBufferMode Window
w) CallBufferMode
new

-- | Get the call buffering mode for the given browser window.
getCallBufferMode :: Window -> IO CallBufferMode
getCallBufferMode :: Window -> IO CallBufferMode
getCallBufferMode w :: Window
w@Window{[Cookie]
IO ()
TVar CallBufferMode
RemotePtr ()
TMVar (String -> String)
Vendor JSPtr
Vendor (Value -> IO ())
Server
String -> IO ()
String -> IO Value
IO () -> IO ()
wJSObjects :: Window -> Vendor JSPtr
wEventHandlers :: Window -> Vendor (Value -> IO ())
wRoot :: Window -> RemotePtr ()
onDisconnect :: Window -> IO () -> IO ()
debug :: Window -> String -> IO ()
timestamp :: Window -> IO ()
wCallBuffer :: Window -> TMVar (String -> String)
callEval :: Window -> String -> IO Value
runEval :: Window -> String -> IO ()
getCookies :: Window -> [Cookie]
getServer :: Window -> Server
wJSObjects :: Vendor JSPtr
wEventHandlers :: Vendor (Value -> IO ())
wRoot :: RemotePtr ()
onDisconnect :: IO () -> IO ()
debug :: String -> IO ()
timestamp :: IO ()
wCallBufferMode :: TVar CallBufferMode
wCallBuffer :: TMVar (String -> String)
callEval :: String -> IO Value
runEval :: String -> IO ()
getCookies :: [Cookie]
getServer :: Server
wCallBufferMode :: Window -> TVar CallBufferMode
..} = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> STM a
readTVar TVar CallBufferMode
wCallBufferMode

-- | Flush the call buffer,
-- i.e. send all outstanding JavaScript to the client in one single message.
flushCallBuffer :: Window -> IO ()
flushCallBuffer :: Window -> IO ()
flushCallBuffer Window
w = forall a. Window -> STM a -> IO a
flushCallBufferWithAtomic Window
w forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Flush the call buffer, and atomically perform an additional action
flushCallBufferWithAtomic :: Window -> STM a -> IO a
flushCallBufferWithAtomic :: forall a. Window -> STM a -> IO a
flushCallBufferWithAtomic w :: Window
w@Window{[Cookie]
IO ()
TVar CallBufferMode
RemotePtr ()
TMVar (String -> String)
Vendor JSPtr
Vendor (Value -> IO ())
Server
String -> IO ()
String -> IO Value
IO () -> IO ()
wJSObjects :: Vendor JSPtr
wEventHandlers :: Vendor (Value -> IO ())
wRoot :: RemotePtr ()
onDisconnect :: IO () -> IO ()
debug :: String -> IO ()
timestamp :: IO ()
wCallBufferMode :: TVar CallBufferMode
wCallBuffer :: TMVar (String -> String)
callEval :: String -> IO Value
runEval :: String -> IO ()
getCookies :: [Cookie]
getServer :: Server
wJSObjects :: Window -> Vendor JSPtr
wEventHandlers :: Window -> Vendor (Value -> IO ())
wRoot :: Window -> RemotePtr ()
onDisconnect :: Window -> IO () -> IO ()
debug :: Window -> String -> IO ()
timestamp :: Window -> IO ()
wCallBuffer :: Window -> TMVar (String -> String)
callEval :: Window -> String -> IO Value
runEval :: Window -> String -> IO ()
getCookies :: Window -> [Cookie]
getServer :: Window -> Server
wCallBufferMode :: Window -> TVar CallBufferMode
..} STM a
action = do
    -- by taking the call buffer, we ensure that no further code
    -- is added to the buffer while we execute the current buffer's code.
    String -> String
code' <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> STM a
takeTMVar TMVar (String -> String)
wCallBuffer
    let code :: String
code = String -> String
code' String
""
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
code) forall a b. (a -> b) -> a -> b
$ String -> IO ()
runEval String
code
    forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
        forall a. TMVar a -> a -> STM ()
putTMVar TMVar (String -> String)
wCallBuffer forall a. a -> a
id
        STM a
action

-- | Schedule a piece of JavaScript code to be run with `runEval`,
-- depending on the buffering mode
bufferRunEval :: Window -> String -> IO ()
bufferRunEval :: Window -> String -> IO ()
bufferRunEval w :: Window
w@Window{[Cookie]
IO ()
TVar CallBufferMode
RemotePtr ()
TMVar (String -> String)
Vendor JSPtr
Vendor (Value -> IO ())
Server
String -> IO ()
String -> IO Value
IO () -> IO ()
wJSObjects :: Vendor JSPtr
wEventHandlers :: Vendor (Value -> IO ())
wRoot :: RemotePtr ()
onDisconnect :: IO () -> IO ()
debug :: String -> IO ()
timestamp :: IO ()
wCallBufferMode :: TVar CallBufferMode
wCallBuffer :: TMVar (String -> String)
callEval :: String -> IO Value
runEval :: String -> IO ()
getCookies :: [Cookie]
getServer :: Server
wJSObjects :: Window -> Vendor JSPtr
wEventHandlers :: Window -> Vendor (Value -> IO ())
wRoot :: Window -> RemotePtr ()
onDisconnect :: Window -> IO () -> IO ()
debug :: Window -> String -> IO ()
timestamp :: Window -> IO ()
wCallBuffer :: Window -> TMVar (String -> String)
callEval :: Window -> String -> IO Value
runEval :: Window -> String -> IO ()
getCookies :: Window -> [Cookie]
getServer :: Window -> Server
wCallBufferMode :: Window -> TVar CallBufferMode
..} String
code = do
    Maybe String
action <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
        CallBufferMode
mode <- forall a. TVar a -> STM a
readTVar TVar CallBufferMode
wCallBufferMode
        case CallBufferMode
mode of
            CallBufferMode
NoBuffering -> do
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
code
            CallBufferMode
_ -> do
                String -> String
msg <- forall a. TMVar a -> STM a
takeTMVar TMVar (String -> String)
wCallBuffer
                forall a. TMVar a -> a -> STM ()
putTMVar TMVar (String -> String)
wCallBuffer (String -> String
msg forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\String
s -> String
";" forall a. [a] -> [a] -> [a]
++ String
code forall a. [a] -> [a] -> [a]
++ String
s))
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    case Maybe String
action of
        Maybe String
Nothing   -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just String
code -> String -> IO ()
runEval String
code