@@ -1,4 +1,4 @@
1−{-# LANGUAGE DeriveDataTypeable, TypeFamilies, ScopedTypeVariables, FlexibleContexts #-}
1+{-# LANGUAGE DeriveDataTypeable, TypeFamilies, ScopedTypeVariables, FlexibleContexts, RecursiveDo #-}
22module Reflex.Dom.Time where
33
44import Reflex
@@ -26,14 +26,14 @@ data TickInfo
2626
2727-- | Special case of tickLossyFrom that uses the post-build event to start the
2828-- tick thread.
29−tickLossy :: (PostBuild t m, PerformEvent t m, TriggerEvent t m, MonadIO (Performable m)) => NominalDiffTime -> UTCTime -> m (Event t TickInfo)
29+tickLossy :: (PostBuild t m, PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), MonadFix m) => NominalDiffTime -> UTCTime -> m (Event t TickInfo)
3030tickLossy dt t0 = tickLossyFrom dt t0 =<< getPostBuild
3131
3232-- | Send events over time with the given basis time and interval
3333-- If the system starts running behind, occurrences will be dropped rather than buffered
3434-- Each occurrence of the resulting event will contain the index of the current interval, with 0 representing the basis time
3535tickLossyFrom
36− :: (PerformEvent t m, TriggerEvent t m, MonadIO (Performable m))
36+ :: (PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), MonadFix m)
3737 => NominalDiffTime
3838 -> UTCTime
3939 -> Event t a
@@ -41,13 +41,15 @@ tickLossyFrom
4141 -- be something like the result of getPostBuild that only fires once. But
4242 -- there could be uses for starting multiple timer threads.
4343 -> m (Event t TickInfo)
44−tickLossyFrom dt t0 e = performEventAsync $ fmap callAtNextInterval e
45− where callAtNextInterval _ cb = void $ liftIO $ forkIO $ forever $ do
44+tickLossyFrom dt t0 e = do
45+ rec result <- performEventAsync $ fmap callAtNextInterval $ leftmost [() <$ e, () <$ result]
46+ return result
47+ where callAtNextInterval _ cb = void $ liftIO $ forkIO $ do
4648 tick <- getCurrentTick dt t0
4749 threadDelay $ ceiling $ (dt - _tickInfo_alreadyElapsed tick) * 1000000
4850 cb tick
4951
50−clockLossy :: (MonadIO m, PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), PostBuild t m, MonadHold t m) => NominalDiffTime -> UTCTime -> m (Dynamic t TickInfo)
52+clockLossy :: (MonadIO m, PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), PostBuild t m, MonadHold t m, MonadFix m) => NominalDiffTime -> UTCTime -> m (Dynamic t TickInfo)
5153clockLossy dt t0 = do
5254 initial <- liftIO $ getCurrentTick dt t0
5355 e <- tickLossy dt t0