190 lines
6.5 KiB
Plaintext
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
|