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 import Control.Monad
   9
  10 newCBMVarRW :: forall a. a -> IO (ReactiveFieldReadWrite IO a)
  11 newCBMVarRW val = do
  12   mvar <- newCBMVar val
  13   let getter :: IO a
  14       getter = readCBMVar mvar
  15       setter :: a -> IO ()
  16       setter = writeCBMVar mvar
  17       notifier :: IO () -> IO ()
  18       notifier = installCallbackCBMVar mvar
  19   return $ ReactiveFieldReadWrite setter getter notifier
  20
  21 emptyRW :: (Monoid b, ReactiveValueReadWrite a b m) => a -> m b
  22 emptyRW rv = do
  23   val <- reactiveValueRead rv
  24   reactiveValueWrite rv mempty
  25   return val
  26
  27 emptyW :: (Monoid b, ReactiveValueWrite a b m) => a -> m ()
  28 emptyW rv = reactiveValueWrite rv mempty
  29
  30 (^:>) :: (ReactiveValueRead a b m, ReactiveValueReadWrite c d m) =>
  31          a -> c -> m ()
  32 notif ^:> rv = reactiveValueOnCanRead notif resync
  33   where resync = reactiveValueRead rv >>= reactiveValueWrite rv
  34
  35 -- Update when the value is an Event. It would be nice to have that
  36 -- even for Maybe as well.
  37 (>:>) :: (ReactiveValueRead a (Event b) m, ReactiveValueWrite c b m) =>
  38          a -> c -> m ()
  39 eventRV >:> rv = reactiveValueOnCanRead eventRV syncOnEvent
  40   where  syncOnEvent = do
  41            erv <- reactiveValueRead eventRV
  42            when (isEvent erv) $ reactiveValueWrite rv $ fromEvent erv