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