How to execute an action periodically in a GHCJS program?

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)