@@ -8,6 +8,7 @@ import Control.Monad
88import Control.Monad.IO.Class
99import Data.Fixed
1010import Data.Time.Clock
11+import System.Random
1112
1213data TickInfo
1314 = TickInfo { _tickInfo_lastUTC :: UTCTime
@@ -48,3 +49,45 @@ delay :: MonadWidget t m => NominalDiffTime -> Event t a -> m (Event t a)
4849delay dt e = performEventAsync $ ffor e $ \a cb -> liftIO $ void $ forkIO $ do
4950 threadDelay $ ceiling $ dt * 1000000
5051 cb a
52+
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
56+poissonLossyFrom
57+ :: (RandomGen g, MonadWidget t m)
58+ => g
59+ -> Double
60+ -- ^ Poisson event rate (Hz)
61+ -> UTCTime
62+ -- ^ Baseline time for events
63+ -> Event t a
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
71+ go lastGen cb = do
72+ t <- getCurrentTime
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
79+ go nextGen cb
80+
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
85+poissonLossy
86+ :: (RandomGen g, MonadWidget t m)
87+ => g
88+ -> Double
89+ -- ^ Poisson event rate (Hz)
90+ -> UTCTime
91+ -- ^ Baseline time for events
92+ -> m (Event t TickInfo)
93+poissonLossy rnd rate t0 = poissonLossyFrom rnd rate t0 =<< getPostBuild