{-# 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 w :: Window
w@Window{[Cookie]
IO ()
TVar CallBufferMode
TVar (String -> String)
RemotePtr ()
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 ()
wCallBufferMode :: Window -> TVar CallBufferMode
wCallBuffer :: Window -> TVar (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 :: TVar (String -> String)
callEval :: String -> IO Value
runEval :: String -> IO ()
getCookies :: [Cookie]
getServer :: Server
..} CallBufferMode
new = do
    Window -> IO ()
flushCallBuffer Window
w
    STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar CallBufferMode -> CallBufferMode -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar CallBufferMode
wCallBufferMode 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
TVar (String -> String)
RemotePtr ()
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 :: TVar (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 ()
wCallBufferMode :: Window -> TVar CallBufferMode
wCallBuffer :: Window -> TVar (String -> String)
callEval :: Window -> String -> IO Value
runEval :: Window -> String -> IO ()
getCookies :: Window -> [Cookie]
getServer :: Window -> Server
..} = 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 w :: Window
w@Window{[Cookie]
IO ()
TVar CallBufferMode
TVar (String -> String)
RemotePtr ()
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 :: TVar (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 ()
wCallBufferMode :: Window -> TVar CallBufferMode
wCallBuffer :: Window -> TVar (String -> String)
callEval :: Window -> String -> IO Value
runEval :: Window -> String -> IO ()
getCookies :: Window -> [Cookie]
getServer :: Window -> Server
..} = do
    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
$ do
        String -> String
code <- TVar (String -> String) -> STM (String -> String)
forall a. TVar a -> STM a
readTVar TVar (String -> String)
wCallBuffer
        TVar (String -> String) -> (String -> String) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (String -> String)
wCallBuffer String -> String
forall a. a -> a
id
        (String -> String) -> STM (String -> String)
forall (m :: * -> *) a. Monad m => a -> m a
return String -> String
code
    let code :: String
code = String -> String
code' String
""
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> 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

-- 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
TVar (String -> String)
RemotePtr ()
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 :: TVar (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 ()
wCallBufferMode :: Window -> TVar CallBufferMode
wCallBuffer :: Window -> TVar (String -> String)
callEval :: Window -> String -> IO Value
runEval :: Window -> String -> IO ()
getCookies :: Window -> [Cookie]
getServer :: Window -> Server
..} 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 (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 <- TVar (String -> String) -> STM (String -> String)
forall a. TVar a -> STM a
readTVar TVar (String -> String)
wCallBuffer
                TVar (String -> String) -> (String -> String) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (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 (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 (m :: * -> *) a. Monad m => a -> m a
return ()
        Just String
code -> String -> IO ()
runEval String
code