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

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.