{-# LANGUAGE RecordWildCards #-}

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

{-|
	Limits invocations of 'getSample' to once every @n@ seconds. Blocks if
	called more frequently.
-}
adaptor
	:: MonadIO m
	=> NominalDiffTime {-^ minimum interval between successive calls to getSample -}
	-> Adaptor m
adaptor period c = liftIO $ do

	timestamp <- getCurrentTime >>= newIORef

	let busyPeriod = 0.1 -- seconds to spend busy-spinning
	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 {..}