]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - src/RMCA/ReactiveValueAtomicUpdate.hs
MIDI influences the GUI back.
[tmp/julm/arpeggigon.git] / 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 reactiveValueUpdate_ :: (ReactiveValueAtomicUpdate a b m) =>
20 a -> (b -> b) -> m ()
21 reactiveValueUpdate_ rv f = void $ reactiveValueUpdate rv f
22
23 reactiveValueAppend :: (Monoid b, ReactiveValueAtomicUpdate a b m) =>
24 a -> b -> m ()
25 reactiveValueAppend rv val = reactiveValueUpdate_ rv (`mappend` val)
26
27 reactiveValueEmpty :: (Monoid b, ReactiveValueAtomicUpdate a b m) =>
28 a -> m b
29 reactiveValueEmpty rv = reactiveValueUpdate rv (const mempty)
30
31 instance ReactiveValueRead (CBRef a) a IO where
32 reactiveValueRead = readCBRef
33 reactiveValueOnCanRead = installCallbackCBRef
34
35 instance ReactiveValueWrite (CBRef a) a IO where
36 reactiveValueWrite = writeCBRef
37
38 instance ReactiveValueReadWrite (CBRef a) a IO where
39
40 instance ReactiveValueAtomicUpdate (CBRef a) a IO where
41 reactiveValueUpdate rv f = atomicModifyCBRef rv (\x -> (f x, x))