Counter.hs

{-----------------------------------------------------------------------------
    reactive-banana
    
    Example: Actuate and pause an event network acting as a counter
------------------------------------------------------------------------------}
import Control.Monad (when)
import System.IO

import Reactive.Banana
import Reactive.Banana.Frameworks


main :: IO ()
main = do
    displayHelpMessage
    sources <- (,,) <$> newAddHandler <*> newAddHandler <*> newAddHandler
    network <- setupNetwork sources
    actuate network
    eventLoop sources network

displayHelpMessage :: IO ()
displayHelpMessage = mapM_ putStrLn $
    "Commands are:":
    "   +   - increase counterUp event":
    "   -   - decrease counterUp event":
    "   p   - pause event network":
    "   a   - actuate event network":
    "   q   - quit the program":
    "":
    []

-- Read commands and fire corresponding events 
eventLoop :: (EventSource (), EventSource (),EventSource EventNetwork) -> EventNetwork -> IO ()
eventLoop (eplus, eminus, espause) network = loop
    where
    loop = do
        putStr "> "
        hFlush stdout
        hSetBuffering stdin NoBuffering
        s <- getChar
        case s of
            '+'   -> fire eplus ()
            '-'   -> fire eminus ()
            'p'   -> fire espause network
            'a'   -> actuate network
            'q'   -> return ()
            _     -> putStrLn $ [s] ++ " - unknown command"
        when (s /= 'q') loop

{-----------------------------------------------------------------------------
    Event sources
------------------------------------------------------------------------------}
-- Event Sources - allows you to register event handlers
-- Your GUI framework should provide something like this for you
type EventSource a = (AddHandler a, a -> IO ())

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

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

{-----------------------------------------------------------------------------
    Program logic
------------------------------------------------------------------------------}
-- Set up the program logic in terms of events and behaviors.
setupNetwork :: (EventSource (), EventSource (), EventSource EventNetwork) -> IO EventNetwork
setupNetwork (eplus, eminus, espause) = compile $ do
    counterUp   <- fromAddHandler (addHandler eplus)
    counterDown <- fromAddHandler (addHandler eminus)
    epause      <- fromAddHandler (addHandler espause)

    ecount <- accumE 0 $ unions
        [ (+1)       <$ counterUp
        , subtract 1 <$ counterDown
        ]

    reactimate $ fmap print ecount
    reactimate $ fmap pause epause