RMCA/Auxiliary/RV.hs

   1 {-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-}
   2
   3 module RMCA.Auxiliary.RV where
   4
   5 import Data.CBMVar
   6 import Data.ReactiveValue
   7 import FRP.Yampa
   8
   9 newCBMVarRW :: forall a. a -> IO (ReactiveFieldReadWrite IO a)
  10 newCBMVarRW val = do
  11   mvar <- newCBMVar val
  12   let getter :: IO a
  13       getter = readCBMVar mvar
  14       setter :: a -> IO ()
  15       setter = writeCBMVar mvar
  16       notifier :: IO () -> IO ()
  17       notifier = installCallbackCBMVar mvar
  18   return $ ReactiveFieldReadWrite setter getter notifier
  19
  20 emptyRW :: (Monoid b, ReactiveValueReadWrite a b m) => a -> m b
  21 emptyRW rv = do
  22   val <- reactiveValueRead rv
  23   reactiveValueWrite rv mempty
  24   return val
  25
  26 emptyW :: (Monoid b, ReactiveValueWrite a b m) => a -> m ()
  27 emptyW rv = reactiveValueWrite rv mempty
  28
  29 (^:>) :: (ReactiveValueRead a b m, ReactiveValueReadWrite c d m) =>
  30          a -> c -> m ()
  31 notif ^:> rv = reactiveValueOnCanRead notif resync
  32   where resync = reactiveValueRead rv >>= reactiveValueWrite rv
  33
  34 -- Update when the value is an Event. It would be nice to have that
  35 -- even for Maybe as well.
  36 (>:>) :: (ReactiveValueRead a (Event b) m, ReactiveValueWrite c b m) =>
  37          a -> c -> m ()
  38 eventRV >:> rv = reactiveValueOnCanRead eventRV syncOnEvent
  39   where  syncOnEvent = reactiveValueRead eventRV >>=
  40                        (\erv -> if isNoEvent erv then return ()
  41                                 else reactiveValueWrite rv $ fromEvent erv)