{-# LANGUAGE RecordWildCards #-}
module Foreign.JavaScript (
serve, defaultConfig, Config(
jsPort, jsAddr
, jsCustomHTML, jsStatic, jsLog
, jsWindowReloadOnDisconnect, jsCallBufferMode),
Server, MimeType, URI, loadFile, loadDirectory,
Window, getServer, getCookies, root,
ToJS(..), FromJS, JSFunction, JSObject, JavaScriptException,
FFI, ffi, runFunction, callFunction,
NewJSObject, unsafeCreateJSObject,
CallBufferMode(..), setCallBufferMode, getCallBufferMode, flushCallBuffer,
IsHandler, exportHandler, onDisconnect,
debug, timestamp,
) where
import Control.Concurrent.STM as STM
import Control.Monad (unless)
import qualified Data.Aeson as JSON
import Foreign.JavaScript.CallBuffer
import Foreign.JavaScript.EventLoop
import Foreign.JavaScript.Marshal
import Foreign.JavaScript.Server
import Foreign.JavaScript.Types
import Foreign.RemotePtr as Foreign
serve
:: Config
-> (Window -> IO ())
-> IO ()
serve :: Config -> (Window -> IO ()) -> IO ()
serve Config
config Window -> IO ()
init = Config -> EventLoop -> IO ()
httpComm Config
config (EventLoop -> IO ()) -> EventLoop -> IO ()
forall a b. (a -> b) -> a -> b
$ (Window -> IO ()) -> EventLoop
forall void. (Window -> IO void) -> EventLoop
eventLoop ((Window -> IO ()) -> EventLoop) -> (Window -> IO ()) -> EventLoop
forall a b. (a -> b) -> a -> b
$ \Window
w -> do
Window -> CallBufferMode -> IO ()
setCallBufferMode Window
w (Config -> CallBufferMode
jsCallBufferMode Config
config)
Window -> JSFunction () -> IO ()
runFunction Window
w (JSFunction () -> IO ()) -> JSFunction () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> Bool -> JSFunction ()
forall a. FFI a => String -> a
ffi String
"connection.setReloadOnDisconnect(%1)" (Bool -> JSFunction ()) -> Bool -> JSFunction ()
forall a b. (a -> b) -> a -> b
$ Config -> Bool
jsWindowReloadOnDisconnect Config
config
Window -> IO ()
flushCallBuffer Window
w
Window -> IO ()
init Window
w
Window -> IO ()
flushCallBuffer Window
w
runFunction :: Window -> JSFunction () -> IO ()
runFunction :: Window -> JSFunction () -> IO ()
runFunction Window
w JSFunction ()
f = Window -> String -> IO ()
bufferRunEval Window
w (String -> IO ()) -> IO String -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSFunction () -> IO String
forall a. JSFunction a -> IO String
toCode JSFunction ()
f
unsafeCreateJSObject :: Window -> JSFunction NewJSObject -> IO JSObject
unsafeCreateJSObject :: Window -> JSFunction NewJSObject -> IO JSObject
unsafeCreateJSObject Window
w JSFunction NewJSObject
f = do
JSFunction JSObject
g <- Window -> JSFunction NewJSObject -> IO (JSFunction JSObject)
wrapImposeStablePtr Window
w JSFunction NewJSObject
f
Window -> String -> IO ()
bufferRunEval Window
w (String -> IO ()) -> IO String -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSFunction JSObject -> IO String
forall a. JSFunction a -> IO String
toCode JSFunction JSObject
g
JSFunction JSObject -> Window -> Value -> IO JSObject
forall a. JSFunction a -> Window -> Value -> IO a
marshalResult JSFunction JSObject
g Window
w Value
JSON.Null
callFunction :: Window -> JSFunction a -> IO a
callFunction :: Window -> JSFunction a -> IO a
callFunction Window
w JSFunction a
f = do
Window -> IO ()
flushCallBuffer Window
w
Value
resultJS <- Window -> String -> IO Value
callEval Window
w (String -> IO Value) -> IO String -> IO Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSFunction a -> IO String
forall a. JSFunction a -> IO String
toCode JSFunction a
f
JSFunction a -> Window -> Value -> IO a
forall a. JSFunction a -> Window -> Value -> IO a
marshalResult JSFunction a
f Window
w Value
resultJS
exportHandler :: IsHandler a => Window -> a -> IO JSObject
exportHandler :: Window -> a -> IO JSObject
exportHandler Window
w a
f = do
HsEvent
g <- Window -> ([Value] -> IO ()) -> IO HsEvent
newHandler Window
w (\[Value]
args -> a -> Window -> [Value] -> IO ()
forall a. IsHandler a => a -> Window -> [Value] -> IO ()
handle a
f Window
w [Value]
args IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> IO ()
flushCallBuffer Window
w)
JSObject
h <- Window -> JSFunction NewJSObject -> IO JSObject
unsafeCreateJSObject Window
w (JSFunction NewJSObject -> IO JSObject)
-> JSFunction NewJSObject -> IO JSObject
forall a b. (a -> b) -> a -> b
$
String -> HsEvent -> String -> JSFunction NewJSObject
forall a. FFI a => String -> a
ffi String
"Haskell.newEvent(%1,%2)" HsEvent
g (a -> String
forall a. IsHandler a => a -> String
convertArguments a
f)
JSObject -> HsEvent -> IO ()
forall a b. RemotePtr a -> RemotePtr b -> IO ()
Foreign.addReachable JSObject
h HsEvent
g
JSObject -> IO JSObject
forall (m :: * -> *) a. Monad m => a -> m a
return JSObject
h