eade9ef · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Use unbounded-delays to fix Int overflow bug when delaying threads.

eade9efSid Raval10 years ago

default.nix+2

compare with develop

unifiedsplit

@@ -4,6 +4,7 @@

4, ghc, webkitgtk3-javascriptcore, exception-transformers

5, webkitgtk24x, dependent-sum-template, bifunctors, bimap

6, raw-strings-qq, zenc, random, monad-control, keycode, hlint

7+, unbounded-delays

7}:

8}:

9mkDerivation {

10mkDerivation {

@@ -32,6 +33,7 @@ mkDerivation {

32 these

33 these

33 transformers

34 transformers

34 zenc

35 zenc

36+ unbounded-delays

35 ] ++ (if ghc.isGhcjs or false then [] else [

37 ] ++ (if ghc.isGhcjs or false then [] else [

36 raw-strings-qq

38 raw-strings-qq

37 webkitgtk3-javascriptcore

39 webkitgtk3-javascriptcore

reflex-dom.cabal+2−1

@@ -51,7 +51,8 @@ library

51 bifunctors >= 4.2 && < 6,

52 bimap >= 0.3 && < 0.4,

53 monad-control >= 1.0.1 && < 1.1,

54− keycode == 0.2.*

54+ keycode == 0.2.*,

55+ unbounded-delays == 0.1.0.9

56 if impl(ghcjs)

57 if impl(ghcjs)

57 hs-source-dirs: src-ghcjs

58 hs-source-dirs: src-ghcjs

src/Reflex/Dom/Time.hs+4−3

@@ -11,6 +11,7 @@ import Reflex.Dom.PerformEvent.Class

11import Reflex.Dom.PostBuild.Class

13import Control.Concurrent

14+import qualified Control.Concurrent.Thread.Delay as Concurrent

14import Control.Monad

15import Control.Monad

15import Control.Monad.Fix

16import Control.Monad.Fix

16import Control.Monad.IO.Class

17import Control.Monad.IO.Class

@@ -51,7 +52,7 @@ tickLossyFrom dt t0 e = do

51 return result

52 return result

52 where callAtNextInterval _ cb = void $ liftIO $ forkIO $ do

53 where callAtNextInterval _ cb = void $ liftIO $ forkIO $ do

53 tick <- getCurrentTick dt t0

54 tick <- getCurrentTick dt t0

54− threadDelay $ ceiling $ (dt - _tickInfo_alreadyElapsed tick) * 1000000

55+ Concurrent.delay $ ceiling $ (dt - _tickInfo_alreadyElapsed tick) * 1000000

55 cb tick

56 cb tick

57clockLossy :: (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)

58clockLossy :: (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)

@@ -70,7 +71,7 @@ getCurrentTick dt t0 = do

70-- | Delay an Event's occurrences by a given amount in seconds.

71-- | Delay an Event's occurrences by a given amount in seconds.

71delay :: (PerformEvent t m, TriggerEvent t m, MonadIO (Performable m)) => NominalDiffTime -> Event t a -> m (Event t a)

72delay :: (PerformEvent t m, TriggerEvent t m, MonadIO (Performable m)) => NominalDiffTime -> Event t a -> m (Event t a)

72delay dt e = performEventAsync $ ffor e $ \a cb -> liftIO $ void $ forkIO $ do

73delay dt e = performEventAsync $ ffor e $ \a cb -> liftIO $ void $ forkIO $ do

73− threadDelay $ ceiling $ dt * 1000000

74+ Concurrent.delay $ ceiling $ dt * 1000000

74 cb a

75 cb a

76-- | Send events with Poisson timing with the given basis and rate

77-- | Send events with Poisson timing with the given basis and rate

@@ -157,7 +158,7 @@ inhomogeneousPoissonFrom rnd rate maxRate t0 e = do

157 alreadyElapsed = diffUTCTime t tTargetLast

158 alreadyElapsed = diffUTCTime t tTargetLast

158 tTarget = addUTCTime dt tTargetLast

159 tTarget = addUTCTime dt tTargetLast

159 thisDelay = realToFrac $ diffUTCTime tTarget t :: Double

160 thisDelay = realToFrac $ diffUTCTime tTarget t :: Double

160− threadDelay $ ceiling $ thisDelay * 1000000

161+ Concurrent.delay $ ceiling $ thisDelay * 1000000

161 _ <- cb (TickInfo t nEvents alreadyElapsed, p)

162 _ <- cb (TickInfo t nEvents alreadyElapsed, p)

162 go tTarget nextGen' cb nEvents

163 go tTarget nextGen' cb nEvents

163

164