wrapping reactive banana

gistfile1.hs

interpretModel :: (forall t. Event t a -> Event t b) -> [[a]] -> [[b]]
interpretModel f xs = map toList $ (unE . f . E) (map Just xs)
    where toList :: Maybe [a] -> [a]
          toList Nothing   = []
          toList (Just xs) = xs

runner :: (forall t. Event t a -> Event t b) -> IO ([a] -> IO [[b]])
runner network = do inbox  <- newIORef [] -- ref to write events into
                    outbox <- newIORef . interpretModel network =<< toEvents inbox
                    return $ step inbox outbox

toEvents :: IORef [a] -> IO [[a]]
toEvents ref = unsafeInterleaveIO $ do
                 current <- readIORef ref
                 writeIORef ref []
                 future  <- toEvents ref
                 return $ current : future

step :: IORef [a] -> IORef [[b]] -> [a] -> IO [[b]]
step inbox outbox inEvent = do writeIORef inbox inEvent
                               outs <- readIORef outbox
                               let (_, outs') = span null outs
                                   (current, future) = break null outs'
                               writeIORef outbox future
                               return current