module Hails.Polling where
import Control.Concurrent (forkIO, threadDelay)
import Control.Monad (forever, void)
import Data.CBMVar
import Data.ReactiveValue
pollingReactive :: IO a
-> Maybe Int
-> IO (ReactiveFieldRead IO a)
pollingReactive :: IO a -> Maybe Int -> IO (ReactiveFieldRead IO a)
pollingReactive IO a
sensor Maybe Int
delay = do
a
initialV <- IO a
sensor
CBMVar a
mvar <- a -> IO (CBMVar a)
forall a. a -> IO (CBMVar a)
newCBMVar a
initialV
IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do a
v <- IO a
sensor
CBMVar a -> a -> IO ()
forall a. CBMVar a -> a -> IO ()
writeCBMVar CBMVar a
mvar a
v
IO () -> (Int -> IO ()) -> Maybe Int -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> (Int -> IO ()) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO ()
threadDelay) Maybe Int
delay
let getter :: IO a
getter = CBMVar a -> IO a
forall a. CBMVar a -> IO a
readCBMVar CBMVar a
mvar
notifier :: IO () -> IO ()
notifier = CBMVar a -> IO () -> IO ()
forall a. CBMVar a -> IO () -> IO ()
installCallbackCBMVar CBMVar a
mvar
ReactiveFieldRead IO a -> IO (ReactiveFieldRead IO a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ReactiveFieldRead IO a -> IO (ReactiveFieldRead IO a))
-> ReactiveFieldRead IO a -> IO (ReactiveFieldRead IO a)
forall a b. (a -> b) -> a -> b
$ IO a -> (IO () -> IO ()) -> ReactiveFieldRead IO a
forall (m :: * -> *) a.
FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
ReactiveFieldRead IO a
getter IO () -> IO ()
notifier