Created
October 2, 2013 09:54
-
-
Save HeinrichApfelmus/6791442 to your computer and use it in GitHub Desktop.
Create new behaviors and switch between them.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE Rank2Types #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
import Data.Traversable (sequenceA) | |
import Reactive.Banana | |
import Reactive.Banana.Frameworks | |
newtype Wrapper = Wrapper (forall t. Moment t (Event t () -> Behavior t Integer)) | |
main :: IO () | |
main = do | |
(a, h) <- newAddHandler | |
let networkDescription :: forall t. Frameworks t => Moment t () | |
networkDescription = do | |
e <- fromAddHandler a | |
eTick <- trimE $ () <$ e | |
let | |
e1 :: Event t (AnyMoment Behavior Integer) | |
e1 = (\(Wrapper m) -> anyMoment $ m <*> now eTick) <$> e | |
-- Trim the behaviors so that they can accumulate state. | |
-- | |
-- The following is indented to simply read | |
-- | |
-- observe (trimB <$> e1) | |
-- | |
-- but the lack of support for imperative polymorphism | |
-- forces us to be a little more verbose. | |
e1b = observeE $ (\mb -> anyMoment $ do | |
b <- now mb | |
Identity <$> trimB b) <$> e1 | |
e2 :: Event t [AnyMoment Behavior Integer] | |
e2 = accumE [] $ (:) <$> e1b | |
e3 :: Event t (AnyMoment Behavior [Integer]) | |
e3 = sequenceA <$> e2 | |
b :: Behavior t [Integer] | |
b = pure [] `switchB` e3 | |
reactimate $ print <$> (b <@ e) | |
network <- compile networkDescription | |
actuate network | |
sequence_ . replicate 4 $ h $ Wrapper $ return $ \e -> accumB 0 $ (+ 1) <$ e |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment