src/RMCA/ReactiveValueAtomicUpdate.hs

   1 {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
   2
   3 module RMCA.ReactiveValueAtomicUpdate where
   4
   5 import Control.Monad
   6 import Data.CBRef
   7 import Data.ReactiveValue
   8
   9 reactiveValueNonAtomicUpdate :: (ReactiveValueReadWrite a b m) =>
  10                                 a -> (b -> b) -> m b
  11 reactiveValueNonAtomicUpdate rv f = do
  12   val <- reactiveValueRead rv
  13   reactiveValueWrite rv $ f val
  14   return val
  15
  16 class (ReactiveValueReadWrite a b m) => ReactiveValueAtomicUpdate a b m where
  17   reactiveValueUpdate :: a -> (b -> b) -> m b
  18
  19 reactiveValueAppend :: (Monoid b, ReactiveValueAtomicUpdate a b m) =>
  20                        a -> b -> m ()
  21 reactiveValueAppend rv val = void $ reactiveValueUpdate rv (`mappend` val)
  22
  23 reactiveValueEmpty :: (Monoid b, ReactiveValueAtomicUpdate a b m) =>
  24                       a -> m b
  25 reactiveValueEmpty rv = reactiveValueUpdate rv (const mempty)
  26
  27 instance ReactiveValueRead (CBRef a) a IO where
  28   reactiveValueRead = readCBRef
  29   reactiveValueOnCanRead = installCallbackCBRef
  30
  31 instance ReactiveValueWrite (CBRef a) a IO where
  32   reactiveValueWrite = writeCBRef
  33
  34 instance ReactiveValueReadWrite (CBRef a) a IO where
  35
  36 instance ReactiveValueAtomicUpdate (CBRef a) a IO where
  37   reactiveValueUpdate rv f = atomicModifyCBRef rv (\x -> (f x, x))