elereaのチュートリアルをeuphoriaで

EuphoriaTutorial.hs

module Main where

import Control.Arrow
import Control.Applicative
import Control.Monad
import Data.Maybe

import FRP.Euphoria.Collection
import FRP.Euphoria.Event
import FRP.Euphoria.Signal
import FRP.Elerea.Simple (stateful)

----------------------------------------------------------------------

main :: IO ()
main = do
    xs <- sigtest $ collectionToListSignal $
              timers [ (0, ("a", 3))
                     , (1, ("b", 5))
                     , (1, ("c", 3))
                     , (3, ("d", 4))
                     ]
    mapM_ print xs

sigtest :: SignalGen (Signal a) -> IO [a]
sigtest = replicateM 15 <=< start

collectionToListSignal :: SignalGen (Collection k a) -> SignalGen (Signal [a])
collectionToListSignal = discreteToSignal <=<
    fmap (fmap (map snd) . collectionToDiscreteList)

----------------------------------------------------------------------

timers :: [(Int, (String, Int))]
       -> SignalGen (Collection Int String)
timers = simpleCollection 0 <=< makeTimersE

makeTimersE :: [(Int, (String, Int))]
            -> SignalGen (Event (String, Event ()))
makeTimersE timerData = do
    countS <- stateful 0 (+1)
    let timerE = flattenE $ fmap occurencesAt $ eachStep countS
    generatorE $ setTimer <$> timerE
    where
        occurencesAt :: Int -> [(String, Int)]
        occurencesAt t = map snd $ filter (\(u, _) -> t == u) timerData

setTimer :: (String, Int) -> SignalGen (String, Event ())
setTimer (name, count) = do
    timer <- countdownE count
    return (name, timer)

countdownE :: Int -> SignalGen (Event ())
countdownE time = do
    timerS <- stateful (Just time) tick
    return $ const () <$> filterE isNothing (eachStep timerS)
    where
        tick prev = do
            t <- prev
            guard (t > 0)
            return (t - 1)

----------------------------------------------------------------------