Add atomically updatable RVs.

diff --git a/src/RMCA/ReactiveValueAtomicUpdate.hs b/src/RMCA/ReactiveValueAtomicUpdate.hs
new file mode 100644 (file)
index 0000000..1e31676
--- /dev/null
+++ b/src/RMCA/ReactiveValueAtomicUpdate.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+
+module RMCA.ReactiveValueAtomicUpdate where
+
+import Control.Monad
+import Data.CBRef
+import Data.ReactiveValue
+
+class (ReactiveValueReadWrite a b m) => ReactiveValueAtomicUpdate a b m where
+  reactiveValueUpdate :: a -> (b -> b) -> m b
+
+reactiveValueAppend :: (Monoid b, ReactiveValueAtomicUpdate a b m) =>
+                       a -> b -> m ()
+reactiveValueAppend rv val = void $ reactiveValueUpdate rv (`mappend` val)
+
+reactiveValueEmpty :: (Monoid b, ReactiveValueAtomicUpdate a b m) =>
+                      a -> m b
+reactiveValueEmpty rv = reactiveValueUpdate rv (\_ -> mempty)
+
+instance ReactiveValueRead (CBRef a) a IO where
+  reactiveValueRead = readCBRef
+  reactiveValueOnCanRead = installCallbackCBRef
+
+instance ReactiveValueWrite (CBRef a) a IO where
+  reactiveValueWrite = writeCBRef
+
+instance ReactiveValueReadWrite (CBRef a) a IO where
+
+instance ReactiveValueAtomicUpdate (CBRef a) a IO where
+  reactiveValueUpdate rv f = atomicModifyCBRef rv (\x -> (f x, x))