1 {-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-}
3 module RMCA.Auxiliary.RV where
6 import Data.ReactiveValue
9 import RMCA.Auxiliary.Curry
11 leftSyncWith :: (ReactiveValueRead a b m, ReactiveValueWrite c d m) =>
12 (b -> d) -> a -> c -> m ()
13 leftSyncWith f a c = reactiveValueOnCanRead a
14 (reactiveValueRead a >>= reactiveValueWrite c . f)
16 (=:$:>) :: (ReactiveValueRead a b m, ReactiveValueWrite c d m) =>
17 (b -> d) -> a -> c -> m ()
18 (=:$:>) = leftSyncWith
20 newCBMVarRW :: forall a. a -> IO (ReactiveFieldReadWrite IO a)
24 getter = readCBMVar mvar
26 setter = writeCBMVar mvar
27 notifier :: IO () -> IO ()
28 notifier = installCallbackCBMVar mvar
29 return $ ReactiveFieldReadWrite setter getter notifier
31 emptyRW :: (Monoid b, ReactiveValueReadWrite a b m) => a -> m b
33 val <- reactiveValueRead rv
34 reactiveValueWrite rv mempty
37 emptyW :: (Monoid b, ReactiveValueWrite a b m) => a -> m ()
38 emptyW rv = reactiveValueWrite rv mempty
40 reactiveValueAppend :: (Monoid b, ReactiveValueReadWrite a b m) =>
42 reactiveValueAppend rv v = do ov <- reactiveValueRead rv
43 reactiveValueWrite rv (ov `mappend` v)
45 onTick :: (ReactiveValueRead a b m, ReactiveValueRead c d m) =>
46 a -> c -> ReactiveFieldRead m d
47 onTick notif rv = ReactiveFieldRead getter notifier
48 where getter = reactiveValueRead rv
50 reactiveValueOnCanRead notif cb
51 reactiveValueOnCanRead rv cb
53 addHandlerR :: (ReactiveValueRead a b m) =>
56 -> ReactiveFieldRead m b
57 addHandlerR x h = ReactiveFieldRead (reactiveValueRead x)
58 (\p -> reactiveValueOnCanRead x p >> h p)
60 -- Update when the value is an Event. It would be nice to have that
61 -- even for Maybe as well.
62 (>:>) :: (ReactiveValueRead a (Event b) IO, ReactiveValueWrite c b IO) =>
64 eventRV >:> rv = reactiveValueOnCanRead eventRV syncOnEvent
65 where syncOnEvent = do
66 erv <- reactiveValueRead eventRV
67 when (isEvent erv) $ reactiveValueWrite rv $ fromEvent erv
70 , ReactiveValueWrite a b m
71 , ReactiveValueWrite c d m
72 , ReactiveValueWrite e f m) =>
77 -> ReactiveFieldWrite m i
78 liftW3 f a b c = ReactiveFieldWrite setter
81 reactiveValueWrite a x1
82 reactiveValueWrite b x2
83 reactiveValueWrite c x3
85 liftRW3 :: ( ReactiveValueReadWrite a b m
86 , ReactiveValueReadWrite c d m
87 , ReactiveValueReadWrite e f m) =>
88 BijectiveFunc i (b,d,f)
92 -> ReactiveFieldReadWrite m i
94 ReactiveFieldReadWrite setter getter notifier
95 where ReactiveFieldRead getter notifier = liftR3 (curry3 f2) a b c
96 ReactiveFieldWrite setter = liftW3 f1 a b c
97 (f1, f2) = (direct bij, inverse bij)
99 liftR4 :: ( ReactiveValueRead a b m
100 , ReactiveValueRead c d m
101 , ReactiveValueRead e f m
102 , ReactiveValueRead g h m) =>
108 -> ReactiveFieldRead m i
109 liftR4 f a b c d = ReactiveFieldRead getter notifier
111 x1 <- reactiveValueRead a
112 x2 <- reactiveValueRead b
113 x3 <- reactiveValueRead c
114 x4 <- reactiveValueRead d
115 return $ f (x1, x2, x3, x4)
117 reactiveValueOnCanRead a p
118 reactiveValueOnCanRead b p
119 reactiveValueOnCanRead c p
120 reactiveValueOnCanRead d p
123 , ReactiveValueWrite a b m
124 , ReactiveValueWrite c d m
125 , ReactiveValueWrite e f m
126 , ReactiveValueWrite g h m) =>
132 -> ReactiveFieldWrite m i
133 liftW4 f a b c d = ReactiveFieldWrite setter
135 let (x1,x2,x3,x4) = f x
136 reactiveValueWrite a x1
137 reactiveValueWrite b x2
138 reactiveValueWrite c x3
139 reactiveValueWrite d x4
141 liftRW4 :: ( ReactiveValueReadWrite a b m
142 , ReactiveValueReadWrite c d m
143 , ReactiveValueReadWrite e f m
144 , ReactiveValueReadWrite g h m) =>
145 BijectiveFunc i (b,d,f,h)
150 -> ReactiveFieldReadWrite m i
151 liftRW4 bij a b c d =
152 ReactiveFieldReadWrite setter getter notifier
153 where ReactiveFieldRead getter notifier = liftR4 f2 a b c d
154 ReactiveFieldWrite setter = liftW4 f1 a b c d
155 (f1, f2) = (direct bij, inverse bij)
157 liftR5 :: ( ReactiveValueRead a b m
158 , ReactiveValueRead c d m
159 , ReactiveValueRead e f m
160 , ReactiveValueRead g h m
161 , ReactiveValueRead i j m) =>
168 -> ReactiveFieldRead m k
169 liftR5 f a b c d e = ReactiveFieldRead getter notifier
171 x1 <- reactiveValueRead a
172 x2 <- reactiveValueRead b
173 x3 <- reactiveValueRead c
174 x4 <- reactiveValueRead d
175 x5 <- reactiveValueRead e
176 return $ f (x1, x2, x3, x4, x5)
178 reactiveValueOnCanRead a p
179 reactiveValueOnCanRead b p
180 reactiveValueOnCanRead c p
181 reactiveValueOnCanRead d p
182 reactiveValueOnCanRead e p
185 , ReactiveValueWrite a b m
186 , ReactiveValueWrite c d m
187 , ReactiveValueWrite e f m
188 , ReactiveValueWrite g h m
189 , ReactiveValueWrite i j m) =>
196 -> ReactiveFieldWrite m k
197 liftW5 f a b c d e = ReactiveFieldWrite setter
199 let (x1,x2,x3,x4,x5) = f x
200 reactiveValueWrite a x1
201 reactiveValueWrite b x2
202 reactiveValueWrite c x3
203 reactiveValueWrite d x4
204 reactiveValueWrite e x5
206 liftRW5 :: ( ReactiveValueReadWrite a b m
207 , ReactiveValueReadWrite c d m
208 , ReactiveValueReadWrite e f m
209 , ReactiveValueReadWrite g h m
210 , ReactiveValueReadWrite i j m) =>
211 BijectiveFunc k (b,d,f,h,j)
217 -> ReactiveFieldReadWrite m k
218 liftRW5 bij a b c d e =
219 ReactiveFieldReadWrite setter getter notifier
220 where ReactiveFieldRead getter notifier = liftR5 f2 a b c d e
221 ReactiveFieldWrite setter = liftW5 f1 a b c d e
222 (f1, f2) = (direct bij, inverse bij)