Setup custom Events with data in reactive-banana

Question

I have a sample I picked up from the reactive-banana repo. This uses gloss. But when I work with events I have my own events with data. These events are not necessarily UI events. So I was expecting that FRP can help me code with custom events. So, for example, a list could change and the changed data is inside an event and another part of the application uses the changed data. My preliminary Haskell knowledge didn't help me to achieve this using reactive-banana but I did come across something similar.

How can I use my own events likemakeTickEvent and fire them ? Can it hold data ?

{-# LANGUAGE ScopedTypeVariables #-}

module Main where
import Control.Monad (when)
import Data.Maybe (isJust, fromJust)
import Data.List (nub)
import System.Random
import System.IO
import Debug.Trace
import Data.IORef
import Reactive.Banana as R
import Reactive.Banana.Frameworks as R

import Graphics.Gloss
import Graphics.Gloss.Data.Extent
import Graphics.Gloss.Interface.Pure.Game
import Graphics.Gloss.Data.Picture

main :: IO()
main = do
    sources <- makeSources
    network <- compile $ networkDescription sources
    actuate network
    eventLoop sources
    display windowDisplay white drawBoard

windowDisplay :: Display
windowDisplay = InWindow "Window" (200, 200) (10, 10)

makeTickEvent :: MomentIO (R.Event ())
makeTickEvent = do
  (etick, tick) <- newEvent
  
  tid <- liftIO  $ do
    tick ()

  pure etick

drawBoard :: Picture
drawBoard =
  Pictures $ [ translate x y $ rectangleWire 90 90| x<-[0,90..180], y<-[0,90..180] ] 


makeSources =  newAddHandler


type EventSource a = (AddHandler a, a -> IO ())



addHandler :: EventSource a -> AddHandler a
addHandler = fst

eventLoop :: (EventSource ())  -> IO ()
eventLoop (displayvalueevent)  =
  fire displayvalueevent ()

fire :: EventSource a -> a -> IO ()
fire = snd


networkDescription :: (EventSource ()) -> MomentIO ()
networkDescription ( displayvalueevent )= do
  -- Obtain events 
  displayvalue <- fromAddHandler (addHandler displayvalueevent)
  reactimate $ putStrLn . showValue <$> displayvalue
 
showValue value = "Value is " ++ show value

This is from the documentation.

plainChanges :: Behavior a -> MomentIO (Event a)
plainChanges b = do
    (e, handle) <- newEvent
    eb <- changes b
    reactimate' $ (fmap handle) <$> eb
    return e

Does this create a new Event that can be fired ?

Answer 1

I have managed to make this code work for now. An event is fired and a new frame is rendered in the initial Gloss Window. It seems to be possible to fire a custom event. But I am not sure about encapsulating data inside the event.

makeNewEvent :: MomentIO (Reactive.Banana.Event ())
makeNewEvent = do
  (enew, new) <- newEvent
  
  tid <- liftIO  $ do
    putStrLn "Fire new Event" 
    new ()

  return enew 

The following code answers some questions. If I have more details I can edit later. This is still very basic as I am learning reactive-banana and 'haskell'

------------------------------------------------------------------------------}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BlockArguments #-}

module Main where
import Data.IORef
import Data.Bool (bool)
import Data.IORef (newIORef, readIORef, writeIORef)
import Graphics.Gloss hiding (pictures)
import Reactive.Banana
import Reactive.Banana.Frameworks
import Graphics.Gloss.Interface.IO.Game( Event(..) )
import Graphics.Gloss.Interface.IO.Game( MouseButton(..) )
import Graphics.Gloss.Interface.IO.Game( KeyState( Down ) )
import Graphics.Gloss.Interface.IO.Game
import qualified Graphics.Gloss.Interface.IO.Game as Gloss (Event, playIO)


main = do

   (eventHandler,event)<- makeSources
   picRef ← newIORef blank
  
   network <- compile $ networkDescriptor picRef eventHandler
   actuate network
   let handleEvent e@(EventKey k Down _ _) = case k of
            (SpecialKey KeySpace) -> event e
            _                   -> return ()
       handleEvent e = return ()

   Gloss.playIO
    (InWindow "Functional Reactive" (550, 490) (800, 200))
    white
    30
    ()
    (\() -> readIORef picRef)
    (\ ev () -> handleEvent ev)
    (\_ () -> pure ())

reactToKeyPress :: IO ()
reactToKeyPress = putStrLn "Key Pressed"

drawBoard :: Picture
drawBoard =
   Pictures $ [ color violet $ translate x y $ rectangleWire 90 90| x<-[0,90..180], y<-[0,90..180] ] 

makeSources =  newAddHandler

type EventSource a = (AddHandler a, a -> IO ())

addHandler :: EventSource a -> AddHandler a
addHandler = fst

fire :: EventSource a -> a -> IO ()
fire = snd

networkDescriptor :: IORef Picture -> AddHandler Gloss.Event -> MomentIO ()
networkDescriptor lastFrame  displayGlossEvent = do
  glossEvent <- fromAddHandler displayGlossEvent
  reactimate $ putStrLn . showValue <$> glossEvent

  picture <- liftMoment (handleKeys glossEvent )
  changes picture >>= reactimate' . fmap (fmap (writeIORef lastFrame))
  valueBLater picture >>= liftIO . writeIORef lastFrame

showValue value = "Value is " ++ show value

handleKeys :: Reactive.Banana.Event e  -> Moment (Behavior Picture)
handleKeys glossEvent = do

  let picture = drawBoard
  return $ pure picture