(PureScript) How can I run a DOM event listener callback within a monadic context other than Eff?

Question

I'm making a canvas game using PureScript and I'm wondering what the best way to handle event listeners is, particularly running the callbacks within a custom monad stack. This is my game stack...

type BaseEffect e = Eff (canvas :: CANVAS, dom :: DOM, console :: CONSOLE | e)
type GameState = { canvas :: CanvasElement, context :: Context2D, angle :: Number }
type GameEffect e a = StateT GameState (BaseEffect e) a

What I'd like to do is change the "angle" property in the GameState when any key is pressed (just for development purposes so I can tweak the graphics). This is my callback function...

changeState :: forall e. Event -> GameEffect e Unit
changeState a = do
  modify \s -> s { angle = s.angle + 1.0 }
  liftEff $ log "keypress"
  pure unit

However addEventListener and eventListener look like they're meant to be used only with Eff, so the following won't type check...

addEventListener
  (EventType "keypress")
  (eventListener changeState)
  false
  ((elementToEventTarget <<< htmlElementToElement) bodyHtmlElement)

I thought I could define addEventListener and eventListener myself and import them using the foreign function interfaces (changing Eff to GameEffect). That typed checked, but caused a console error when I tried running in the browser.

foreign import addEventListener :: forall e. EventType -> EventListener e -> Boolean -> EventTarget -> GameEffect e Unit
foreign import eventListener :: forall e. (Event -> GameEffect e Unit) -> EventListener e

What's the best way to handle running callbacks within a monad stack?

Answer 1

I would use purescript-aff-coroutines for this. It means changing BaseEffect to Aff, but anything Eff can do Aff can do too:

import Prelude

import Control.Coroutine as CR
import Control.Coroutine.Aff as CRA
import Control.Monad.Aff (Aff)
import Control.Monad.Aff.AVar (AVAR)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Rec.Class (forever)
import Control.Monad.State (StateT, lift, modify)
import Data.Either (Either(..))

import DOM (DOM)
import DOM.Event.EventTarget (addEventListener, eventListener)
import DOM.Event.Types (Event, EventTarget, EventType(..))
import DOM.HTML.Types (HTMLElement, htmlElementToElement)
import DOM.Node.Types (elementToEventTarget)

import Graphics.Canvas (CANVAS, CanvasElement, Context2D)

type BaseEffect e = Aff (canvas :: CANVAS, dom :: DOM, console :: CONSOLE, avar :: AVAR | e)
type GameState = { canvas :: CanvasElement, context :: Context2D, angle :: Number }
type GameEffect e = StateT GameState (BaseEffect e)

changeState :: forall e. Event -> GameEffect e Unit
changeState a = do
  modify \s -> s { angle = s.angle + 1.0 }
  liftEff $ log "keypress"
  pure unit

eventProducer :: forall e. EventType -> EventTarget -> CR.Producer Event (GameEffect e) Unit
eventProducer eventType target =
  CRA.produce' \emit ->
    addEventListener eventType (eventListener (emit <<< Left)) false target

setupListener :: forall e. HTMLElement -> GameEffect e Unit
setupListener bodyHtmlElement = CR.runProcess $ consumer `CR.pullFrom` producer
  where
  producer :: CR.Producer Event (GameEffect e) Unit
  producer =
    eventProducer
      (EventType "keypress")
      ((elementToEventTarget <<< htmlElementToElement) bodyHtmlElement)
  consumer :: CR.Consumer Event (GameEffect e) Unit
  consumer = forever $ lift <<< changeState =<< CR.await

So in here the eventProducer function creates a coroutine producer for an event listener, and then setupListener does the the equivalent of the theoretical addEventListener usage you had above.

This works by creating a producer for the listener and then connecting it to a consumer that calls changeState when it receives an Event. Coroutine processes run with a monadic context, here being your GameEffect monad, which is why everything works out.