a10ddfd · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Add websocket onopen event

a10ddfdAli Abrar11 years ago

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

compare with develop

unifiedsplit

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

26 , wsContext :: JSContextRef

27 }

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

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

30−newWebSocket wv url onMessage onClose = do

30+newWebSocket wv url onMessage onOpen onClose = do

31 c <- webFrameGetGlobalContext =<< webViewGetMainFrame wv

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

33 newWSArgs <- toJSObject c [url']

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

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

44 jsvaluemakeundefined c

45 onMessageCb <- jsobjectmakefunctionwithcallback c nullPtr onMessage'

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

47+ onOpen

48+ jsvaluemakeundefined c

49+ onOpenCb <- jsobjectmakefunctionwithcallback c nullPtr onOpen'

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

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

47 onClose

51 onClose

48 jsvaluemakeundefined c

52 jsvaluemakeundefined c

49 onCloseCb <- jsobjectmakefunctionwithcallback c nullPtr onClose'

53 onCloseCb <- jsobjectmakefunctionwithcallback c nullPtr onClose'

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

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

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

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

52 _ <- jsevaluatescript c addCbs o nullPtr 1 nullPtr

56 _ <- jsevaluatescript c addCbs o nullPtr 1 nullPtr

53 return $ JSWebSocket ws c

57 return $ JSWebSocket ws c

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

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

10import qualified Data.ByteString as BS

11import Foreign.Ptr

12import GHCJS.Foreign

13+import GHCJS.Marshal

13import GHCJS.Types

14import GHCJS.Types

15+import GHCJS.DOM.EventM

16+import GHCJS.DOM.Types

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

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

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

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

19data JSByteArray

22data JSByteArray

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

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

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))

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

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

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

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

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

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

28 ba <- extractByteArray cStr $ BS.length bs

31 ba <- extractByteArray cStr $ BS.length bs

29− webSocketSend_ (unWebSocket ws) ba

32+ webSocketSend_ (unJSWebSocket ws) ba

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

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

32−newWebSocket _ url onMessage onClose = do

35+newWebSocket _ url onMessage onOpen onClose = do

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

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

34 rec onCloseFun <- syncCallback AlwaysRetain True $ do

37 rec onCloseFun <- syncCallback AlwaysRetain True $ do

35 release onMessageFun

38 release onMessageFun

36 release onCloseFun

39 release onCloseFun

37 onClose

40 onClose

41+ onOpenFun <- syncCallback AlwaysRetain True $ do

42+ release onOpenFun

43+ onOpen

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

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

39−

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

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

30data WebSocket t

31 = WebSocket { _webSocket_recv :: Event t ByteString

32+ , _webSocket_open :: Event t ()

32 }

33 }

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

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

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

39 (eRecv, eRecvTriggerRef) <- newEventWithTriggerRef

40 (eRecv, eRecvTriggerRef) <- newEventWithTriggerRef

40 currentSocketRef <- liftIO $ newIORef Nothing

41 currentSocketRef <- liftIO $ newIORef Nothing

41 --TODO: Disconnect if value no longer needed

42 --TODO: Disconnect if value no longer needed

43+ (eOpen, eOpenTriggerRef) <- newEventWithTriggerRef

42 let onMessage :: ByteString -> IO ()

44 let onMessage :: ByteString -> IO ()

43 onMessage m = postGui $ do

45 onMessage m = postGui $ do

44 mt <- readRef eRecvTriggerRef

46 mt <- readRef eRecvTriggerRef

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

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

48+ onOpen = postGui $ do

49+ mt <- readRef eOpenTriggerRef

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

46 start = do

51 start = do

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

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

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

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

49 liftIO $ writeIORef currentSocketRef Nothing

54 liftIO $ writeIORef currentSocketRef Nothing

50 liftIO $ threadDelay 1000000

55 liftIO $ threadDelay 1000000

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

58 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?

63 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?

59 Just ws -> do

64 Just ws -> do

60 liftIO $ webSocketSend ws payload

65 liftIO $ webSocketSend ws payload

61− return $ WebSocket eRecv

66+ return $ WebSocket eRecv eOpen

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

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