@@ -0,0 +1,22 @@
1+module Reflex.Dom.Time where
2+
3+import Reflex
4+import Reflex.Dom.Class
5+
6+import Control.Concurrent
7+import Control.Monad
8+import Control.Monad.IO.Class
9+import Data.Fixed
10+import Data.Time.Clock
11+
12+-- | Send events over time with the given basis time and interval
13+-- If the system starts running behind, occurrences will be dropped rather than buffered
14+-- Each occurrence of the resulting event will contain the index of the current interval, with 0 representing the basis time
15+skippableIntervalsAround :: MonadWidget t m => UTCTime -> NominalDiffTime -> m (Event t Integer)
16+skippableIntervalsAround t0 dt = performEventAsync . fmap callAtNextInterval =<< getPostBuild
17+ where callAtNextInterval _ cb = void $ liftIO $ forkIO $ do
18+ t <- getCurrentTime
19+ let offset = t `diffUTCTime` t0
20+ (n, delay) = offset `divMod'` dt
21+ threadDelay $ ceiling $ delay * 1000000
22+ cb n