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

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 =
    Window -> STM () -> IO ()
forall a. Window -> STM a -> IO a
flushCallBufferWithAtomic Window
w (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar CallBufferMode -> CallBufferMode -> STM ()
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 Window{[Cookie]
IO ()
TVar CallBufferMode
RemotePtr ()
TMVar (String -> String)
Vendor JSPtr
Vendor (Value -> IO ())
Server
String -> IO ()
String -> IO Value
IO () -> IO ()
wCallBufferMode :: Window -> TVar CallBufferMode
getServer :: Server
getCookies :: [Cookie]
runEval :: String -> IO ()
callEval :: String -> IO Value
wCallBuffer :: TMVar (String -> String)
wCallBufferMode :: TVar CallBufferMode
timestamp :: IO ()
debug :: String -> IO ()
onDisconnect :: IO () -> IO ()
wRoot :: RemotePtr ()
wEventHandlers :: Vendor (Value -> IO ())
wJSObjects :: Vendor JSPtr
getServer :: Window -> Server
getCookies :: Window -> [Cookie]
runEval :: Window -> String -> IO ()
callEval :: Window -> String -> IO Value
wCallBuffer :: Window -> TMVar (String -> String)
timestamp :: Window -> IO ()
debug :: Window -> String -> IO ()
onDisconnect :: Window -> IO () -> IO ()
wRoot :: Window -> RemotePtr ()
wEventHandlers :: Window -> Vendor (Value -> IO ())
wJSObjects :: Window -> Vendor JSPtr
..} = STM CallBufferMode -> IO CallBufferMode
forall a. STM a -> IO a
atomically (STM CallBufferMode -> IO CallBufferMode)
-> STM CallBufferMode -> IO CallBufferMode
forall a b. (a -> b) -> a -> b
$ TVar CallBufferMode -> STM CallBufferMode
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 = Window -> STM () -> IO ()
forall a. Window -> STM a -> IO a
flushCallBufferWithAtomic Window
w (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> STM ()
forall a. a -> STM a
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 Window{[Cookie]
IO ()
TVar CallBufferMode
RemotePtr ()
TMVar (String -> String)
Vendor JSPtr
Vendor (Value -> IO ())
Server
String -> IO ()
String -> IO Value
IO () -> IO ()
wCallBufferMode :: Window -> TVar CallBufferMode
getServer :: Window -> Server
getCookies :: Window -> [Cookie]
runEval :: Window -> String -> IO ()
callEval :: Window -> String -> IO Value
wCallBuffer :: Window -> TMVar (String -> String)
timestamp :: Window -> IO ()
debug :: Window -> String -> IO ()
onDisconnect :: Window -> IO () -> IO ()
wRoot :: Window -> RemotePtr ()
wEventHandlers :: Window -> Vendor (Value -> IO ())
wJSObjects :: Window -> Vendor JSPtr
getServer :: Server
getCookies :: [Cookie]
runEval :: String -> IO ()
callEval :: String -> IO Value
wCallBuffer :: TMVar (String -> String)
wCallBufferMode :: TVar CallBufferMode
timestamp :: IO ()
debug :: String -> IO ()
onDisconnect :: IO () -> IO ()
wRoot :: RemotePtr ()
wEventHandlers :: Vendor (Value -> IO ())
wJSObjects :: Vendor JSPtr
..} 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' <- STM (String -> String) -> IO (String -> String)
forall a. STM a -> IO a
atomically (STM (String -> String) -> IO (String -> String))
-> STM (String -> String) -> IO (String -> String)
forall a b. (a -> b) -> a -> b
$ TMVar (String -> String) -> STM (String -> String)
forall a. TMVar a -> STM a
takeTMVar TMVar (String -> String)
wCallBuffer
    let code :: String
code = String -> String
code' String
""
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
code) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
runEval String
code
    STM a -> IO a
forall a. STM a -> IO a
atomically (STM a -> IO a) -> STM a -> IO a
forall a b. (a -> b) -> a -> b
$ do
        TMVar (String -> String) -> (String -> String) -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (String -> String)
wCallBuffer String -> String
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 Window{[Cookie]
IO ()
TVar CallBufferMode
RemotePtr ()
TMVar (String -> String)
Vendor JSPtr
Vendor (Value -> IO ())
Server
String -> IO ()
String -> IO Value
IO () -> IO ()
wCallBufferMode :: Window -> TVar CallBufferMode
getServer :: Window -> Server
getCookies :: Window -> [Cookie]
runEval :: Window -> String -> IO ()
callEval :: Window -> String -> IO Value
wCallBuffer :: Window -> TMVar (String -> String)
timestamp :: Window -> IO ()
debug :: Window -> String -> IO ()
onDisconnect :: Window -> IO () -> IO ()
wRoot :: Window -> RemotePtr ()
wEventHandlers :: Window -> Vendor (Value -> IO ())
wJSObjects :: Window -> Vendor JSPtr
getServer :: Server
getCookies :: [Cookie]
runEval :: String -> IO ()
callEval :: String -> IO Value
wCallBuffer :: TMVar (String -> String)
wCallBufferMode :: TVar CallBufferMode
timestamp :: IO ()
debug :: String -> IO ()
onDisconnect :: IO () -> IO ()
wRoot :: RemotePtr ()
wEventHandlers :: Vendor (Value -> IO ())
wJSObjects :: Vendor JSPtr
..} String
code = do
    Maybe String
action <- STM (Maybe String) -> IO (Maybe String)
forall a. STM a -> IO a
atomically (STM (Maybe String) -> IO (Maybe String))
-> STM (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
        CallBufferMode
mode <- TVar CallBufferMode -> STM CallBufferMode
forall a. TVar a -> STM a
readTVar TVar CallBufferMode
wCallBufferMode
        case CallBufferMode
mode of
            CallBufferMode
NoBuffering -> do
                Maybe String -> STM (Maybe String)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> STM (Maybe String))
-> Maybe String -> STM (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
code
            CallBufferMode
_ -> do
                String -> String
msg <- TMVar (String -> String) -> STM (String -> String)
forall a. TMVar a -> STM a
takeTMVar TMVar (String -> String)
wCallBuffer
                TMVar (String -> String) -> (String -> String) -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (String -> String)
wCallBuffer (String -> String
msg (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\String
s -> String
";" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
code String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s))
                Maybe String -> STM (Maybe String)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
    case Maybe String
action of
        Maybe String
Nothing    -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just String
code1 -> String -> IO ()
runEval String
code1