module Reflex.Dom.Time where
import Reflex
import Reflex.Dom.Class
import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class
import Data.Fixed
import Data.Time.Clock
data TickInfo
= TickInfo { _tickInfo_lastUTC :: UTCTime
, _tickInfo_n :: Integer
, _tickInfo_alreadyElapsed :: NominalDiffTime
}
deriving (Eq)
tickLossy :: MonadWidget t m => NominalDiffTime -> UTCTime -> m (Event t TickInfo)
tickLossy dt t0 = tickLossyFrom dt t0 =<< getPostBuild
tickLossyFrom
:: MonadWidget t m
=> NominalDiffTime
-> UTCTime
-> Event t a
-> m (Event t TickInfo)
tickLossyFrom dt t0 e = performEventAsync $ fmap callAtNextInterval e
where callAtNextInterval _ cb = void $ liftIO $ forkIO $ forever $ do
t <- getCurrentTime
let offset = t `diffUTCTime` t0
(n, alreadyElapsed) = offset `divMod'` dt
threadDelay $ ceiling $ (dt alreadyElapsed) * 1000000
cb $ TickInfo t n alreadyElapsed
delay :: MonadWidget t m => NominalDiffTime -> Event t a -> m (Event t a)
delay dt e = performEventAsync $ ffor e $ \a cb -> liftIO $ void $ forkIO $ do
threadDelay $ ceiling $ dt * 1000000
cb a