diff --git a/bower.json b/bower.json index 109a324..cca4b82 100644 --- a/bower.json +++ b/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" } } diff --git a/example/Main.purs b/example/Main.purs index 180080a..fff2c9c 100644 --- a/example/Main.purs +++ b/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) diff --git a/src/HTML5/WebSocket.js b/src/HTML5/WebSocket.js index 92cf04d..1860e57 100644 --- a/src/HTML5/WebSocket.js +++ b/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 {}; diff --git a/src/HTML5/WebSocket.purs b/src/HTML5/WebSocket.purs index 0fdb519..6a1fe46 100644 --- a/src/HTML5/WebSocket.purs +++ b/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