e923366 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

websockets allow receiving text messages not only binaries

e923366Attila Sztupak11 years ago

src-ghcjs/Reflex/Dom/WebSocket/Foreign.hs+10−2

@@ -6,6 +6,8 @@ import Prelude hiding (div, span, mapM, mapM_, concat, concatMap, all, sequence)

7import Data.ByteString (ByteString)

8import qualified Data.ByteString as BS

9+import Data.Text as T

10+import Data.Text.Encoding (encodeUtf8)

9import GHCJS.Types

11import GHCJS.Types

10import GHCJS.DOM.WebSocket (message, open, closeEvent)

12import GHCJS.DOM.WebSocket (message, open, closeEvent)

11import qualified GHCJS.DOM.WebSocket as GD

13import qualified GHCJS.DOM.WebSocket as GD

@@ -17,6 +19,8 @@ import Control.Monad.Reader

17import GHCJS.Buffer

19import GHCJS.Buffer

18import JavaScript.TypedArray.ArrayBuffer as JS

20import JavaScript.TypedArray.ArrayBuffer as JS

19import GHCJS.Marshal.Pure

21import GHCJS.Marshal.Pure

22+import qualified GHCJS.Prim as Prim

23+import GHCJS.Foreign

21data JSWebSocket = JSWebSocket { unWebSocket :: WebSocket }

25data JSWebSocket = JSWebSocket { unWebSocket :: WebSocket }

@@ -28,8 +32,12 @@ newWebSocket _ url onMessage onOpen onClose = do

28 _ <- on ws message $ do

32 _ <- on ws message $ do

29 e <- ask

33 e <- ask

30 d <- getData e

34 d <- getData e

35+ if isString d

36+ then

37+ liftIO $ onMessage $ encodeUtf8 $ T.pack $ Prim.fromJSString d

38+ else do

31− ab <- liftIO $ unsafeFreeze $ pFromJSVal d

39+ ab <- liftIO $ unsafeFreeze $ pFromJSVal d

32− liftIO $ onMessage $ toByteString 0 Nothing $ createFromArrayBuffer ab

40+ liftIO $ onMessage $ toByteString 0 Nothing $ createFromArrayBuffer ab

33 _ <- on ws closeEvent $ liftIO onClose

41 _ <- on ws closeEvent $ liftIO onClose

34 return $ JSWebSocket ws

42 return $ JSWebSocket ws