{-# 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))