]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - src/RMCA/ReactiveValueAtomicUpdate.hs
Edit change log.
[tmp/julm/arpeggigon.git] / src / RMCA / ReactiveValueAtomicUpdate.hs
1 {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
2 {-# OPTIONS_GHC -fno-warn-orphans #-}
3
4 module RMCA.ReactiveValueAtomicUpdate where
5
6 import Control.Monad
7 import Data.CBRef
8 import Data.ReactiveValue
9
10 reactiveValueNonAtomicUpdate :: (ReactiveValueReadWrite a b m) =>
11 a -> (b -> b) -> m b
12 reactiveValueNonAtomicUpdate rv f = do
13 val <- reactiveValueRead rv
14 reactiveValueWrite rv $ f val
15 return val
16
17 class (ReactiveValueReadWrite a b m) => ReactiveValueAtomicUpdate a b m where
18 reactiveValueUpdate :: a -> (b -> b) -> m b
19
20 reactiveValueUpdate_ :: (ReactiveValueAtomicUpdate a b m) =>
21 a -> (b -> b) -> m ()
22 reactiveValueUpdate_ rv f = void $ reactiveValueUpdate rv f
23
24 reactiveValueAppend :: (Monoid b, ReactiveValueAtomicUpdate a b m) =>
25 a -> b -> m ()
26 reactiveValueAppend rv val = reactiveValueUpdate_ rv (`mappend` val)
27
28 reactiveValueEmpty :: (Monoid b, ReactiveValueAtomicUpdate a b m) =>
29 a -> m b
30 reactiveValueEmpty rv = reactiveValueUpdate rv (const mempty)
31
32 instance ReactiveValueRead (CBRef a) a IO where
33 reactiveValueRead = readCBRef
34 reactiveValueOnCanRead = installCallbackCBRef
35
36 instance ReactiveValueWrite (CBRef a) a IO where
37 reactiveValueWrite = writeCBRef
38
39 instance ReactiveValueReadWrite (CBRef a) a IO where
40
41 instance ReactiveValueAtomicUpdate (CBRef a) a IO where
42 reactiveValueUpdate rv f = atomicModifyCBRef rv (\x -> (f x, x))