fibs.hs

-- Running Fibonacci numbers

import FRP.Reactive                ( Event, atTimes, scanlE )
import FRP.Reactive.LegacyAdapters ( adaptE )
import Control.Applicative         ( (<$>) )

fibs :: Event a -> Event (Integer, Integer)
fibs e = scanlE (\(n0, n1) _ -> (n1, n0 + n1)) (0, 1) e

main :: IO ()
main = adaptE $ print <$> (fibs $ atTimes [1..])

hello.hs

-- Print Hello World after 3 seconds.

import FRP.Reactive                ( atTime )
import FRP.Reactive.LegacyAdapters ( adaptE )
import Control.Applicative         ( (<$>) )

main :: IO ()
main = adaptE $ (\_ -> putStrLn "Hello, World!") <$> atTime 3

helloMany.hs

-- Print Hello World each second.

import FRP.Reactive                ( atTimes )
import FRP.Reactive.LegacyAdapters ( adaptE )
import Control.Applicative         ( (<$>) )

main :: IO ()
main = adaptE $ (\_ -> putStrLn "Hello, World!") <$> atTimes [1..]

mealy.hs

-- Toggle the state when you type something

import FRP.Reactive                ( Event, mealy_, zipE, atTimes )
import FRP.Reactive.LegacyAdapters ( makeClock, makeEvent, adaptE )
import Control.Applicative         ( (<$>) )
import System.IO                   ( stdout, stdin, hSetBuffering, hSetEcho,
                                     BufferMode(NoBuffering) )
import Control.Concurrent          ( forkIO )
import Control.Monad               ( forever )

-- Transition definition
next :: String -> String
next "HOP" = "STEP"
next "STEP" = "JUMP"
next "JUMP" = "HOP"

-- An event makes state update
state :: Event a -> Event String
state event = mealy_ "HOP" next event

-- Zip state event and clock event, and show current state.
-- Because events are zipped, the state is shown when you type.
machine :: Event Char -> Event (IO ())
machine event = action <$> zipE ("HOP", ()) (state event, atTimes [0..])
    where action (s, _) = print s

-- Event driver to generate Char event, and run IO event.
run :: (Event Char -> Event (IO ())) -> IO ()
run machine = do
  hSetBuffering stdin NoBuffering
  hSetBuffering stdout NoBuffering
  hSetEcho stdin False
  (sink, event) <- makeEvent =<< makeClock
  forkIO $ forever $ getChar >>= sink
  adaptE $ machine event

main :: IO ()
main = run machine

type.hs

-- Show as you type

import FRP.Reactive                ( Event )
import FRP.Reactive.LegacyAdapters ( makeClock, makeEvent, adaptE )
import Control.Applicative         ( (<$>) )
import Control.Concurrent          ( forkIO )
import Control.Monad               ( forever )
import System.IO                   ( stdout, stdin, hSetBuffering , BufferMode(NoBuffering) )

main :: IO ()
main = run machine

-- Accept a character event and print it.
machine :: Event Char -> Event (IO ())
machine event = showChar <$> event
    where showChar c = putStrLn (" You type " ++ show c)

-- Event driver to generate Char event, and run IO event.
run :: (Event Char -> Event (IO ())) -> IO ()
run machine = do
  hSetBuffering stdin NoBuffering
  hSetBuffering stdout NoBuffering
  (sink, event) <- makeEvent =<< makeClock
  forkIO $ forever $ getChar >>= sink
  adaptE $ machine event

typeClock.hs

-- Show as you type, or bang each two seconds.

import FRP.Reactive                ( Event, atTimes )
import FRP.Reactive.LegacyAdapters ( makeClock, makeEvent, adaptE )
import Control.Applicative         ( (<$>) )
import Control.Concurrent          ( forkIO )
import Control.Monad               ( forever )
import Data.Monoid                 ( mappend )
import System.IO                   ( stdout, stdin, hSetBuffering, hSetEcho , BufferMode(NoBuffering) )

main :: IO ()
main = run machine

-- merge two event handlers.
machine :: Event Char -> Event (IO ())
machine event = onType event `mappend` onClock

-- Show as you type.
onType :: Event Char -> Event (IO ())
onType event = (\c -> putStrLn (" You type " ++ show c)) <$> event

-- Show "bang" each two seconds.
onClock :: Event (IO ())
onClock = (\_ -> putStrLn "bang") <$> atTimes [0, 2..]

-- Event driver to generate Char event, and run IO event.
run :: (Event Char -> Event (IO ())) -> IO ()
run machine = do
  hSetBuffering stdin NoBuffering
  hSetBuffering stdout NoBuffering
  (sink, event) <- makeEvent =<< makeClock
  forkIO $ forever $ getChar >>= sink
  adaptE $ machine event