My answer is not specific to GHCJS and has not been tested on GHCJS, only GHC, but it illustrates the problems with the naive OP solution . If you don't care about motivation, just go to my final runPeriodicallyConstantDrift solution below or the generalized versions at the very end.
The solution to the first straw and its problems
Here is my version of the OP solution, for comparison below:
import Control.Concurrent ( threadDelay ) import Control.Monad ( forever ) -- | Run @ action@ every @ period@ seconds. runPeriodicallyBigDrift :: Double -> IO () -> IO () runPeriodicallyBigDrift period action = forever $ do action threadDelay (round $ period * 10 ** 6)
Assuming that “execute an action periodically” means that the action runs every few seconds, the OP's solution is problematic because threadDelay does not take into account the time that the action itself takes. After n iterations, the start time of the action will be drifted, at least for the time taken to complete the action n times!
Second straw solution
So, if we really want to start a new action every period, we need to consider the time it takes to start. If the period is relatively large compared to the time required to create the stream, then this simple solution may work for you:
import Control.Concurrent ( threadDelay ) import Control.Concurrent.Async ( async, link ) import Control.Monad ( forever )
In my experiments (see below for more details) it takes about 0.001 second to create a stream on my system, so the drift for runPeriodicallySmallDrift after n iterations is about a thousandth of a second, which can be insignificant with some use of cases.
Final decision
Finally, if we really care about constant drift (i.e., the drift does not grow with the number of iterations of the periodic action, but is uniformly limited), then we can achieve this by instead tracking the absolute time:
import Control.Concurrent ( threadDelay ) import Data.Time.Clock.POSIX ( getPOSIXTime ) import Text.Printf ( printf ) -- | Run @ action@ every @ period@ seconds. runPeriodicallyConstantDrift :: Double -> IO () -> IO () runPeriodicallyConstantDrift period action = do start <- getPOSIXTime go start 1 where go start iteration = do action now <- getPOSIXTime let elapsed = realToFrac $ now - start let target = iteration * period let delay = target - elapsed -- Fail loudly if the action takes longer than one period. For -- some use cases it may be OK for the action to take longer -- than one period, in which case remove this check. when (delay < 0 ) $ do let msg = printf "runPeriodically: action took longer than one period: delay = %f, target = %f, elapsed = %f" delay target elapsed error msg threadDelay (round $ delay * microsecondsInSecond) go start (iteration + 1) microsecondsInSecond = 10 ** 6
Comparison of solutions through testing
To compare these solutions, we create an action that tracks its own drift and informs us and runs it in each of the above runPeriodically* implementations:
import Control.Concurrent ( threadDelay ) import Data.IORef ( newIORef, readIORef, writeIORef ) import Data.Time.Clock.POSIX ( getPOSIXTime ) import Text.Printf ( printf ) -- | Use a @ runPeriodically@ implementation to run an action -- periodically with period @ period@. The action takes -- (approximately) @ runtime@ seconds to run. testRunPeriodically :: (Double -> IO () -> IO ()) -> Double -> Double -> IO () testRunPeriodically runPeriodically runtime period = do iterationRef <- newIORef 0 start <- getPOSIXTime startRef <- newIORef start runPeriodically period $ action startRef iterationRef where action startRef iterationRef = do now <- getPOSIXTime start <- readIORef startRef iteration <- readIORef iterationRef writeIORef iterationRef (iteration + 1) let drift = (iteration * period) - (realToFrac $ now - start) printf "test: iteration = %.0f, drift = %f\n" iteration drift threadDelay (round $ runtime * 10**6)
Here are the test results. In each case, check the action that takes 0.05 seconds, and use the period twice, i.e. 0.1 seconds.
For runPeriodicallyBigDrift drift after n iterations is approximately n times longer than the execution time of one iteration, as expected. After 100 iterations, the drift is -5.15, and the predicted drift immediately from the execution time is -5.00:
ghci> testRunPeriodically runPeriodicallyBigDrift 0.05 0.1 ... test: iteration = 98, drift = -5.045410253 test: iteration = 99, drift = -5.096661091 test: iteration = 100, drift = -5.148137684 test: iteration = 101, drift = -5.199764033999999 test: iteration = 102, drift = -5.250980596 ...
For runPeriodicallySmallDrift drift after n iterations is about 0.001 seconds, presumably the time it takes to create a thread on my system:
ghci> testRunPeriodically runPeriodicallySmallDrift 0.05 0.1 ... test: iteration = 98, drift = -0.08820333399999924 test: iteration = 99, drift = -0.08908210599999933 test: iteration = 100, drift = -0.09006684400000076 test: iteration = 101, drift = -0.09110764399999915 test: iteration = 102, drift = -0.09227584299999947 ...
With runPeriodicallyConstantDrift drift remains constant (plus noise) for about 0.001 seconds:
ghci> testRunPeriodically runPeriodicallyConstantDrift 0.05 0.1 ... test: iteration = 98, drift = -0.0009586619999986112 test: iteration = 99, drift = -0.0011010979999994674 test: iteration = 100, drift = -0.0011610369999992542 test: iteration = 101, drift = -0.0004908619999977049 test: iteration = 102, drift = -0.0009897379999994627 ...
If we cared about this level of constant drift, a more sophisticated solution could track the average constant drift and adjust it.
Generalization for states of periodic cycles
In practice, I realized that some of my loops have a state that goes from one iteration to the next. Here's a small generalization of runPeriodicallyConstantDrift to support this:
import Control.Concurrent ( threadDelay ) import Data.IORef ( newIORef, readIORef, writeIORef ) import Data.Time.Clock.POSIX ( getPOSIXTime ) import Text.Printf ( printf ) -- | Run a stateful @ action@ every @ period@ seconds. -- -- Achieves uniformly bounded drift (ie independent of the number of -- iterations of the action) of about 0.001 seconds, runPeriodicallyWithState :: Double -> st -> (st -> IO st) -> IO () runPeriodicallyWithState period st0 action = do start <- getPOSIXTime go start 1 st0 where go start iteration st = do st' <- action st now <- getPOSIXTime let elapsed = realToFrac $ now - start let target = iteration * period let delay = target - elapsed -- Warn if the action takes longer than one period. Originally I -- was failing in this case, but in my use case we sometimes, -- but very infrequently, take longer than the period, and I -- don't actually want to crash in that case. when (delay < 0 ) $ do printf "WARNING: runPeriodically: action took longer than one period: delay = %f, target = %f, elapsed = %f" delay target elapsed threadDelay (round $ delay * microsecondsInSecond) go start (iteration + 1) st' microsecondsInSecond = 10 ** 6 -- | Run a stateless @ action@ every @ period@ seconds. -- -- Achieves uniformly bounded drift (ie independent of the number of -- iterations of the action) of about 0.001 seconds, runPeriodically :: Double -> IO () -> IO () runPeriodically period action = runPeriodicallyWithState period () (const action)