Add an example of Websockets with ArrayBuffer.

drop/WebSocketsWithArrayBufferStuff.purs

@@ -0,0 +1,189 @@
+module Main where
+
+import Prelude
+
+import Control.Monad.Except (runExcept)
+import Data.Array as Array
+import Data.ArrayBuffer.DataView as DataView
+import Data.ArrayBuffer.Types (ArrayBuffer, ArrayView, DataView, Int32)
+import Data.Bifunctor (lmap)
+import Data.Either (Either(Left, Right))
+import Data.Maybe (Maybe(Just))
+import Data.String as String
+import Data.Traversable (traverse_)
+import Effect (Effect)
+import Effect.Class.Console as Console
+import Foreign (Foreign)
+import Foreign as F
+import Halogen.Subscription as HS
+import Web.Event.Event (Event)
+import Web.Event.Event as Event
+import Web.Event.EventTarget (EventTarget)
+import Web.Event.EventTarget as EventTarget
+import Web.Socket.BinaryType (BinaryType(ArrayBuffer))
+import Web.Socket.Event.CloseEvent (CloseEvent)
+import Web.Socket.Event.CloseEvent as CloseEvent
+import Web.Socket.Event.EventTypes as EventTypes
+import Web.Socket.Event.MessageEvent as MessageEvent
+import Web.Socket.WebSocket (WebSocket)
+import Web.Socket.WebSocket as WS
+
+import Data.ArrayBuffer.Builder (execPut, putUint32be)
+
+--------------------------------------------------------------------------------
+-- Types
+
+data WebSocketEvent
+  = WSMessage Foreign
+  | WSClose CloseEvent
+  | WSOpen Event
+  | WSError Event
+
+--------------------------------------------------------------------------------
+-- Program entrypoint
+
+main :: Effect Unit
+main = do
+  Console.log "1. Let's start the application!"
+  websocketProgram "ws://127.0.0.1:8080"
+
+--------------------------------------------------------------------------------
+-- Here is where you edit in what you want to happen in this program
+-- in response to each type of `WebSocketEvent`.
+
+websocketProgram :: String -> Effect Unit
+websocketProgram url = do
+
+  Console.log "2. Let's start the application!"
+  webSocket <- WS.create url []
+
+  void $ HS.subscribe (webSocketEmitter webSocket) case _ of
+
+    WSOpen _event -> do
+      Console.log "Open event"
+      WS.setBinaryType webSocket ArrayBuffer
+      -- Console.log "WS set to binary, let's send something!"
+      -- sendArrayBuffer webSocket
+
+    WSMessage foreign' -> do
+      Console.log "Message event"
+      case foreignToDataView foreign' of
+        Left errs ->
+          Console.error errs
+        Right dataView -> do
+          Console.log "Do something with this DataView!"
+          let
+            byteOffset = 0
+            number = DataView.getInt32be dataView byteOffset
+          Console.log "Received number is: " <> show number
+          -- DataView.getInt32be dataView byteOffset >>= traverse_ \int32 ->
+          --   Console.log $ mkMessage byteOffset int32
+
+    WSClose _closeEvent -> do
+      Console.log "Close event"
+
+    WSError _event -> do
+      Console.log "Error event"
+
+mkMessage :: Int -> Int -> String
+mkMessage byteOffset i32 =
+  "The Int32 at ByteOffset " <> show byteOffset <> " was " <> show i32
+
+--------------------------------------------------------------------------------
+-- A unified emitter (of the 4 websocket event types) that we subscribe to once
+-- as you see in `webSocketProgram` above.
+webSocketEmitter
+  :: WebSocket
+  -> HS.Emitter WebSocketEvent
+webSocketEmitter webSocket =
+  HS.makeEmitter \pushWsEvent -> do
+    messageId <- HS.subscribe messageEmitter (pushWsEvent <<< WSMessage)
+    closeId <- HS.subscribe closeEmitter (pushWsEvent <<< WSClose)
+    openId <- HS.subscribe openEmitter (pushWsEvent <<< WSOpen)
+    errorId <- HS.subscribe errorEmitter (pushWsEvent <<< WSError)
+
+    pure do
+      HS.unsubscribe messageId
+      HS.unsubscribe closeId
+      HS.unsubscribe openId
+      HS.unsubscribe errorId
+
+  where
+  target :: EventTarget
+  target = WS.toEventTarget webSocket
+
+  fromMessageEvent :: Event -> Maybe Foreign
+  fromMessageEvent event = do
+    messageEvent <- MessageEvent.fromEvent event
+    pure $ MessageEvent.data_ messageEvent
+
+  messageEmitter = mkEventListener EventTypes.onMessage target fromMessageEvent
+  closeEmitter = mkEventListener EventTypes.onClose target CloseEvent.fromEvent
+  openEmitter = mkEventListener EventTypes.onOpen target Just
+  errorEmitter = mkEventListener EventTypes.onError target Just
+
+--------------------------------------------------------------------------------
+-- If the websocket is sending you back array buffers, this might be used to
+-- assist you in decoding those array buffers from the MessageEvent's data.
+
+foreignToArrayBuffer :: Foreign -> Either String ArrayBuffer
+foreignToArrayBuffer
+  = lmap renderForeignErrors
+  <<< runExcept
+  <<< F.unsafeReadTagged "ArrayBuffer"
+  where
+  renderForeignErrors :: F.MultipleErrors -> String
+  renderForeignErrors =
+    String.joinWith "; " <<< Array.fromFoldable <<< map F.renderForeignError
+
+arrayBufferToDataView :: ArrayBuffer -> DataView
+arrayBufferToDataView = DataView.whole
+
+foreignToDataView :: Foreign -> Either String DataView
+foreignToDataView = map arrayBufferToDataView <<< foreignToArrayBuffer
+
+{-
+
+From monoidmusician's link to the `Data.ArrayBuffer.DataView` module:
+  
+  -- Fetch big-endian int32 value at a certain index in a DataView.
+  DataView.getInt32be :: DataView -> ByteOffset -> Effect (Maybe Int)
+
+  -- Store big-endian int32 value at a certain index in a DataView.
+  DataView.setInt32be :: DataView -> ByteOffset -> Int -> Effect Boolean
+
+Using `DataView.getInt32be` on the `DataView` obtained above should be like
+this JS example in the MDN docs:
+  
+  https://developer.mozilla.org/en-US/docs/Web/API/WebSocket/binaryType#examples
+
+-}
+
+
+--------------------------------------------------------------------------------
+-- The module `Web.Socket.WebSocket` in the `purescript-web-socket` package does
+-- have these two functions below if you want to send just an `ArrayBuffer` or
+-- `ArrayView` alone.
+
+sendArrayBuffer :: WebSocket -> ArrayBuffer -> Effect Unit
+sendArrayBuffer = WS.sendArrayBuffer
+
+sendArrayBufferView :: WebSocket -> ArrayView Int32 -> Effect Unit
+sendArrayBufferView = WS.sendArrayBufferView
+
+--------------------------------------------------------------------------------
+-- Taken directly from `Halogen.Query.Event.eventListener`. I find it's nicer
+-- to use and re-use this (...than working directly with `addEventListener`,
+-- `removeEventListener`, etc. each time).
+mkEventListener
+  :: forall a
+   . Event.EventType
+  -> EventTarget.EventTarget
+  -> (Event.Event -> Maybe a)
+  -> HS.Emitter a
+mkEventListener eventType target f =
+  HS.makeEmitter \push -> do
+    listener <- EventTarget.eventListener \ev -> traverse_ push (f ev)
+    EventTarget.addEventListener eventType listener false target
+    pure do
+      EventTarget.removeEventListener eventType listener false target