halogen-websocket-ipc-playzone/drop/WebSocketsWithArrayBufferStuff.purs

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