How to execute an action periodically in a GHCJS program? - haskell

Question

Should one use setInterval via Javascript, or use some more idiomatic solution based on threads?

Answer 1

Using setInterval posed some challenges and comments from Alexander, Erik and Luite himself led me to try threads. This worked seamlessly, with very clean code similar to the following:
import Control.Concurrent( forkIO, threadDelay )
import Control.Monad( forever )
... within an IO block
threadId <- forkIO $ forever $ do
threadDelay (60 * 1000 * 1000) -- one minute in microseconds, not milliseconds like in Javascript!
doWhateverYouLikeHere
Haskell has the concept of lightweight threads so this is the idiomatic Haskell way to run an action in an asynchronous way as you would do with a Javascript setInterval or setTimeout.
Hackage
Real world Haskell

Answer 2

If you don't care about the motivation, just scroll to my best solution runPeriodicallyConstantDrift below. If you prefer a simpler solution with worse results, then see runPeriodicallySmallDrift.
My answer is not GHCJS specific, and has not been tested on GHCJS, only GHC, but it illustrates problems with the OP's naive solution.
First Strawman Solution: runPeriodicallyBigDrift
Here's my version of the OP's 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 "execute an action periodically" means the action starts every period many seconds, the OP's solution is problematic because the threadDelay doesn't take into account the time the action itself takes. After n iterations, the start time of the action will have drifted by at least the time it takes to run the action n times!
Second Strawman Solution: runPeriodicallySmallDrift
So, we if we actually want to start a new action every period, we need to take into account the time it takes the action to run. If the period is relatively large compared to the time it takes to spawn a thread, then this simple solution may work for you:
import Control.Concurrent ( threadDelay )
import Control.Concurrent.Async ( async, link )
import Control.Monad ( forever )
-- | Run #action# every #period# seconds.
runPeriodicallySmallDrift :: Double -> IO () -> IO ()
runPeriodicallySmallDrift period action = forever $ do
-- We reraise any errors raised by the action, but
-- we don't check that the action actually finished within one
-- period. If the action takes longer than one period, then
-- multiple actions will run concurrently.
link =<< async action
threadDelay (round $ period * 10 ** 6)
In my experiments (more details below), it takes about 0.001 seconds to spawn a thread on my system, so the drift for runPeriodicallySmallDrift after n iterations is about n thousandths of a second, which may be negligible in some use cases.
Final Solution: runPeriodicallyConstantDrift
Finally, suppose we require only constant drift, meaning the drift is always less than some constant, and does not grow with the number of iterations of the periodic action. We can achieve constant drift by keeping track of the total time since we started, and starting the nth iteration when the total time is n times the period:
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
-- Current time.
let elapsed = realToFrac $ now - start
-- Time at which to run action again.
let target = iteration * period
-- How long until target time.
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
Based on experiments below, the drift is always about 1/1000th of a second, independent of the number of iterations of the action.
Comparison Of Solutions By Testing
To compare these solutions, we create an action that keeps track of its own drift and tells us, and run it in each of the runPeriodically* implementations above:
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 test an action that runs for 0.05 seconds, and use a period of twice that, i.e. 0.1 seconds.
For runPeriodicallyBigDrift, the drift after n iterations is about n times the runtime of a single iteration, as expected. After 100 iterations the drift is -5.15, and the predicted drift just from runtime of the action 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, the drift after n iterations is about 0.001 seconds, presumably the time it takes to spawn 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
...
For runPeriodicallyConstantDrift, the drift remains constant (plus noise) at 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 that level of constant drift, then a more sophisticiated solution could track the average constant drift and adjust for it.
Generalization To Stateful Periodic Loops
In practice I realized that some of my loops have state that passes from one iteration to the next. Here's a slight generalization of runPeriodicallyConstantDrift to support that:
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 (i.e. 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 (i.e. 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)