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 class (ReactiveValueReadWrite a b m) => ReactiveValueAtomicUpdate a b m where
  10   reactiveValueUpdate :: a -> (b -> b) -> m b
  11
  12 reactiveValueAppend :: (Monoid b, ReactiveValueAtomicUpdate a b m) =>
  13                        a -> b -> m ()
  14 reactiveValueAppend rv val = void $ reactiveValueUpdate rv (`mappend` val)
  15
  16 reactiveValueEmpty :: (Monoid b, ReactiveValueAtomicUpdate a b m) =>
  17                       a -> m b
  18 reactiveValueEmpty rv = reactiveValueUpdate rv (\_ -> mempty)
  19
  20 instance ReactiveValueRead (CBRef a) a IO where
  21   reactiveValueRead = readCBRef
  22   reactiveValueOnCanRead = installCallbackCBRef
  23
  24 instance ReactiveValueWrite (CBRef a) a IO where
  25   reactiveValueWrite = writeCBRef
  26
  27 instance ReactiveValueReadWrite (CBRef a) a IO where
  28
  29 instance ReactiveValueAtomicUpdate (CBRef a) a IO where
  30   reactiveValueUpdate rv f = atomicModifyCBRef rv (\x -> (f x, x))