Experiment.hs

{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE RankNTypes #-}
module Experiment where

import Control.Monad.Trans
import Data.IORef
import Reactive.Banana
import Reactive.Banana.Frameworks

data Network = Network { eventNetwork :: EventNetwork
                       , sync :: MomentIO () -> IO ()
                       }

newNet :: IO Network
newNet = do
    (ah, call) <- newAddHandler
    network <- compile (do
        globalExecuteEV <- fromAddHandler ah
        _ <- execute globalExecuteEV
        return () )
    actuate network
    return $ Network { eventNetwork = network
                     , sync = call
                     }

run :: Network -> MomentIO a -> IO a
run Network{sync = call} f = do
    ref <- newIORef (error "Network hasn't written result to ref")
    call $ do
        res <- f
        liftIO $ writeIORef ref res
    readIORef ref

main :: IO ()
main = do
    net <- newNet
    (bhv1, set1) <- run net $ newBehavior (0 :: Integer)
    (bhv2, set2) <- run net $ newBehavior (0 :: Integer)
    set1 3
    set2 7
    let sumB = (liftA2 (+) bhv1 bhv2)
    print =<< run net (valueB sumB)
    set1 5
    print =<< run net (valueB sumB)
    return ()