Binary support (ArrayBuffer messages)

bower.json

@@ -16,9 +16,13 @@
     "bower_components"
   ],
   "dependencies": {
-    "purescript-maybe": "~0.3.5",
-    "purescript-transformers": "~0.8.0",
-    "purescript-control": "~0.3.2",
-    "purescript-functions": "~0.1.0"
+    "purescript-maybe": "~3.0.0",
+    "purescript-transformers": "~3.0.0",
+    "purescript-control": "~3.0.0",
+    "purescript-functions": "~3.0.0",
+    "purescript-arraybuffer-types": "~2.0.0"
+  },
+  "devDependencies": {
+    "purescript-console": "~3.0.0"
   }
 }

example/Main.purs

@@ -1,8 +1,8 @@
 module Main where
 
-import Prelude
+import Prelude (Unit, bind, (<<<), ($))
 import WebSocket
-import Control.Monad.Eff.Console
+import Control.Monad.Eff.Console (CONSOLE, log)
 import Control.Monad.Eff (Eff ())
 import Control.Monad.Trans (lift)
 import Data.Either (Either (Left, Right))
@@ -16,9 +16,11 @@ main = do
          Right _ -> output "DONE"
          Left err -> output err
 
+config :: WebSocketConfig
 config =
   { uri: "ws://127.0.0.1:9001"
   , protocols: []
+  , binary: false
   }
 
 handlers :: forall eff. WebSocketHandler (console :: CONSOLE | eff)

src/HTML5/WebSocket.js

@@ -16,10 +16,18 @@ exports.withWebSocketImpl = function(config, handlers, ok, err) {
             h.onOpen();
             return {};
         };
-        socket.onmessage = function(ev) {
-            h.onMessage(ev.data)();
-            return {};
-        };
+	if (config.binary) {
+            socket.binaryType = 'arraybuffer';
+            socket.onmessage = function (ev) {
+		h.onBuffer(ev.data)();
+		return {};
+            };
+	} else {
+            socket.onmessage = function (ev) {
+		h.onMessage(ev.data)();
+		return {};
+            };
+	}
         socket.onclose = function() {
             ok({})();
             return {};

src/HTML5/WebSocket.purs

@@ -10,20 +10,23 @@ module WebSocket
   , WithWebSocket ()
   , defaultHandlers
   , send
+  , bsend
   , withWebSocket
   , runWebSocket
   ) where
 
 import Prelude
-import Control.Monad.Eff
-import Data.Either
-import Data.Function
+import Control.Monad.Eff (kind Effect, Eff)
+import Data.Either (Either(..))
+import Control.Monad.Cont.Trans (ContT(..), runContT)
+import Data.Function.Uncurried (runFn2, Fn2, Fn4, runFn4)
+import Data.ArrayBuffer.Types (ArrayBuffer)
 
-import Control.Monad.Cont.Trans
 
 type WebSocketConfig =
   { uri :: URI
   , protocols :: Array Protocol
+  , binary :: Boolean
   }
 
 type URI = String
@@ -33,17 +36,18 @@ type WithWebSocket eff = Eff (ws :: WS | eff)
 type WebSocket eff = ContT Unit (WithWebSocket eff)
 type WebSocketError = String
 
-foreign import data WS :: !
+foreign import data WS :: Effect
 
-foreign import data Socket :: *
+foreign import data Socket :: Type
 
 type WebSocketHandler eff = Socket ->
   { onOpen :: WithWebSocket eff Unit
   , onMessage :: String -> WithWebSocket eff Unit
+  , onBuffer :: ArrayBuffer -> WithWebSocket eff Unit
   }
 
 runWebSocket :: forall eff. WebSocket eff Unit -> WithWebSocket eff Unit
-runWebSocket = flip runContT return
+runWebSocket = flip runContT pure
 
 foreign import withWebSocketImpl :: forall eff.
           Fn4 WebSocketConfig
@@ -54,8 +58,9 @@ foreign import withWebSocketImpl :: forall eff.
 
 defaultHandlers :: forall eff. WebSocketHandler eff
 defaultHandlers _ =
-  { onOpen: return unit
-  , onMessage: const $ return unit
+  { onOpen: pure unit
+  , onMessage: const $ pure unit
+  , onBuffer: const $ pure unit
   }
 
 withWebSocket :: forall eff. WebSocketConfig
@@ -65,7 +70,10 @@ withWebSocket c h = ContT $ \k -> runFn4 withWebSocketImpl c h
                                          (k <<< Right)
                                          (k <<< Left)
 
-foreign import sendImpl :: forall eff.  Fn2 Socket String (WithWebSocket eff Unit)
+foreign import sendImpl :: forall eff a.  Fn2 Socket a (WithWebSocket eff Unit)
 
 send :: forall eff.  Socket -> String -> WithWebSocket eff Unit
 send = runFn2 sendImpl
+
+bsend :: forall eff.  Socket -> ArrayBuffer -> WithWebSocket eff Unit
+bsend = runFn2 sendImpl