module System.Hardware.Acquisition.Adaptor.RateLimit
( adaptor
) where
import Prelude
import Control.Applicative
import Control.Monad.Error
import Control.Concurrent
import Data.Traversable
import Data.IORef
import Data.Time
import System.Hardware.Acquisition as Acquisition
adaptor
:: MonadIO m
=> NominalDiffTime
-> Adaptor m
adaptor period c = liftIO $ do
timestamp <- getCurrentTime >>= newIORef
let busyPeriod = 0.1
let getSample :: (Error e, MonadError e m, MonadIO m) => m Sample
getSample = do liftIO wait; Acquisition.getSample c where
wait :: IO ()
wait = do
ts <- readIORef timestamp
let target = addUTCTime period ts
let lazyTarget = addUTCTime (negate busyPeriod) target
let spinUntil time delayAction = do
let spin = do
now <- getCurrentTime
case now < time of
True -> do delayAction; spin
False -> return ()
spin
spinUntil lazyTarget $ do
now <- getCurrentTime
threadDelay . floor . (* 1000000) $
diffUTCTime lazyTarget now
spinUntil target yield
writeIORef timestamp target
let close :: MonadIO m => m ()
close = return ()
return Channel {..}