frpstuff.hs

{-# LANGUAGE RankNTypes #-}
import Control.Monad (when)
import Reactive.Banana
import Reactive.Banana.Frameworks

main = do
  source <- newAddHandler
  network <- setupNetwork source
  actuate network
  eventLoop source

eventLoop :: EventSource () -> IO ()
eventLoop esEvent = loop
  where
  loop = do
    s <- getLine
    case s of
      "event" -> return () >>= snd esEvent
      _ -> return ()
    when (s /= "quit") loop

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

setupNetwork :: EventSource () -> IO EventNetwork
setupNetwork esEvent = compile $ do
  eEvent <- fromAddHandler $ fst esEvent
  reactimate $ fmap react eEvent
  where
  react _ = putStrLn "react"