haskellconcurrencyghcjs

How to execute an action periodically in a GHCJS program?


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


Solution

  • 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)