reactive fizz-buzz
В процессе "поиска пространственно-временной утечки" спустился до уровня Reactive.FRP и вот такой артефакт остался:
{-# LANGUAGE BangPatterns, FlexibleInstances, TypeSynonymInstances #-}
{-# OPTIONS_GHC -Wall #-}
import Control.Monad
import Control.Concurrent (threadDelay)
import System.IO
import Data.AddBounds
import Data.Max
import Data.Monoid
import FRP.Reactive.Improving
import FRP.Reactive
import FRP.Reactive.Internal.Reactive
import FRP.Reactive.Internal.Future
import FRP.Reactive.Internal.Clock
-- rendered from FRP.Reactive.Internal.Timing
class Syncable a where
syncIO :: IO TimeT -> a -> IO ()
instance Syncable TimeT where
syncIO getT target = do
now <- getT
let sleep = threadDelay . ceiling . (1.0e6 *)
unless (now > target) $ sleep (target - now) -- >> loop
instance Syncable (AddBounds TimeT) where
syncIO _ MinBound = return ()
syncIO getT (NoBound target) = syncIO getT target
syncIO _ MaxBound = error "syncIO MaxBound. Expected??"
instance Syncable t => Syncable (Improving t) where
syncIO getT (Imp { exact = target }) = syncIO getT target
instance Syncable t => Syncable (Time t) where
syncIO getT (Max target) = syncIO getT target
runBeatsWith :: (a -> b -> a) -> a -> Event (IO b) -> IO a
runBeatsWith f s0 e = do
clock <- makeClock
let getT = cGetTime clock
let walk s [] = return s
walk s ((Future (t, io)):xs) = do
syncIO getT t
x <- io
walk (f s x) xs
walk s0 (eFutures e)
runBeats :: Event (IO a) -> IO ()
runBeats = runBeatsWith const ()
main :: IO ()
main = runBeats beats where
fizz = do
atTimes [0,0.3..]
return (putStr "fizz")
buzz = do
atTimes [0.01,0.51..]
return (putStr "buzz")
eol = do
atTimes [0.02,0.12..]
return (putStrLn "")
beats = fizz `mappend` buzz `mappend` eol