@@ -8,6 +8,7 @@ import Control.Monad
8import Control.Monad.IO.Class
8import Control.Monad.IO.Class
9import Data.Fixed
9import Data.Fixed
10import Data.Time.Clock
10import Data.Time.Clock
12data TickInfo
13data TickInfo
13 = TickInfo { _tickInfo_lastUTC :: UTCTime
14 = TickInfo { _tickInfo_lastUTC :: UTCTime
@@ -48,3 +49,45 @@ delay :: MonadWidget t m => NominalDiffTime -> Event t a -> m (Event t a)
48delay dt e = performEventAsync $ ffor e $ \a cb -> liftIO $ void $ forkIO $ do
49delay dt e = performEventAsync $ ffor e $ \a cb -> liftIO $ void $ forkIO $ do
49 threadDelay $ ceiling $ dt * 1000000
50 threadDelay $ ceiling $ dt * 1000000
53+-- | Send events with Poisson timing with the given basis and rate
54+-- Each occurence of the resulting event will contain the index of
55+-- the current interval, with 0 representing the basis time
57+ :: (RandomGen g, MonadWidget t m)
60+ -- ^ Poisson event rate (Hz)
62+ -- ^ Baseline time for events
64+ -- ^ Event that starts a tick generation thread. Usually you want this to
65+ -- be something like the result of getPostBuild that only fires once. But
66+ -- there could be uses for starting multiple timer threads.
67+ -- Start sending events in response to the event parameter.
68+ -> m (Event t TickInfo)
69+poissonLossyFrom rnd rate t0 e = performEventAsync $ fmap callAtNextInterval e
70+ where callAtNextInterval _ cb = void $ liftIO $ forkIO $ forever $ go rnd cb
73+ let (u, nextGen) = randomR (0,1) lastGen
74+ dt = realToFrac $ -1 * log(u)/rate :: NominalDiffTime
75+ offset = t `diffUTCTime` t0
76+ (n, alreadyElapsed) = offset `divMod'` dt
77+ threadDelay $ ceiling $ (dt - alreadyElapsed) * 1000000
78+ void $ cb $ TickInfo t n alreadyElapsed
81+-- | Send events with Poisson timing with the given basis and rate
82+-- Each occurence of the resulting event will contain the index of
83+-- the current interval, with 0 representing the basis time.
84+-- Automatically begin sending events when the DOM is built
86+ :: (RandomGen g, MonadWidget t m)
89+ -- ^ Poisson event rate (Hz)
91+ -- ^ Baseline time for events
92+ -> m (Event t TickInfo)
93+poissonLossy rnd rate t0 = poissonLossyFrom rnd rate t0 =<< getPostBuild