a10ddfd · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Add websocket onopen event

commita10ddfd9920e239c674feda34f6ba4ce0cb2b673 authorAli Abrar <aliabrar@gmail.com> dateTue 1 Dec 2015, 10:45 (11 years ago) parent71f1e6c

3 files changed+27−13

compare with develop

unifiedsplit

src-ghc/Reflex/Dom/WebSocket/Foreign.hs+8−4 src-ghcjs/Reflex/Dom/WebSocket/Foreign.hs+12−7 src/Reflex/Dom/WebSocket.hs+7−2

src-ghc/Reflex/Dom/WebSocket/Foreign.hs+8−4

@@ -26,8 +26,8 @@ data JSWebSocket = JSWebSocket { wsValue :: JSValueRef

2626 , wsContext :: JSContextRef

2727 }

2828

29−newWebSocket :: WebView -> String -> (ByteString -> IO ()) -> IO () -> IO JSWebSocket

30−newWebSocket wv url onMessage onClose = do

29+newWebSocket :: WebView -> String -> (ByteString -> IO ()) -> IO () -> IO () -> IO JSWebSocket

30+newWebSocket wv url onMessage onOpen onClose = do

3131 c <- webFrameGetGlobalContext =<< webViewGetMainFrame wv

3232 url' <- jsvaluemakestring c =<< jsstringcreatewithutf8cstring url

3333 newWSArgs <- toJSObject c [url']

@@ -43,12 +43,16 @@ newWebSocket wv url onMessage onClose = do

4343 Just m -> onMessage $ encodeUtf8 $ T.pack m

4444 jsvaluemakeundefined c

4545 onMessageCb <- jsobjectmakefunctionwithcallback c nullPtr onMessage'

46+ onOpen' <- wrapper $ \_ _ _ _ _ _ -> do

47+ onOpen

48+ jsvaluemakeundefined c

49+ onOpenCb <- jsobjectmakefunctionwithcallback c nullPtr onOpen'

4650 onClose' <- wrapper $ \_ _ _ _ _ _ -> do

4751 onClose

4852 jsvaluemakeundefined c

4953 onCloseCb <- jsobjectmakefunctionwithcallback c nullPtr onClose'

50− o <- toJSObject c [ws, onMessageCb, onCloseCb]

51− addCbs <- jsstringcreatewithutf8cstring "this[0]['onmessage'] = this[1]; this[0]['onclose'] = this[2];"

54+ o <- toJSObject c [ws, onMessageCb, onOpenCb, onCloseCb]

55+ addCbs <- jsstringcreatewithutf8cstring "this[0]['onmessage'] = this[1]; this[0]['onopen'] = this[2]; this[0]['onclose'] = this[3];"

5256 _ <- jsevaluatescript c addCbs o nullPtr 1 nullPtr

5357 return $ JSWebSocket ws c

5458

src-ghcjs/Reflex/Dom/WebSocket/Foreign.hs+12−7

@@ -10,30 +10,35 @@ import Data.Text.Encoding

1010import qualified Data.ByteString as BS

1111import Foreign.Ptr

1212import GHCJS.Foreign

13+import GHCJS.Marshal

1314import GHCJS.Types

15+import GHCJS.DOM.EventM

16+import GHCJS.DOM.Types

1417

1518#define JS(name, js, type) foreign import javascript unsafe js name :: type

1619

17−newtype JSWebSocket = JSWebSocket { unWebSocket :: JSRef JSWebSocket }

20+newtype JSWebSocket = JSWebSocket { unJSWebSocket :: JSRef JSWebSocket }

1821

1922data JSByteArray

2023JS(extractByteArray, "new Uint8Array($1_1.buf, $1_2, $2)", Ptr a -> Int -> IO (JSRef JSByteArray))

2124

22−JS(newWebSocket_, "(function() { var ws = new WebSocket($1); ws['binaryType'] = 'arraybuffer'; ws['onmessage'] = function(e){ $2(e['data']); }; ws['onclose'] = function(e){ $3(); }; return ws; })()", JSString -> JSFun (JSString -> IO ()) -> JSFun (IO ()) -> IO (JSRef JSWebSocket))

25+JS(newWebSocket_, "(function() { var ws = new WebSocket($1); ws['binaryType'] = 'arraybuffer'; ws['onmessage'] = function(e){ $2(e['data']); }; ws['onopen'] = function(e){ $3(); }; ws['onclose'] = function(e){ $4(); }; return ws; })()", JSString -> JSFun (JSString -> IO ()) -> JSFun (IO ()) -> JSFun (IO ()) -> IO (JSRef JSWebSocket))

2326

2427JS(webSocketSend_, "$1['send'](String.fromCharCode.apply(null, $2))", JSRef JSWebSocket -> JSRef JSByteArray -> IO ())

2528

2629webSocketSend :: JSWebSocket -> ByteString -> IO ()

2730webSocketSend ws bs = BS.useAsCString bs $ \cStr -> do

2831 ba <- extractByteArray cStr $ BS.length bs

29− webSocketSend_ (unWebSocket ws) ba

32+ webSocketSend_ (unJSWebSocket ws) ba

3033

31−newWebSocket :: a -> String -> (ByteString -> IO ()) -> IO () -> IO JSWebSocket

32−newWebSocket _ url onMessage onClose = do

34+newWebSocket :: a -> String -> (ByteString -> IO ()) -> IO () -> IO () -> IO JSWebSocket

35+newWebSocket _ url onMessage onOpen onClose = do

3336 onMessageFun <- syncCallback1 AlwaysRetain True $ onMessage <=< return . encodeUtf8 . fromJSString

3437 rec onCloseFun <- syncCallback AlwaysRetain True $ do

3538 release onMessageFun

3639 release onCloseFun

3740 onClose

38− liftM JSWebSocket $ newWebSocket_ (toJSString url) onMessageFun onCloseFun

39−

41+ onOpenFun <- syncCallback AlwaysRetain True $ do

42+ release onOpenFun

43+ onOpen

44+ liftM JSWebSocket $ newWebSocket_ (toJSString url) onMessageFun onOpenFun onCloseFun

src/Reflex/Dom/WebSocket.hs+7−2

@@ -29,6 +29,7 @@ instance Reflex t => Default (WebSocketConfig t) where

2929

3030data WebSocket t

3131 = WebSocket { _webSocket_recv :: Event t ByteString

32+ , _webSocket_open :: Event t ()

3233 }

3334

3435webSocket :: forall t m. (HasWebView m, MonadWidget t m) => String -> WebSocketConfig t -> m (WebSocket t)

@@ -39,12 +40,16 @@ webSocket url config = do

3940 (eRecv, eRecvTriggerRef) <- newEventWithTriggerRef

4041 currentSocketRef <- liftIO $ newIORef Nothing

4142 --TODO: Disconnect if value no longer needed

43+ (eOpen, eOpenTriggerRef) <- newEventWithTriggerRef

4244 let onMessage :: ByteString -> IO ()

4345 onMessage m = postGui $ do

4446 mt <- readRef eRecvTriggerRef

4547 forM_ mt $ \t -> runWithActions [t :=> m]

48+ onOpen = postGui $ do

49+ mt <- readRef eOpenTriggerRef

50+ forM_ mt $ \t -> runWithActions [t :=> ()]

4651 start = do

47− ws <- liftIO $ newWebSocket wv url onMessage $ do

52+ ws <- liftIO $ newWebSocket wv url onMessage onOpen $ do

4853 void $ forkIO $ do --TODO: Is the fork necessary, or do event handlers run in their own threads automatically?

4954 liftIO $ writeIORef currentSocketRef Nothing

5055 liftIO $ threadDelay 1000000

@@ -58,6 +63,6 @@ webSocket url config = do

5863 Nothing -> return () -- Discard --TODO: should we do something better here? probably buffer it, since we handle reconnection logic; how do we verify that the server has received things?

5964 Just ws -> do

6065 liftIO $ webSocketSend ws payload

61− return $ WebSocket eRecv

66+ return $ WebSocket eRecv eOpen

6267

6368makeLensesWith (lensRules & simpleLenses .~ True) ''WebSocketConfig