PureScript Halogen and websockets

Question

I'm trying to use purescript-halogen in combination with websockets, but after several attempts I'm unable to make them work together.

I've seen this question on Thermite and websockets and Phil's answer regarding the Driver function. Halogen also has a Driver function, but I need to run the Driver function with the Aff effect, while purescript-websockets-simple uses the Eff effect.

I've no idea how to transform the synchronous callbacks of the websocket package to asynchronous code running in the Aff monad. Do I need to use an AVar? Do I need purescript-coroutines-aff? If so, how do I hook up these parts together?

Thanks in advance for any pointers in the right direction!

Answer 1

In this case you would indeed want to use purescript-aff-coroutines. That will get you a coroutine Producer that you can then hook up to a Consumer that pushes messages into the driver:

module Main where

import Prelude

import Control.Coroutine (Producer, Consumer, consumer, runProcess, ($$))
import Control.Coroutine.Aff (produce)
import Control.Monad.Aff (Aff)
import Control.Monad.Aff.AVar (AVAR)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Exception (EXCEPTION)
import Control.Monad.Eff.Var (($=))

import Data.Array as Array
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))

import Halogen as H
import Halogen.HTML.Indexed as HH
import Halogen.Util (runHalogenAff, awaitBody)

import WebSocket (WEBSOCKET, Connection(..), Message(..), URL(..), runMessageEvent, runMessage, newWebSocket)

----------------------------------------------------------------------------
-- Halogen component. This just displays a list of messages and has a query
-- to accept new messages.
----------------------------------------------------------------------------

type State = { messages :: Array String }

initialState :: State
initialState = { messages: [] }

data Query a = AddMessage String a

ui :: forall g. H.Component State Query g
ui = H.component { render, eval }
  where
  render :: State -> H.ComponentHTML Query
  render state =
    HH.ol_ $ map (\msg -> HH.li_ [ HH.text msg ]) state.messages

  eval :: Query ~> H.ComponentDSL State Query g
  eval (AddMessage msg next) = do
    H.modify \st -> { messages: st.messages `Array.snoc` msg }
    pure next

----------------------------------------------------------------------------
-- Websocket coroutine producer. This uses `purescript-aff-coroutines` to
-- create a producer of messages from a websocket.
----------------------------------------------------------------------------

wsProducer :: forall eff. Producer String (Aff (avar :: AVAR, err :: EXCEPTION, ws :: WEBSOCKET | eff)) Unit
wsProducer = produce \emit -> do
  Connection socket <- newWebSocket (URL "ws://echo.websocket.org") []

  -- This part is probably unnecessary in the real world, but it gives us 
  -- some messages to consume when using the echo service
  socket.onopen $= \event -> do
    socket.send (Message "hello")
    socket.send (Message "something")
    socket.send (Message "goodbye")

  socket.onmessage $= \event -> do
    emit $ Left $ runMessage (runMessageEvent event)

----------------------------------------------------------------------------
-- Coroutine consumer. This accepts a Halogen driver function and sends
-- `AddMessage` queries in when the coroutine consumes an input.
----------------------------------------------------------------------------

wsConsumer
  :: forall eff
   . (Query ~> Aff (H.HalogenEffects (ws :: WEBSOCKET | eff)))
  -> Consumer String (Aff (H.HalogenEffects (ws :: WEBSOCKET | eff))) Unit
wsConsumer driver = consumer \msg -> do
  driver $ H.action $ AddMessage msg
  pure Nothing

----------------------------------------------------------------------------
-- Normal Halogen-style `main`, the only addition is a use of `runProcess`
-- to connect the producer and consumer and start sending messages to the
-- Halogen component.
----------------------------------------------------------------------------

main :: forall eff. Eff (H.HalogenEffects (ws :: WEBSOCKET | eff)) Unit
main = runHalogenAff do
  body <- awaitBody
  driver <- H.runUI ui initialState body
  runProcess (wsProducer $$ wsConsumer driver)
  pure unit

This should give you a page that almost immediately prints:

1. hello
2. something
3. goodbye

But it is doing everything you need, honest! If you use the producer with a "real" source you'll get something more like what you need.