-- |
--
-- Copyright   : (C) Keera Studios Ltd, 2015
-- License     : BSD3
-- Maintainer  : support@keera.co.uk
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

  -- RV fields
  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