{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} -- | Reactive Values (RVs) are typed mutable variables with a change -- notification mechanism. -- -- They are defined by providing a way to read the value, a way to change it, -- and a way to install an event listener when the value has changed. -- -- RVs are pruposely abstract, defined as a type class. GUI toolkits, -- for instance, can use existing event-handling installing mechanisms to -- enclose widget attributes as Reactive Values, without the need for an -- additional, manually-handled event dispatcher. -- -- RVs are complemented with /relation-building/ functions, which -- enable pairing RVs during execution so that they are /kept in/ -- /sync/ for the duration of the program. -- -- This module only defines RVs and operations on them. For connections -- to existing backends (GUIs, devices, files, network, FRP), see -- https://github.com/keera-studios/keera-hails -- -- A more detailed description of reactive values can be found at: -- http://dl.acm.org/citation.cfm?id=2804316 -- -- Copyright : (C) Keera Studios Ltd, 2013 -- License : BSD3 -- Maintainer : support@keera.co.uk module Data.ReactiveValue ( -- * Reactive Values -- ** Readable Reactive Values -- $readablervs ReactiveValueRead(..) -- ** Writable Reactive Values -- $writablervs , ReactiveValueWrite(..) -- ** Read-Write Reactive Values -- $readwritervs , ReactiveValueReadWrite -- * Reactive Relations or Rules -- $rules , (=:>) , (=:=) , (<:=) -- * Activatable Reactive Values -- $activatable , ReactiveFieldActivatable , ReactiveValueActivatable(..) , mkActivatable -- * Purely functional implementation of RVs. -- $fields , ReactiveFieldRead(..) , ReactiveFieldWrite(..) , ReactiveFieldReadWrite(..) -- ** Setters, getters and notifiers -- $settersgetters , FieldGetter , FieldSetter , FieldNotifier -- * RV combinators -- ** Creating, lifting on and manipulating readable values -- $readablecombinators , constR , initRW , liftR , (<^>) , liftR2 , liftR3 , liftMR , readOnly , wrapMR , wrapMRPassive , eventR -- *** Merging , lMerge , rMerge -- ** Creating, lifting on and manipulating writeable values -- $writablecombinators , constW , liftW , liftW2 , (&.&) , liftMW , writeOnly , wrapMW , wrapDo , wrapDo_ -- ** Lift monadic actions/sinks (setters) and sources (getters) -- *** Lifting (sink) computations into writable RVs. -- $readwritecombinators -- **** Bijective functions , BijectiveFunc , bijection , direct , inverse , Involution , involution -- **** Combinators , liftRW , liftRW2 , pairRW , modRW , reactiveValueModify -- * Stopping change -- $changecontrol -- ** Stopping unnecesary change propagation , eqCheck -- ** Stopping all change propagation , passivelyR , passivelyRW -- ** Changing control over change propagation , governingR , governingRW -- ** Conditional change propagation , ifRW , ifRW_ , guardRO , guardRO' ) where import Control.Monad import Control.GFunctor -- Functors parameterised over the morphisms -- in the source category import Data.Functor.Contravariant -- $readablervs -- -- Readable reactive values are mutable values that can be read and, possibly, -- trigger notifications when they change. -- -- RVs without event handling are considered /passive/. That is their default -- behaviour if 'reactiveValueOnCanRead' is not specialised. -- BEWARE: Active and passive RVs are not differentiated at the type level. -- -- You are responsible of installing any potential thread-safety -- mechanisms when you implement instances, and to ensure that operations -- are executed in the right thread (some GUI toolkits may require that). -- It is important that the way that ensured that monadic actions are -- executed in the right thread can be nested; otherwise, some propagation can -- block. -- | A class for all Readable RVs. They can be read-only or read-write. -- -- If your type is also writeable (a writable RV or simply if it is not -- constant), you can include a change handler installer here. By default -- no change handlers are installed. -- -- Use a monad with "error" if reading or installing a handler can fail. class Monad m => ReactiveValueRead a b m | a -> b, a -> m where -- | Install a handler that will be executed when the reactive value -- changes. reactiveValueOnCanRead :: a -> m () -> m () reactiveValueOnCanRead _ _ = return () -- | Provide the last known value for this reactive value. reactiveValueRead :: a -> m b {-# MINIMAL reactiveValueRead #-} -- | Monadic actions are readable, but they do not provide any -- change notification. instance ReactiveValueRead (IO a) a IO where -- | Executes the monadic action and provides a value. reactiveValueRead = id -- | Pairs carrying a monadic action as their first component are Readable RVs. instance (Functor m, Monad m) => ReactiveValueRead (m a, a -> m b) a m where reactiveValueRead = fst -- $writablervs -- -- Writable reactive values are those that we can write to. -- They behave like sinks: there are no guarantees that anything happens, -- or result codes. -- -- You are responsible of installing any potential thread-safety -- mechanisms when you implement instances, and to ensure that operations -- are executed in the right thread (some GUI toolkits may require that). -- It is important that the way that ensured that monadic actions are -- executed in the right thread can be nested; otherwise, some propagation can -- block. -- | A minimal type class for all mutable values. Use a monad with error -- if changing the value can fail. class ReactiveValueWrite a b m | a -> b, a -> m where reactiveValueWrite :: a -> b -> m () -- | Monadic actions are trivially writable RVs in that monad, by ignoring the -- argument and executing the action. This is particularly suitable for IO code -- that just runs an action when a given value changes. instance ReactiveValueWrite (IO a) () IO where reactiveValueWrite m _ = void m -- | Monadic actions parameterised over an input are trivially writable RVs in -- that monad. This is particularly suitable for IO code that just runs an -- action when a given value changes, using that value. instance (Functor m, Monad m) => ReactiveValueWrite (a -> m b) a m where reactiveValueWrite f v = void (f v) -- | To facilitate creating RW reactive values from monadic actions, pairs -- of a getter and a setter are also RVs. instance ReactiveValueWrite (a -> m b) a m => ReactiveValueWrite (m a, a -> m b) a m where reactiveValueWrite (_, f) = reactiveValueWrite f -- $readwritervs -- -- RVs can be readable and writable, which is useful to create bi-directional -- rules (combinators like '(=:=)' require this instance). -- -- | Read-write Reactive Values are trivially defined. This class only captures -- the constraints of both the other classes. There is no need to implement -- any methods. class (ReactiveValueRead a b m, ReactiveValueWrite a b m) => ReactiveValueReadWrite a b m -- | Pairs of a monadic action and a parametric monadic action are also RVs instance (Functor m, Monad m) => ReactiveValueReadWrite (m a, a -> m b) a m -- $rules -- -- Reactive Rules are data dependency (data-passing) building combinators. -- By executing them, you install the right event handlers on the right RVs, so -- that values pass to the other RV. -- -- Reactive Relations cannot be independently removed. If the event-dispatching -- is handled internally by RVs, and two connected RVs are removed, then the -- rules should also disappear with them. -- Priorities so that we can write them infix without parenthesising infix 9 =:= infix 9 =:> infix 9 <:= -- | Left to right RV synchronisation function. If the value on the left -- changes, the one on the right is updated accordingly. (=:>) :: Monad m => (ReactiveValueRead a b m, ReactiveValueWrite c b m) => a -> c -> m () (=:>) v1 v2 = reactiveValueOnCanRead v1 sync1 where sync1 = reactiveValueRead v1 >>= reactiveValueWrite v2 -- | Right-to-left RV synchronisation function. If the value on the right -- changes, the one on the left is updated accordingly. (<:=) :: Monad m => (ReactiveValueRead a b m, ReactiveValueWrite c b m) => c -> a -> m () (<:=) v2 v1 = reactiveValueOnCanRead v1 sync1 where sync1 = reactiveValueRead v1 >>= reactiveValueWrite v2 -- | Bidirectional synchronisation. When either value changes, the other -- is updated accordingly. (=:=) :: Monad m => (ReactiveValueReadWrite a b m, ReactiveValueReadWrite c b m) => a -> c -> m () (=:=) v1 v2 = do -- This is often async, so the fact that one comes before the other does not guarantee -- that they will be refreshed in that order. v1 =:> v2 v1 <:= v2 -- reactiveValueOnCanRead v1 sync1 -- reactiveValueOnCanRead v2 sync2 -- where sync1 = reactiveValueRead v1 >>= reactiveValueWrite v2 -- sync2 = reactiveValueRead v2 >>= reactiveValueWrite v1 -- $settersgetters -- -- These are used internally for combinators that need to return RV instances. They can -- also be used to write new backends and library extensions, but they are not -- recommended to enclose application models. For that purpose, see light models and -- protected models instead. -- | The type of a monadic value producer (a getter, a source). type FieldGetter m a = m a -- | The type of a monadic value consumer (a setter, a sink, a slot). type FieldSetter m a = a -> m () -- | The type of an event handler installer type FieldNotifier m a = m () -> m () -- FIXME: why does fieldnotifier have an argument -- $fields -- This is a specific implementation of RVs that does not have a custom event queue. -- -- It can be used to return RVs in the combinators, by relying on the underlying -- change detection and event notification system (underlying meaning or the RV -- that these were created from). -- | A Read-Only RV. data ReactiveFieldRead m a = ReactiveFieldRead (FieldGetter m a) (FieldNotifier m a) -- | A Write-Only RV. newtype ReactiveFieldWrite m a = ReactiveFieldWrite (FieldSetter m a) -- | A Read-Write RV. data ReactiveFieldReadWrite m a = ReactiveFieldReadWrite (FieldSetter m a) (FieldGetter m a) (FieldNotifier m a) instance Monad m => ReactiveValueRead (ReactiveFieldRead m a) a m where reactiveValueOnCanRead (ReactiveFieldRead _ notifier) = notifier reactiveValueRead (ReactiveFieldRead getter _) = getter instance Monad m => ReactiveValueWrite (ReactiveFieldWrite m a) a m where reactiveValueWrite (ReactiveFieldWrite setter) = setter instance Monad m => ReactiveValueRead (ReactiveFieldReadWrite m a) a m where reactiveValueOnCanRead (ReactiveFieldReadWrite _ _ notifier) = notifier reactiveValueRead (ReactiveFieldReadWrite _ getter _) = getter instance Monad m => ReactiveValueWrite (ReactiveFieldReadWrite m a) a m where reactiveValueWrite (ReactiveFieldReadWrite setter _ _) = setter instance Monad m => ReactiveValueReadWrite (ReactiveFieldReadWrite m a) a m -- $activatable -- -- Activatable RVs are values that never hold any data, but whose change (or -- activation, or some sort of internal event) we need to be aware of). -- | A class for things with a trivial field that carries unit. Buttons -- (in any GUI library), for instance, could be a member of this class. class ReactiveValueActivatable m a where defaultActivation :: a -> ReactiveFieldActivatable m -- | A trivial type for Readable RVs that carry unit. They can be used for -- buttons, or events without data. type ReactiveFieldActivatable m = ReactiveFieldRead m () -- | Create an activatable RV from a handler installer. mkActivatable :: Monad m => (m () -> m ()) -> ReactiveFieldActivatable m mkActivatable f = ReactiveFieldRead getter notifier where getter = return () notifier = f -- instance (ReactiveValueWrite a b) => ReactiveValueWrite (TypedReactiveValue a b) b where -- reactiveValueWrite (TypedReactiveValue x _) v = reactiveValueWrite x v -- -- instance (ReactiveValueRead a b) => ReactiveValueRead (TypedReactiveValue a b) b where -- reactiveValueOnCanRead (TypedReactiveValue x _) v op = (reactiveValueOnCanRead x) v op -- reactiveValueRead (TypedReactiveValue x _) = reactiveValueRead x -- $readablecombinators -- | A trivial RV builder tith a constant value. We need this because -- we cannot have overlapping instances with a default case, and because -- the interpretation of lifting with RVs could be very confusing unless -- values are lifted into RVs explicitly. constR :: Monad m => a -> ReactiveFieldRead m a constR e = ReactiveFieldRead getter notifier where notifier _ = return () getter = return e -- | TODO: Bad name. Should be eliminated or extended with a setter. initRW :: Monad m => a -> ReactiveFieldRead m a initRW e = ReactiveFieldRead getter notifier where notifier _ = return () getter = return e {-# ANN liftR "HLint: ignore Use fmap" #-} -- | Lift a transformation onto a RV. Note that this creates a new -- RV, it does not modify the existing RV. liftR :: (Monad m, ReactiveValueRead a b m) => (b -> c) -> a -> ReactiveFieldRead m c liftR f e = ReactiveFieldRead getter notifier where notifier = reactiveValueOnCanRead e getter = liftM f (reactiveValueRead e) -- | Shorter name for 'liftR' (<^>) :: (Monad m, ReactiveValueRead a b m) => (b -> c) -> a -> ReactiveFieldRead m c (<^>) = liftR -- | Lift a transformation onto two RVs. Note that this creates a new -- RV, it does not modify the existing RVs. When either RV changes, -- the new one triggers a change. liftR2 :: (Monad m, ReactiveValueRead a b m, ReactiveValueRead c d m) => (b -> d -> e) -> a -> c -> ReactiveFieldRead m e liftR2 f e1 e2 = ReactiveFieldRead getter notifier where getter = do v1 <- reactiveValueRead e1 v2 <- reactiveValueRead e2 return (f v1 v2) notifier p = do reactiveValueOnCanRead e1 p reactiveValueOnCanRead e2 p -- | Lift a transformation onto three RVs. Note that this creates a new -- RV, it does not modify the existing RVs. When either RV changes, -- the new one triggers a change. liftR3 :: ( Monad m, ReactiveValueRead a b m, ReactiveValueRead c d m , ReactiveValueRead e f m) => (b -> d -> f -> g) -> a -> c -> e -> ReactiveFieldRead m g liftR3 f e1 e2 e3 = ReactiveFieldRead getter notifier where getter = do v1 <- reactiveValueRead e1 v2 <- reactiveValueRead e2 v3 <- reactiveValueRead e3 return (f v1 v2 v3) notifier p = do reactiveValueOnCanRead e1 p reactiveValueOnCanRead e2 p reactiveValueOnCanRead e3 p -- | Lift a parameterised monadic transformation onto an RV. -- -- Same as lifting join . f? liftMR :: (Monad m, ReactiveValueRead a b m) => (b -> m c) -> a -> ReactiveFieldRead m c liftMR f e = ReactiveFieldRead getter notifier where notifier = reactiveValueOnCanRead e getter = f =<< reactiveValueRead e -- *** Lifting (source) computations into readable RVs. {-# ANN wrapMR "HLint: ignore Eta reduce" #-} -- | Wrap an reading operation and an notification installer in -- a readable reactive value. wrapMR :: m a -> (m () -> m ()) -> ReactiveFieldRead m a wrapMR f p = ReactiveFieldRead f p -- | Wrap an reading operation into an RV. Because there is -- no way to detect changes, the resulting RV is passive (does -- not push updates). wrapMRPassive :: Monad m => m a -> ReactiveFieldRead m a wrapMRPassive f = ReactiveFieldRead f (const (return ())) {-# ANN eventR "HLint: ignore Eta reduce" #-} -- | Wrap event-handler installers in RVs eventR :: Monad m => (m () -> m ()) -> ReactiveFieldRead m () eventR notifInstaller = ReactiveFieldRead (return ()) notifInstaller -- | Make a RW RV read only readOnly :: ReactiveValueRead r a m => r -> ReactiveFieldRead m a readOnly r = ReactiveFieldRead (reactiveValueRead r) (reactiveValueOnCanRead r) -- $writablecombinators -- | Create a constant writable RV. -- constW :: (Monad m, ReactiveValueWrite v a m) => a -> v -> ReactiveFieldWrite m b constW c v = ReactiveFieldWrite $ \_ -> reactiveValueWrite v c -- | Lift a transformation onto an RV. This creates a new RV, it does -- not actually modify the old RV (when this one is written to, so will -- be the old one, but both will keep existing somewhat independently). liftW :: (Monad m, ReactiveValueWrite a b m) => (c -> b) -> a -> ReactiveFieldWrite m c liftW f e = ReactiveFieldWrite setter where setter = reactiveValueWrite e . f -- | Lift a transformation onto two RVs. This creates a new RV, it does -- not actually modify the old RVs (when this one is written to, so will -- be the old ones, but both will keep existing somewhat independently). liftW2 :: (Monad m, ReactiveValueWrite a b m, ReactiveValueWrite d e m) => (c -> (b,e)) -> a -> d -> ReactiveFieldWrite m c liftW2 f e1 e2 = ReactiveFieldWrite setter where setter x = do let (v1,v2) = f x reactiveValueWrite e1 v1 reactiveValueWrite e2 v2 -- | Binary writable replicator. -- -- r1 &.& r2 = liftW2 (\x -> (x,x)) r1 r2 -- (&.&) :: (Monad m, ReactiveValueWrite a b m, ReactiveValueWrite c b m) => a -> c -> ReactiveFieldWrite m b (&.&) v1 v2 = ReactiveFieldWrite $ \x -> do reactiveValueWrite v1 x reactiveValueWrite v2 x -- | Lift a parameterised monadic transformation onto an RV. liftMW :: (Monad m, ReactiveValueWrite a b m) => (c -> m b) -> a -> ReactiveFieldWrite m c liftMW f e = ReactiveFieldWrite setter where setter x = reactiveValueWrite e =<< f x -- | Make a RW RV write only writeOnly :: ReactiveValueWrite r a m => r -> ReactiveFieldWrite m a writeOnly r = ReactiveFieldWrite (reactiveValueWrite r) -- $readwritecombinators -- | Wrap a monadic computation in a writable reactive value. wrapMW :: (a -> m ()) -> ReactiveFieldWrite m a wrapMW = ReactiveFieldWrite -- | Wrap a monadic computation in a writable reactive value. -- It discards the written value and executes the operation. -- -- Note: Because the value is discarded, the resulting RV is -- polymorphic in the value that may be written to it. Using -- 'wrapDo_' may save you some extra type signatures. -- -- NOTE: this should be unnecessary since the introduction -- of a default 'ReactiveValueWrite' instance for monadic -- actions. wrapDo :: m () -> ReactiveFieldWrite m a wrapDo = wrapMW . const -- | Wrap a monadic computation in a writable reactive value of type -- unit. It discards the written value and executes the operation. wrapDo_ :: m () -> ReactiveFieldWrite m () wrapDo_ = wrapDo -- Lifting onto read-write values -- | Bijections newtype BijectiveFunc a b = BijectiveFunc { unBijectiveFunc :: (a -> b, b -> a) } -- | Create a bijection ('BijectiveFunc') from a couple of functions bijection :: (a -> b, b -> a) -> BijectiveFunc a b bijection = BijectiveFunc {-# ANN direct "HLint: ignore Redundant bracket" #-} -- | Obtain the direct function from a bijection direct :: BijectiveFunc a b -> (a -> b) direct = fst . unBijectiveFunc {-# ANN inverse "HLint: ignore Redundant bracket" #-} -- | Obtain the inverse function from a bijection inverse :: BijectiveFunc a b -> (b -> a) inverse = snd . unBijectiveFunc -- | Involutions (functions that are the same as their inverse) type Involution a = BijectiveFunc a a -- | Create an involution from a function involution :: (a -> a) -> Involution a involution f = BijectiveFunc (f, f) -- | Lift a bijection onto a read-write RV liftRW :: (Monad m, ReactiveValueReadWrite a b m) => BijectiveFunc b c -> a -> ReactiveFieldReadWrite m c liftRW (BijectiveFunc (f1, f2)) e = ReactiveFieldReadWrite setter getter notifier where ReactiveFieldRead getter notifier = liftR f1 e ReactiveFieldWrite setter = liftW f2 e -- | Lift a bijection onto two read-write RVs liftRW2 :: (Monad m, ReactiveValueReadWrite a b m, ReactiveValueReadWrite c d m) => BijectiveFunc e (b,d) -> a -> c -> ReactiveFieldReadWrite m e liftRW2 (BijectiveFunc (f1, f2)) e1 e2 = ReactiveFieldReadWrite setter getter notifier where ReactiveFieldRead getter notifier = liftR2 (curry f2) e1 e2 ReactiveFieldWrite setter = liftW2 f1 e1 e2 -- | Pair two read-write RVs pairRW :: (Monad m, ReactiveValueReadWrite a b m, ReactiveValueReadWrite c d m) => a -> c -> ReactiveFieldReadWrite m (b, d) pairRW = liftRW2 (bijection (id, id)) -- | Add an equality check to the setter of a Read-Write RV, effectively stopping -- all unnecessary change (the RV is not modified if it has not changed). {-# INLINE eqCheck #-} eqCheck :: (Eq v, Monad m) => ReactiveFieldReadWrite m v -> ReactiveFieldReadWrite m v eqCheck (ReactiveFieldReadWrite setter getter notifier) = ReactiveFieldReadWrite setter' getter notifier where setter' v = do o <- getter when (o /= v) $ setter v -- | Lift a function that takes an old value and a new input and creates a new -- value. It is similar to how fold works: the RV represents the accumulator, -- and the values are provided in succession by writing to the resulting RV. modRW :: (Monad m, ReactiveValueReadWrite a b m) => (b -> c -> b) -> a -> ReactiveFieldWrite m c modRW f rv = ReactiveFieldWrite setter where setter c = do b <- reactiveValueRead rv let b' = f b c reactiveValueWrite rv b' -- | Apply a modification to an RV. This modification is not attached to -- the RV, and there are no guarantees that it will be atomic (if you need -- atomicity, check out STM. reactiveValueModify :: (Monad m, ReactiveValueReadWrite a b m) => a -> (b -> b) -> m () reactiveValueModify r f = reactiveValueWrite r . f =<< reactiveValueRead r {-# ANN lMerge "HLint: ignore Use const" #-} -- | Left merge (give priority to the value on the left) lMerge :: (Monad m, ReactiveValueRead a v m, ReactiveValueRead b v m) => a -> b -> ReactiveFieldRead m v lMerge = liftR2 (\a _ -> a) -- | Right merge (give priority to the value on the right) rMerge :: (Monad m, ReactiveValueRead a v m, ReactiveValueRead b v m) => a -> b -> ReactiveFieldRead m v rMerge = liftR2 (\_ b -> b) -- $changecontrol -- -- Sometimes you need to create complex liftings between RVs in which -- only changes to one of them should provoke change propagation. -- These combinators allow you to stop propagation (making RVs passive), -- make one RV control the change propagation of another (governance), -- filter propagation based on some condition (guards) and have a -- boolean-carrying RV guard another. -- Turning an active RV into a passive one (does not propagate changes) -- Note that this does not really affect the RV itself, only produces a new -- RV that will not propagate changes. So, if used in a reactive relation, -- values will not get propagated when they change. It is useful in combination -- with lifts, to achieve things similar to Yampa's tagging, but this might -- be more general. -- | Create a passive RO RV backed by another Readable RV by disabling change -- propagation. passivelyR :: (Monad m, ReactiveValueRead a b m) => a -> ReactiveFieldRead m b passivelyR rv = ReactiveFieldRead (reactiveValueRead rv) (\_ -> return ()) -- | Create a passive RW RV backed by another RW RV by disabling change -- propagation. passivelyRW :: (Monad m, ReactiveValueReadWrite a b m) => a -> ReactiveFieldReadWrite m b passivelyRW rv = ReactiveFieldReadWrite (reactiveValueWrite rv) (reactiveValueRead rv) (\_ -> return ()) -- | A form of binary readable lifting that passifies the second RV but reads -- exclusively from it. -- -- governingR r1 r2 = rMerge r1 (passively r2) governingR :: (ReactiveValueRead a b m, ReactiveValueRead c d m) => a -> c -> ReactiveFieldRead m d governingR r c = ReactiveFieldRead getter notifier where getter = reactiveValueRead c notifier = reactiveValueOnCanRead r -- | A form of binary read-writable lifting that passifies the second RV but reads -- exclusively from it. governingRW :: (ReactiveValueRead a b m, ReactiveValueReadWrite c d m) => a -> c -> ReactiveFieldReadWrite m d governingRW r c = ReactiveFieldReadWrite setter getter notifier where getter = reactiveValueRead c setter = reactiveValueWrite c notifier = reactiveValueOnCanRead r -- | Check condition, and write or notify only when it holds. ifRW :: (Monad m, ReactiveValueRead c Bool m, ReactiveValueReadWrite v a m) => c -> v -> ReactiveFieldReadWrite m a ifRW c r = ReactiveFieldReadWrite setter getter notifier where setter x = do b <- reactiveValueRead c when b $ reactiveValueWrite r x getter = reactiveValueRead r -- If either changes, the value *may* be propagated notifier p = do reactiveValueOnCanRead c (when' p) reactiveValueOnCanRead r (when' p) -- Propagate only if the condition holds where when' m = do b <- reactiveValueRead c when b m -- | Check condition and notify only when holds (but writing occurs -- regardless). ifRW_ :: (Monad m, ReactiveValueRead c Bool m, ReactiveValueReadWrite v a m) => c -> v -> ReactiveFieldReadWrite m a ifRW_ c r = ReactiveFieldReadWrite setter getter notifier where setter = reactiveValueWrite r getter = reactiveValueRead r -- If either changes, the value *may* be propagated notifier p = do reactiveValueOnCanRead c (when' p) reactiveValueOnCanRead r (when' p) -- Propagate only if the condition holds where when' m = do x <- reactiveValueRead c when x m -- | Check RV carrying a 'Bool', and notify only when it changes and it is -- 'True'. guardRO :: (Monad m, ReactiveValueRead c Bool m) => c -> ReactiveFieldRead m Bool guardRO c = ReactiveFieldRead getter notifier where getter = reactiveValueRead c -- If either changes, the value *may* be propagated notifier = reactiveValueOnCanRead c . when' -- Propagate only if the condition holds where when' m = do x <- reactiveValueRead c when x m -- | Check RV and notify only when condition on the value holds. -- -- (stops propagation by filtering on the new value). guardRO' :: (Monad m, ReactiveValueRead c a m) => c -> (a -> Bool) -> ReactiveFieldRead m a guardRO' c p = ReactiveFieldRead getter notifier where getter = reactiveValueRead c -- If either changes, the value *may* be propagated notifier = reactiveValueOnCanRead c . when' -- Propagate only if the condition holds where when' m = do x <- reactiveValueRead c when (p x) m -- Category theoretic definitions -- Functor definitions instance (Functor m, Monad m) => Functor (ReactiveFieldRead m) where fmap = liftR -- FIXME: I might not want to provide this: the contravariant library -- depends on transformers. -- (ReactiveFieldRead getter notifier) = ReactiveFieldRead (fmap f getter) notifier instance (Monad m) => Contravariant (ReactiveFieldWrite m) where contramap = liftW instance Monad m => GFunctor (ReactiveFieldReadWrite m) BijectiveFunc where gmap = liftRW