Stability | experimental |
---|---|
Maintainer | [email protected] |
FRP.Reactive.Internal.Reactive
Description
Representation for Reactive
and Event
types. Combined here,
because they're mutually recursive.
The representation used in this module is based on a close connection between these two types. A reactive value is defined by an initial value and an event that yields future values; while an event is given as a future reactive value.
- newtype EventG t a = Event {}
- isNeverE :: (Bounded t, Eq t) => EventG t a -> Bool
- inEvent :: (FutureG s (ReactiveG s a) -> FutureG t (ReactiveG t b)) -> EventG s a -> EventG t b
- inEvent2 :: (FutureG t (ReactiveG t a) -> FutureG t (ReactiveG t b) -> FutureG t (ReactiveG t c)) -> EventG t a -> EventG t b -> EventG t c
- eFutures :: (Bounded t, Eq t) => EventG t a -> [FutureG t a]
- data ReactiveG t a = a Stepper (EventG t a)
- inREvent :: (EventG s a -> EventG t a) -> ReactiveG s a -> ReactiveG t a
- inFutR :: (FutureG s (ReactiveG s b) -> FutureG t (ReactiveG t b)) -> ReactiveG s b -> ReactiveG t b
- runE :: forall t. (Ord t, Bounded t) => Sink t -> Sink (EventG t Action)
- runR :: (Bounded t, Ord t) => Sink t -> Sink (ReactiveG t Action)
- forkE :: (Ord t, Bounded t) => Sink t -> EventG t Action -> IO ThreadId
- forkR :: (Ord t, Bounded t) => Sink t -> ReactiveG t Action -> IO ThreadId
Documentation
Events. Semantically: time-ordered list of future values. Instances:
-
Monoid
:mempty
is the event that never occurs, ande
is the event that combines occurrences frommappend
e'e
ande'
. -
Functor
:fmap f e
is the event that occurs whenevere
occurs, and whose occurrence values come from applyingf
to the values frome
. -
Applicative
:pure a
is an event with a single occurrence at time -Infinity.ef <*> ex
is an event whose occurrences are made from the product of the occurrences ofef
andex
. For every occurrencef
at timetf
ofef
and occurrencex
at timetx
ofex
,ef <*> ex
has an occurrencef x
at timetf
. N.B.: I don't expect this instance to be very useful. Ifmax
txef
hasnf
instances andex
hasnx
instances, thenef <*> ex
hasnf*nx
instances. However, there are onlynf+nx
possibilities fortf
, so many of the occurrences are simultaneous. If you think you want to use this instance, consider usingmax
txReactive
instead. -
Monad
:return a
is the same aspure a
(as usual). Ine >>= f
, each occurrence ofe
leads, throughf
, to a new event. Similarly forjoin ee
, which is somehow simpler for me to think about. The occurrences ofe >>= f
(orjoin ee
) correspond to the union of the occurrences (temporal interleaving) of all such events. For example, suppose we're playing Asteroids and tracking collisions. Each collision can break an asteroid into more of them, each of which has to be tracked for more collisions. Another example: A chat room has an enter event, whose occurrences contain new events like speak. An especially useful monad-based function isjoinMaybes
, which filters a Maybe-valued event.
Instances
(Ord t, Bounded t) => Monad (EventG t) | |
Functor (EventG t) | |
(Ord t, Bounded t) => MonadPlus (EventG t) | |
(Ord t, Bounded t) => Applicative (EventG t) | |
Unzip (EventG t) | |
(Ord t, Bounded t) => Monoid_f (EventG t) | |
(Ord t, Bounded t) => Alternative (EventG t) | |
Monoid t => Comonad (EventG t) | |
Copointed (EventG t) | |
(Eq t, Bounded t, Show t, Show a) => Show (EventG t a) | |
(Arbitrary t, Ord t, Bounded t, Num t, Arbitrary a) => Arbitrary (EventG t a) | |
(CoArbitrary t, CoArbitrary a) => CoArbitrary (EventG t a) | |
(Ord t, Bounded t) => Monoid (EventG t a) | |
(Ord t, Bounded t, Cozip f) => Zip (:. (EventG t) f) | |
(Ord t, Bounded t) => Monoid_f (:. (EventG t) f) | |
(Bounded t, Eq t, Eq a, EqProp t, EqProp a) => EqProp (EventG t a) | |
(Ord t, Bounded t) => Monoid (:. (EventG t) f a) |
inEvent :: (FutureG s (ReactiveG s a) -> FutureG t (ReactiveG t b)) -> EventG s a -> EventG t bSource
Apply a unary function inside an EventG
representation.
inEvent2 :: (FutureG t (ReactiveG t a) -> FutureG t (ReactiveG t b) -> FutureG t (ReactiveG t c)) -> EventG t a -> EventG t b -> EventG t cSource
Apply a binary function inside an EventG
representation.
eFutures :: (Bounded t, Eq t) => EventG t a -> [FutureG t a]Source
Make the event into a list of futures
Reactive value: a discretely changing value. Reactive values can be
understood in terms of (a) a simple denotational semantics of reactive
values as functions of time, and (b) the corresponding instances for
functions. The semantics is given by the function at :: ReactiveG t a ->
(t -> a)
. A reactive value may also be thought of (and in this module
is implemented as) a current value and an event (stream of future values).
The semantics of ReactiveG
instances are given by corresponding
instances for the semantic model (functions):
-
Functor
:at (fmap f r) == fmap f (at r)
, i.e.,fmap f r
.at
t == f (rat
t) -
Applicative
:at (pure a) == pure a
, andat (s <*> r) == at s <*> at t
. That is,pure a
, andat
t == a(s <*> r)
.at
t == (sat
t) (rat
t) -
Monad
:at (return a) == return a
, andat (join rr) == join (at . at rr)
. That is,return a
, andat
t == ajoin rr
. As always,at
t == (rrat
t)at
t(r >>= f) == join (fmap f r)
.at (r >>= f) == at r >>= at . f
. -
Monoid
: a typical lifted monoid. Ifo
is a monoid, thenReactive o
is a monoid, withmempty == pure mempty
, andmappend == liftA2 mappend
. That is,mempty
, andat
t == mempty(r
mappend
s)at
t == (rat
t)mappend
(sat
t).
Instances
(Ord t, Bounded t) => Monad (ReactiveG t) | |
Functor (ReactiveG t) | |
(Ord t, Bounded t) => Applicative (ReactiveG t) | |
(Ord t, Bounded t) => Zip (ReactiveG t) | |
Unzip (ReactiveG t) | |
Monoid t => Comonad (ReactiveG t) | |
(Ord t, Bounded t) => Pointed (ReactiveG t) | |
Copointed (ReactiveG t) | |
(Eq t, Bounded t, Show t, Show a) => Show (ReactiveG t a) | |
(Arbitrary t, Arbitrary a, Num t, Ord t, Bounded t) => Arbitrary (ReactiveG t a) | |
(CoArbitrary t, CoArbitrary a) => CoArbitrary (ReactiveG t a) | |
(Ord t, Bounded t, Monoid a) => Monoid (ReactiveG t a) | |
(Ord t, Bounded t, Zip f) => Zip (:. (ReactiveG t) f) | |
(Monoid_f f, Ord t, Bounded t) => Monoid_f (:. (ReactiveG t) f) | |
(Ord t, Bounded t, Arbitrary t, Show t, EqProp a) => EqProp (ReactiveG t a) | |
(Ord t, Bounded t) => Model (ReactiveG t a) (t -> a) | |
(Applicative (:. (ReactiveG tr) (Fun tf)), Monoid a) => Monoid (:. (ReactiveG tr) (Fun tf) a) |
inREvent :: (EventG s a -> EventG t a) -> ReactiveG s a -> ReactiveG t aSource
Apply a unary function inside the rEvent
part of a Reactive
representation.
inFutR :: (FutureG s (ReactiveG s b) -> FutureG t (ReactiveG t b)) -> ReactiveG s b -> ReactiveG t bSource
Apply a unary function inside the future reactive inside a Reactive
representation.
runE :: forall t. (Ord t, Bounded t) => Sink t -> Sink (EventG t Action)Source
Run an event in the current thread. Use the given time sink to sync time, i.e., to wait for an output time before performing the action.
runR :: (Bounded t, Ord t) => Sink t -> Sink (ReactiveG t Action)Source
Run a reactive value in the current thread, using the given time sink to sync time.