Copyright | (C) Keera Studios Ltd 2013 |
---|---|
License | BSD3 |
Maintainer | support@keera.co.uk |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Data.ReactiveValue
Description
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 react when the value has changed.
RVs are abstract (i.e., a type class). This module defines a class and
manipulation operations, but you need an actual instance of RV underneath.
For a way to turn IORef
s into RVs, see the example below. GUI toolkits can
use existing event-handling mechanisms to make widget attributes Reactive
Values without additional boilerplate. A number of
backends (GUIs, devices,
files, network, FRP) are supported.
RVs are complemented with Reactive Relations, which connect RVs and keep them in sync during execution.
A very simple example of an RV is the following construction, in which passive IORefs are turned into active Reactive Values.
import Control.Concurrent (threadDelay) import Control.Monad (forever) -- From the package keera-callbacks import Data.CBRef (installCallbackCBRef, newCBRef, readCBRef, writeCBRef) -- From keera-hails-reactivevalues import Data.ReactiveValue (ReactiveFieldReadWrite (..), ReactiveFieldWrite, reactiveValueModify, wrapMW, (=:>)) main :: IO () main = do -- Empower IORef with callback installation mechanism -- -- passiveCBRef :: CBRRef Integer passiveCBRef <- newCBRef 0 -- Turn IORef into active reactive value (RV). -- -- We use the type of Reactive Fields, which have a trivial RV -- implementation. let activeCBRefRV :: ReactiveFieldReadWrite IO Integer activeCBRefRV = ReactiveFieldReadWrite (writeCBRef passiveCBRef) (readCBRef passiveCBRef) (installCallbackCBRef passiveCBRef) -- Define a write-only RV that prints whatever you put in it. let printer :: Show a => ReactiveFieldWrite IO a printer = wrapMW print -- Connect them using a reactive rule. In a GUI application, this code -- would in the controller, and would define connections between the model -- and the view. -- -- For bi-directional connections, see (=:=). activeCBRefRV =:> printer -- To demonstrate the connection, just loop forever and increment the -- first reactive value. The change will propagate through the channel -- and be printed on the screen every second. forever $ do threadDelay 1000000 -- 1 second reactiveValueModify activeCBRefRV (+1)
For further explanations on reactive values, see the Haskell Symposium paper and the demos in our repository.
Synopsis
- class Monad m => ReactiveValueRead a b m | a -> b, a -> m where
- reactiveValueOnCanRead :: a -> m () -> m ()
- reactiveValueRead :: a -> m b
- class ReactiveValueWrite a b m | a -> b, a -> m where
- reactiveValueWrite :: a -> b -> m ()
- class (ReactiveValueRead a b m, ReactiveValueWrite a b m) => ReactiveValueReadWrite a b m
- (=:>) :: Monad m => (ReactiveValueRead a b m, ReactiveValueWrite c b m) => a -> c -> m ()
- (=:=) :: Monad m => (ReactiveValueReadWrite a b m, ReactiveValueReadWrite c b m) => a -> c -> m ()
- (<:=) :: Monad m => (ReactiveValueRead a b m, ReactiveValueWrite c b m) => c -> a -> m ()
- data ReactiveFieldRead m a = ReactiveFieldRead (FieldGetter m a) (FieldNotifier m a)
- newtype ReactiveFieldWrite m a = ReactiveFieldWrite (FieldSetter m a)
- data ReactiveFieldReadWrite m a = ReactiveFieldReadWrite (FieldSetter m a) (FieldGetter m a) (FieldNotifier m a)
- type FieldGetter m a = m a
- type FieldSetter m a = a -> m ()
- type FieldNotifier m a = m () -> m ()
- constR :: Monad m => a -> ReactiveFieldRead m a
- initRW :: Monad m => a -> ReactiveFieldRead m a
- liftR :: (Monad m, ReactiveValueRead a b m) => (b -> c) -> a -> ReactiveFieldRead m c
- (<^>) :: (Monad m, ReactiveValueRead a b m) => (b -> c) -> a -> ReactiveFieldRead m c
- liftR2 :: (Monad m, ReactiveValueRead a b m, ReactiveValueRead c d m) => (b -> d -> e) -> a -> c -> ReactiveFieldRead m e
- 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
- liftMR :: (Monad m, ReactiveValueRead a b m) => (b -> m c) -> a -> ReactiveFieldRead m c
- readOnly :: ReactiveValueRead r a m => r -> ReactiveFieldRead m a
- wrapMR :: m a -> (m () -> m ()) -> ReactiveFieldRead m a
- wrapMRPassive :: Monad m => m a -> ReactiveFieldRead m a
- eventR :: Monad m => (m () -> m ()) -> ReactiveFieldRead m ()
- lMerge :: (Monad m, ReactiveValueRead a v m, ReactiveValueRead b v m) => a -> b -> ReactiveFieldRead m v
- rMerge :: (Monad m, ReactiveValueRead a v m, ReactiveValueRead b v m) => a -> b -> ReactiveFieldRead m v
- constW :: (Monad m, ReactiveValueWrite v a m) => a -> v -> ReactiveFieldWrite m b
- liftW :: (Monad m, ReactiveValueWrite a b m) => (c -> b) -> a -> ReactiveFieldWrite m c
- liftW2 :: (Monad m, ReactiveValueWrite a b m, ReactiveValueWrite d e m) => (c -> (b, e)) -> a -> d -> ReactiveFieldWrite m c
- (&.&) :: (Monad m, ReactiveValueWrite a b m, ReactiveValueWrite c b m) => a -> c -> ReactiveFieldWrite m b
- liftMW :: (Monad m, ReactiveValueWrite a b m) => (c -> m b) -> a -> ReactiveFieldWrite m c
- writeOnly :: ReactiveValueWrite r a m => r -> ReactiveFieldWrite m a
- wrapMW :: (a -> m ()) -> ReactiveFieldWrite m a
- wrapDo :: m () -> ReactiveFieldWrite m a
- wrapDo_ :: m () -> ReactiveFieldWrite m ()
- liftRW :: (Monad m, ReactiveValueReadWrite a b m) => BijectiveFunc b c -> a -> ReactiveFieldReadWrite m c
- liftRW2 :: (Monad m, ReactiveValueReadWrite a b m, ReactiveValueReadWrite c d m) => BijectiveFunc e (b, d) -> a -> c -> ReactiveFieldReadWrite m e
- pairRW :: (Monad m, ReactiveValueReadWrite a b m, ReactiveValueReadWrite c d m) => a -> c -> ReactiveFieldReadWrite m (b, d)
- modRW :: (Monad m, ReactiveValueReadWrite a b m) => (b -> c -> b) -> a -> ReactiveFieldWrite m c
- data BijectiveFunc a b
- bijection :: (a -> b, b -> a) -> BijectiveFunc a b
- direct :: BijectiveFunc a b -> a -> b
- inverse :: BijectiveFunc a b -> b -> a
- type Involution a = BijectiveFunc a a
- involution :: (a -> a) -> Involution a
- reactiveValueModify :: (Monad m, ReactiveValueReadWrite a b m) => a -> (b -> b) -> m ()
- eqCheck :: (Eq v, Monad m) => ReactiveFieldReadWrite m v -> ReactiveFieldReadWrite m v
- passivelyR :: (Monad m, ReactiveValueRead a b m) => a -> ReactiveFieldRead m b
- passivelyRW :: (Monad m, ReactiveValueReadWrite a b m) => a -> ReactiveFieldReadWrite m b
- governingR :: (ReactiveValueRead a b m, ReactiveValueRead c d m) => a -> c -> ReactiveFieldRead m d
- governingRW :: (ReactiveValueRead a b m, ReactiveValueReadWrite c d m) => a -> c -> ReactiveFieldReadWrite m d
- ifRW :: (Monad m, ReactiveValueRead c Bool m, ReactiveValueReadWrite v a m) => c -> v -> ReactiveFieldReadWrite m a
- ifRW_ :: (Monad m, ReactiveValueRead c Bool m, ReactiveValueReadWrite v a m) => c -> v -> ReactiveFieldReadWrite m a
- guardRO :: (Monad m, ReactiveValueRead c Bool m) => c -> ReactiveFieldRead m Bool
- guardRO' :: (Monad m, ReactiveValueRead c a m) => c -> (a -> Bool) -> ReactiveFieldRead m a
- class ReactiveValueActivatable m a where
- defaultActivation :: a -> ReactiveFieldActivatable m
- type ReactiveFieldActivatable m = ReactiveFieldRead m ()
- mkActivatable :: Monad m => (m () -> m ()) -> ReactiveFieldActivatable m
Reactive Values
Reactive Values are an abstraction over values that change over the execution of a program, and whose change we can be aware of.
There is no unique, canonical implementation of RVs: they are defined as a collection of type classes, and you are free to make your existing framework reactive by providing the necessary instances.
RVs are distinguished by the API they offer, mainly whether it is possible to read them, to write to them, or both. A readable RV is one that whose value we can read (whether it is read-only or read-write, or whether it will actively propagate changes to it or not, is a different matter). Analogously, a writable RV is one that we can write to (write-only or read-write).
We also distinguish between active RVs (i.e., those that actively propagate changes through the Reactive Relations they are connected to) and passive RVs (those that do not propagate changes). It is possible to "silence" an RV by minimizing unnecesssary change, or attaching it to another RV that determines when change propagates (see governing and guarding below).
Readable Reactive Values
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.
class Monad m => ReactiveValueRead a b m | a -> b, a -> m where Source #
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.
Minimal complete definition
Methods
reactiveValueOnCanRead :: a -> m () -> m () Source #
Install a handler that will be executed when the reactive value changes.
reactiveValueRead :: a -> m b Source #
Provide the last known value for this reactive value.
Instances
ReactiveValueRead (IO a) a IO Source # | Monadic actions are readable, but they do not provide any change notification. |
Defined in Data.ReactiveValue | |
(Functor m, Monad m) => ReactiveValueRead (m a, a -> m b) a m Source # | Pairs carrying a monadic action as their first component are Readable RVs. |
Defined in Data.ReactiveValue Methods reactiveValueOnCanRead :: (m a, a -> m b) -> m () -> m () Source # reactiveValueRead :: (m a, a -> m b) -> m a Source # | |
Monad m => ReactiveValueRead (ReactiveFieldReadWrite m a) a m Source # | |
Defined in Data.ReactiveValue Methods reactiveValueOnCanRead :: ReactiveFieldReadWrite m a -> m () -> m () Source # reactiveValueRead :: ReactiveFieldReadWrite m a -> m a Source # | |
Monad m => ReactiveValueRead (ReactiveFieldRead m a) a m Source # | |
Defined in Data.ReactiveValue Methods reactiveValueOnCanRead :: ReactiveFieldRead m a -> m () -> m () Source # reactiveValueRead :: ReactiveFieldRead m a -> m a Source # |
Writable Reactive Values
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.
class ReactiveValueWrite a b m | a -> b, a -> m where Source #
A minimal type class for all mutable values. Use a monad with error if changing the value can fail.
Methods
reactiveValueWrite :: a -> b -> m () Source #
Instances
ReactiveValueWrite (IO a) () IO Source # | 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. |
Defined in Data.ReactiveValue Methods reactiveValueWrite :: IO a -> () -> IO () Source # | |
(Functor m, Monad m) => ReactiveValueWrite (a -> m b) a m Source # | 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. |
Defined in Data.ReactiveValue Methods reactiveValueWrite :: (a -> m b) -> a -> m () Source # | |
ReactiveValueWrite (a -> m b) a m => ReactiveValueWrite (m a, a -> m b) a m Source # | To facilitate creating RW reactive values from monadic actions, pairs of a getter and a setter are also RVs. |
Defined in Data.ReactiveValue Methods reactiveValueWrite :: (m a, a -> m b) -> a -> m () Source # | |
Monad m => ReactiveValueWrite (ReactiveFieldReadWrite m a) a m Source # | |
Defined in Data.ReactiveValue Methods reactiveValueWrite :: ReactiveFieldReadWrite m a -> a -> m () Source # | |
Monad m => ReactiveValueWrite (ReactiveFieldWrite m a) a m Source # | |
Defined in Data.ReactiveValue Methods reactiveValueWrite :: ReactiveFieldWrite m a -> a -> m () Source # |
Read-Write Reactive Values
RVs can be readable and writable, which is useful to create bi-directional
rules (combinators like (=:=)
require this instance).
class (ReactiveValueRead a b m, ReactiveValueWrite a b m) => ReactiveValueReadWrite a b m Source #
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.
Instances
(Functor m, Monad m) => ReactiveValueReadWrite (m a, a -> m b) a m Source # | Pairs of a monadic action and a parametric monadic action are also RVs |
Defined in Data.ReactiveValue | |
Monad m => ReactiveValueReadWrite (ReactiveFieldReadWrite m a) a m Source # | |
Defined in Data.ReactiveValue |
Reactive Relations or 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.
(=:>) :: Monad m => (ReactiveValueRead a b m, ReactiveValueWrite c b m) => a -> c -> m () infix 9 Source #
Left to right RV synchronisation function. If the value on the left changes, the one on the right is updated accordingly.
(=:=) :: Monad m => (ReactiveValueReadWrite a b m, ReactiveValueReadWrite c b m) => a -> c -> m () infix 9 Source #
Bidirectional synchronisation. When either value changes, the other is updated accordingly.
(<:=) :: Monad m => (ReactiveValueRead a b m, ReactiveValueWrite c b m) => c -> a -> m () infix 9 Source #
Right-to-left RV synchronisation function. If the value on the right changes, the one on the left is updated accordingly.
Reactive Fields (pure RVs)
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).
data ReactiveFieldRead m a Source #
A Read-Only RV.
Constructors
ReactiveFieldRead (FieldGetter m a) (FieldNotifier m a) |
Instances
(Functor m, Monad m) => Functor (ReactiveFieldRead m) Source # | |
Defined in Data.ReactiveValue Methods fmap :: (a -> b) -> ReactiveFieldRead m a -> ReactiveFieldRead m b # (<$) :: a -> ReactiveFieldRead m b -> ReactiveFieldRead m a # | |
Monad m => ReactiveValueRead (ReactiveFieldRead m a) a m Source # | |
Defined in Data.ReactiveValue Methods reactiveValueOnCanRead :: ReactiveFieldRead m a -> m () -> m () Source # reactiveValueRead :: ReactiveFieldRead m a -> m a Source # |
newtype ReactiveFieldWrite m a Source #
A Write-Only RV.
Constructors
ReactiveFieldWrite (FieldSetter m a) |
Instances
Monad m => Contravariant (ReactiveFieldWrite m) Source # | |
Defined in Data.ReactiveValue Methods contramap :: (a -> b) -> ReactiveFieldWrite m b -> ReactiveFieldWrite m a # (>$) :: b -> ReactiveFieldWrite m b -> ReactiveFieldWrite m a # | |
Monad m => ReactiveValueWrite (ReactiveFieldWrite m a) a m Source # | |
Defined in Data.ReactiveValue Methods reactiveValueWrite :: ReactiveFieldWrite m a -> a -> m () Source # |
data ReactiveFieldReadWrite m a Source #
A Read-Write RV.
Constructors
ReactiveFieldReadWrite (FieldSetter m a) (FieldGetter m a) (FieldNotifier m a) |
Instances
Monad m => GFunctor (ReactiveFieldReadWrite m) BijectiveFunc Source # | |
Defined in Data.ReactiveValue Methods gmap :: BijectiveFunc a b -> ReactiveFieldReadWrite m a -> ReactiveFieldReadWrite m b Source # | |
Monad m => ReactiveValueReadWrite (ReactiveFieldReadWrite m a) a m Source # | |
Defined in Data.ReactiveValue | |
Monad m => ReactiveValueWrite (ReactiveFieldReadWrite m a) a m Source # | |
Defined in Data.ReactiveValue Methods reactiveValueWrite :: ReactiveFieldReadWrite m a -> a -> m () Source # | |
Monad m => ReactiveValueRead (ReactiveFieldReadWrite m a) a m Source # | |
Defined in Data.ReactiveValue Methods reactiveValueOnCanRead :: ReactiveFieldReadWrite m a -> m () -> m () Source # reactiveValueRead :: ReactiveFieldReadWrite m a -> m a Source # |
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.
type FieldGetter m a = m a Source #
The type of a monadic value producer (a getter, a source).
type FieldSetter m a = a -> m () Source #
The type of a monadic value consumer (a setter, a sink, a slot).
type FieldNotifier m a = m () -> m () Source #
The type of an event handler installer
RV creation and manipulation
Readable RVs
constR :: Monad m => a -> ReactiveFieldRead m a Source #
A trivial RV builder with 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.
initRW :: Monad m => a -> ReactiveFieldRead m a Source #
Deprecated: Deprecated in keera-hails-reactivevalues 0.8.0, use constR instead
A trivial RV builder with a constant value (i.e., initialized). 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.
liftR :: (Monad m, ReactiveValueRead a b m) => (b -> c) -> a -> ReactiveFieldRead m c Source #
Lift a transformation onto a RV. Note that this creates a new RV, it does not modify the existing RV.
(<^>) :: (Monad m, ReactiveValueRead a b m) => (b -> c) -> a -> ReactiveFieldRead m c Source #
Shorter name for liftR
liftR2 :: (Monad m, ReactiveValueRead a b m, ReactiveValueRead c d m) => (b -> d -> e) -> a -> c -> ReactiveFieldRead m e Source #
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.
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 Source #
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.
liftMR :: (Monad m, ReactiveValueRead a b m) => (b -> m c) -> a -> ReactiveFieldRead m c Source #
Lift a parameterised monadic transformation onto an RV.
Same as lifting join . f?
readOnly :: ReactiveValueRead r a m => r -> ReactiveFieldRead m a Source #
Make a RW RV read only
wrapMR :: m a -> (m () -> m ()) -> ReactiveFieldRead m a Source #
Wrap an reading operation and an notification installer in a readable reactive value.
wrapMRPassive :: Monad m => m a -> ReactiveFieldRead m a Source #
Wrap an reading operation into an RV. Because there is no way to detect changes, the resulting RV is passive (does not push updates).
eventR :: Monad m => (m () -> m ()) -> ReactiveFieldRead m () Source #
Wrap event-handler installers in RVs
lMerge :: (Monad m, ReactiveValueRead a v m, ReactiveValueRead b v m) => a -> b -> ReactiveFieldRead m v Source #
Left merge (give priority to the value on the left)
rMerge :: (Monad m, ReactiveValueRead a v m, ReactiveValueRead b v m) => a -> b -> ReactiveFieldRead m v Source #
Right merge (give priority to the value on the right)
Writable RVs
constW :: (Monad m, ReactiveValueWrite v a m) => a -> v -> ReactiveFieldWrite m b Source #
Create a constant writable RV.
liftW :: (Monad m, ReactiveValueWrite a b m) => (c -> b) -> a -> ReactiveFieldWrite m c Source #
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).
liftW2 :: (Monad m, ReactiveValueWrite a b m, ReactiveValueWrite d e m) => (c -> (b, e)) -> a -> d -> ReactiveFieldWrite m c Source #
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).
(&.&) :: (Monad m, ReactiveValueWrite a b m, ReactiveValueWrite c b m) => a -> c -> ReactiveFieldWrite m b Source #
Binary writable replicator.
r1 &.& r2 = liftW2 (x -> (x, x)) r1 r2
liftMW :: (Monad m, ReactiveValueWrite a b m) => (c -> m b) -> a -> ReactiveFieldWrite m c Source #
Lift a parameterised monadic transformation onto an RV.
writeOnly :: ReactiveValueWrite r a m => r -> ReactiveFieldWrite m a Source #
Make a RW RV write only
wrapMW :: (a -> m ()) -> ReactiveFieldWrite m a Source #
Wrap a monadic computation in a writable reactive value.
wrapDo :: m () -> ReactiveFieldWrite m a Source #
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 () Source #
Wrap a monadic computation in a writable reactive value of type unit. It discards the written value and executes the operation.
Read-write RVs
liftRW :: (Monad m, ReactiveValueReadWrite a b m) => BijectiveFunc b c -> a -> ReactiveFieldReadWrite m c Source #
Lift a bijection onto a read-write RV
liftRW2 :: (Monad m, ReactiveValueReadWrite a b m, ReactiveValueReadWrite c d m) => BijectiveFunc e (b, d) -> a -> c -> ReactiveFieldReadWrite m e Source #
Lift a bijection onto two read-write RVs
pairRW :: (Monad m, ReactiveValueReadWrite a b m, ReactiveValueReadWrite c d m) => a -> c -> ReactiveFieldReadWrite m (b, d) Source #
Pair two read-write RVs
modRW :: (Monad m, ReactiveValueReadWrite a b m) => (b -> c -> b) -> a -> ReactiveFieldWrite m c Source #
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.
Bijective functions
data BijectiveFunc a b Source #
Bijections
Instances
Monad m => GFunctor (ReactiveFieldReadWrite m) BijectiveFunc Source # | |
Defined in Data.ReactiveValue Methods gmap :: BijectiveFunc a b -> ReactiveFieldReadWrite m a -> ReactiveFieldReadWrite m b Source # |
bijection :: (a -> b, b -> a) -> BijectiveFunc a b Source #
Create a bijection (BijectiveFunc
) from a couple of functions
direct :: BijectiveFunc a b -> a -> b Source #
Obtain the direct function from a bijection
inverse :: BijectiveFunc a b -> b -> a Source #
Obtain the inverse function from a bijection
type Involution a = BijectiveFunc a a Source #
Involutions (functions that are the same as their inverse)
involution :: (a -> a) -> Involution a Source #
Create an involution from a function
Low-level operations
reactiveValueModify :: (Monad m, ReactiveValueReadWrite a b m) => a -> (b -> b) -> m () Source #
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).
Controlling change
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.
Stopping change propagation
eqCheck :: (Eq v, Monad m) => ReactiveFieldReadWrite m v -> ReactiveFieldReadWrite m v Source #
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).
passivelyR :: (Monad m, ReactiveValueRead a b m) => a -> ReactiveFieldRead m b Source #
Create a passive RO RV backed by another Readable RV by disabling change propagation.
passivelyRW :: (Monad m, ReactiveValueReadWrite a b m) => a -> ReactiveFieldReadWrite m b Source #
Create a passive RW RV backed by another RW RV by disabling change propagation.
Governing
governingR :: (ReactiveValueRead a b m, ReactiveValueRead c d m) => a -> c -> ReactiveFieldRead m d Source #
A form of binary readable lifting that passifies the second RV but reads exclusively from it.
governingR r1 r2 = rMerge r1 (passively r2)
governingRW :: (ReactiveValueRead a b m, ReactiveValueReadWrite c d m) => a -> c -> ReactiveFieldReadWrite m d Source #
A form of binary read-writable lifting that passifies the second RV but reads exclusively from it.
Guarding
ifRW :: (Monad m, ReactiveValueRead c Bool m, ReactiveValueReadWrite v a m) => c -> v -> ReactiveFieldReadWrite m a Source #
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 Source #
Check condition and notify only when holds (but writing occurs regardless).
guardRO :: (Monad m, ReactiveValueRead c Bool m) => c -> ReactiveFieldRead m Bool Source #
guardRO' :: (Monad m, ReactiveValueRead c a m) => c -> (a -> Bool) -> ReactiveFieldRead m a Source #
Check RV and notify only when condition on the value holds (stops propagation by filtering on the new value).
Activatable RVs
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).
class ReactiveValueActivatable m a where Source #
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.
Methods
defaultActivation :: a -> ReactiveFieldActivatable m Source #
type ReactiveFieldActivatable m = ReactiveFieldRead m () Source #
A trivial type for Readable RVs that carry unit. They can be used for buttons, or events without data.
mkActivatable :: Monad m => (m () -> m ()) -> ReactiveFieldActivatable m Source #
Create an activatable RV from a handler installer.