Haskell function to repeat an IO action repeatedly, analogous to javascript's setInterval, with the addition of receiving a time delta. Personally used for a game server's main tick-loop.

recurseInterval.hs

import Data.Time.Clock.POSIX (getPOSIXTime) -- from `time` package.
import Control.Concurrent (threadDelay)

{- | Repeats IO action repeatedly on single thread, taking action running-time into account when waiting for next repetition.

__Examples__:

@
secondsToMicros = (*) (10 ^ 6)
millisToMicros = (*) (10 ^ 3)

recurseInterval
  (secondsToMicros 1)
  (\exc -> putStrLn $ "action took to long! exceeded by " <> show exc <> " micros!")
  (\delta i -> putStrLn ("iteration " <> show i <> " delta is " <> show delta) >> threadDelay (millisToMicros 500) >> return (i + 1))
  0
@
-}
recurseInterval
  :: Int                -- ^ the interval to repeat the action, in microseconds.
  -> (Int -> IO ())     -- ^ in case the repeated action takes longer than the interval, this function receives the exceeded time in microseconds.
  -> (Int -> a -> IO a) -- ^ the IO action to repeat.
                        --   It receives the time it took for the last repition in microseconds.
                        --   The first repition receives the interval as argument.
                        --   Further repitions time-delta is slightly higher though, as imposed by threadDelay.
  -> a                  -- ^ the initial argument to invoke the function with.
  -> IO ()              -- ^ loop indefinitely. Exceptions raised by either provided actions are bubbled.
recurseInterval intv0 exceeded0 act0 a0 = currentTimeMicros >>= \t -> go intv0 t intv0 exceeded0 act0 a0
 where
  go :: Int -> Int -> Int -> (Int -> IO ()) -> (Int -> a -> IO a) -> a -> IO ()
  go prevDelta before intv exceeded act a = do
    a'    <- act prevDelta a
    after <- currentTimeMicros
    let offset = intv - (after - before)
    if offset < 0 then exceeded (abs offset) else threadDelay offset
    now <- currentTimeMicros
    go (now - before) now intv exceeded act a'

  currentTimeMicros :: IO Int
  currentTimeMicros = round . (*) (10 ^ 6) <$> getPOSIXTime