halogen-websocket-ipc-playzone/drop/WebSocketsWithArrayBufferSt...

190 lines
6.5 KiB
Plaintext

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