-
Notifications
You must be signed in to change notification settings - Fork 217
/
Main.purs
69 lines (61 loc) · 2.4 KB
/
Main.purs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
module Example.Driver.Websockets.Main where
import Prelude
import Control.Coroutine as CR
import Control.Coroutine.Aff (emit)
import Control.Coroutine.Aff as CRA
import Control.Monad.Except (runExcept)
import Data.Either (either)
import Data.Foldable (for_)
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Effect.Aff (Aff)
import Example.Driver.Websockets.Log as Log
import Foreign (F, Foreign, unsafeToForeign, readString)
import Halogen as H
import Halogen.Aff as HA
import Halogen.Subscription as HS
import Halogen.VDom.Driver (runUI)
import Web.Event.EventTarget as EET
import Web.Socket.Event.EventTypes as WSET
import Web.Socket.Event.MessageEvent as ME
import Web.Socket.WebSocket as WS
-- A producer coroutine that emits messages that arrive from the websocket.
wsProducer :: WS.WebSocket -> CR.Producer String Aff Unit
wsProducer socket = CRA.produce \emitter -> do
listener <- EET.eventListener \ev -> do
for_ (ME.fromEvent ev) \msgEvent ->
for_ (readHelper readString (ME.data_ msgEvent)) \msg ->
emit emitter msg
EET.addEventListener
WSET.onMessage
listener
false
(WS.toEventTarget socket)
where
readHelper :: forall a b. (Foreign -> F a) -> b -> Maybe a
readHelper read =
either (const Nothing) Just <<< runExcept <<< read <<< unsafeToForeign
-- A consumer coroutine that takes the `query` function from our component IO
-- record and sends `ReceiveMessage` queries in when it receives inputs from the
-- producer.
wsConsumer :: (forall a. Log.Query a -> Aff (Maybe a)) -> CR.Consumer String Aff Unit
wsConsumer query = CR.consumer \msg -> do
void $ query $ H.mkTell $ Log.ReceiveMessage msg
pure Nothing
-- A handler for messages from our component IO that sends them to the server
-- using the websocket
wsSender :: WS.WebSocket -> Log.Message -> Effect Unit
wsSender socket = case _ of
Log.OutputMessage msgContents ->
WS.sendString socket msgContents
main :: Effect Unit
main = do
connection <- WS.create "wss://ws.postman-echo.com/raw" []
HA.runHalogenAff do
body <- HA.awaitBody
io <- runUI Log.component unit body
-- Subscribe to all output messages from our component
_ <- H.liftEffect $ HS.subscribe io.messages $ wsSender connection
-- Connecting the consumer to the producer initializes both,
-- feeding queries back to our component as messages are received.
CR.runProcess (wsProducer connection CR.$$ wsConsumer io.query)