module System.Hardware.Acquisition.Adaptor.Continuous
( adaptor
) where
import Prelude
import Control.Monad.Error
import Control.Concurrent
import Control.Concurrent.STM
import Data.Foldable
import Data.Traversable
import System.Hardware.Acquisition as Acquisition
type Concrete = Either String Sample
adaptor :: MonadIO m => Adaptor m
adaptor c = liftIO $ do
sv <- atomically (newTVar Nothing)
tid <- forkOS . forever $ do
s <- runErrorT (getSample c) :: IO Concrete
atomically (writeTVar sv (Just s))
let getSample :: (Error e, MonadError e m, MonadIO m) => m Sample
getSample = do
c <- liftIO . atomically $ do
ms <- readTVar sv
case ms of
Just s -> return s
Nothing -> retry
case c of
Left e -> throwError (strMsg e)
Right s -> return s
let close :: MonadIO m => m ()
close = liftIO (killThread tid)
return Channel {..}